diff options
Diffstat (limited to 'FS')
57 files changed, 1534 insertions, 687 deletions
@@ -126,6 +126,12 @@ L<FS::registrar> - Domain registrar class L<FS::svc_forward> - Mail forwarding class +L<FS::svc_mailinglist> - (Customer) Mailing list class + +L<FS::mailinglist> - Mailing list class + +L<FS::mailinglistmember> - Mailing list member class + L<FS::svc_www> - Web virtual host class. L<FS::svc_broadband> - DSL, wireless and other broadband class. @@ -346,6 +352,8 @@ L<FS::h_svc_external> - Historical externally tracked service objects L<FS::h_svc_forward> - Historical mail forwarding alias objects +L<FS::h_svc_mailinglist> - Historical mailing list objects + L<FS::h_svc_phone> - Historical phone number objects L<FS::h_svc_pbx> - Historical PBX objects diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 095d93dd2..45d11c45c 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -3546,6 +3546,13 @@ worry that config_items is freeside-specific and icky. 'type' => 'checkbox', }, + { + 'key' => 'enable_legacy_prepaid_income', + 'section' => '', + 'description' => "Enable legacy prepaid income reporting. Only useful when you have imported pre-Freeside packages with longer-than-monthly duration, and need to do prepaid income reporting on them before they've been invoiced the first time.", + 'type' => 'checkbox', + }, + { key => "apacheroot", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, { key => "apachemachine", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, { key => "apachemachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" }, diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index 9a8272b26..cc2bdcc7c 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -222,6 +222,7 @@ if ( -e $addl_handler_use_file ) { use FS::h_svc_www; use FS::cust_statement; use FS::svc_pbx; + use FS::svc_mailinglist; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm index 69954a862..71670f758 100644 --- a/FS/FS/Misc.pm +++ b/FS/FS/Misc.pm @@ -343,14 +343,14 @@ sub send_email { $smtp_opt{'port'} = $port; my $transport; - if ( $enc eq 'starttls' ) { + if ( defined($enc) && $enc eq 'starttls' ) { $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password); $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt ); } else { if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) { $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password); } - $smtp_opt{'ssl'} = 1 if $enc eq 'tls'; + $smtp_opt{'ssl'} = 1 if defined($enc) && $enc eq 'tls'; $transport = Email::Sender::Transport::SMTP->new( %smtp_opt ); } diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 46ad18a2f..660a072b8 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -102,6 +102,10 @@ sub dbdef_dist { my %hash = map { $_ => shift @coldef } qw( name type null length default local ); + #can be removed once we depend on DBIx::DBSchema 0.39; + $hash{'type'} = 'LONGTEXT' + if $hash{'type'} =~ /^TEXT$/i && $datasrc =~ /^dbi:mysql/i; + unless ( defined $hash{'default'} ) { warn "$tablename:\n". join('', map "$_ => $hash{$_}\n", keys %hash) ;# $stop = <STDIN>; @@ -113,7 +117,17 @@ sub dbdef_dist { #false laziness w/sub indices in DBIx::DBSchema::DBD (well, sorta) #and sub sql_create_table in DBIx::DBSchema::Table (slighty more?) my $unique = $tables_hashref->{$tablename}{'unique'}; - my $index = $tables_hashref->{$tablename}{'index'}; + my @index = @{ $tables_hashref->{$tablename}{'index'} }; + + # kludge to avoid avoid "BLOB/TEXT column 'statustext' used in key + # specification without a key length". + # better solution: teach DBIx::DBSchema to specify a default length for + # MySQL indices on text columns, or just to support an index length at all + # so we can pass something in. + # best solution: eliminate need for this index in cust_main::retry_realtime + @index = grep { @{$_}[0] ne 'statustext' } @index + if $datasrc =~ /^dbi:mysql/i; + my @indices = (); push @indices, map { DBIx::DBSchema::Index->new({ @@ -130,7 +144,7 @@ sub dbdef_dist { 'columns' => $_, }); } - @$index; + @index; DBIx::DBSchema::Table->new({ 'name' => $tablename, @@ -641,10 +655,11 @@ sub tables_hashref { 'addlinfo', 'text', 'NULL', '', '', '', 'closed', 'char', 'NULL', 1, '', '', 'pkgnum', 'int', 'NULL', '', '', '', #desired pkgnum for pkg-balances + 'eventnum', 'int', 'NULL', '', '', '', #triggering event for commission ], 'primary_key' => 'crednum', 'unique' => [], - 'index' => [ ['custnum'], ['_date'] ], + 'index' => [ ['custnum'], ['_date'], ['eventnum'] ], }, 'cust_credit_bill' => { @@ -1353,8 +1368,8 @@ sub tables_hashref { 'part_pkg_taxoverride' => { 'columns' => [ 'taxoverridenum', 'serial', '', '', '', '', - 'pkgpart', 'serial', '', '', '', '', - 'taxclassnum', 'serial', '', '', '', '', + 'pkgpart', 'int', '', '', '', '', + 'taxclassnum', 'int', '', '', '', '', 'usage_class', 'varchar', 'NULL', $char_d, '', '', ], 'primary_key' => 'taxoverridenum', @@ -1969,16 +1984,17 @@ sub tables_hashref { 'rate_detail' => { 'columns' => [ - 'ratedetailnum', 'serial', '', '', '', '', - 'ratenum', 'int', '', '', '', '', - 'orig_regionnum', 'int', 'NULL', '', '', '', - 'dest_regionnum', 'int', '', '', '', '', - 'min_included', 'int', '', '', '', '', - #'min_charge', @money_type, '', '', - 'min_charge', 'decimal', '', '10,5', '', '', - 'sec_granularity', 'int', '', '', '', '', + 'ratedetailnum', 'serial', '', '', '', '', + 'ratenum', 'int', '', '', '', '', + 'orig_regionnum', 'int', 'NULL', '', '', '', + 'dest_regionnum', 'int', '', '', '', '', + 'min_included', 'int', '', '', '', '', + 'conn_charge', @money_type, '0', '', #'decimal','','10,5','0','', + 'conn_sec', 'int', '', '', '0', '', + 'min_charge', 'decimal', '', '10,5', '', '', #@money_type, '', '', + 'sec_granularity', 'int', '', '', '', '', #time period (link to table of periods)? - 'classnum', 'int', 'NULL', '', '', '', + 'classnum', 'int', 'NULL', '', '', '', ], 'primary_key' => 'ratedetailnum', 'unique' => [ [ 'ratenum', 'orig_regionnum', 'dest_regionnum' ] ], @@ -2365,11 +2381,12 @@ sub tables_hashref { '_password', 'varchar', '', $char_d, '', '', 'last', 'varchar', '', $char_d, '', '', 'first', 'varchar', '', $char_d, '', '', + 'user_custnum', 'int', 'NULL', '', '', '', 'disabled', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'usernum', 'unique' => [ [ 'username' ] ], - 'index' => [], + 'index' => [ [ 'user_custnum' ] ], }, 'access_user_pref' => { @@ -2553,6 +2570,44 @@ sub tables_hashref { 'index' => [ [ 'id' ] ], }, + 'svc_mailinglist' => { #svc_group? + 'columns' => [ + 'svcnum', 'int', '', '', '', '', + 'username', 'varchar', '', $username_len, '', '', + 'domsvc', 'int', '', '', '', '', + 'listnum', 'int', '', '', '', '', + 'reply_to', 'char', 'NULL', 1, '', '',#SetReplyTo + 'remove_from', 'char', 'NULL', 1, '', '',#RemoveAuthor + 'reject_auto', 'char', 'NULL', 1, '', '',#RejectAuto + 'remove_to_and_cc', 'char', 'NULL', 1, '', '',#RemoveToAndCc + ], + 'primary_key' => 'svcnum', + 'unique' => [], + 'index' => [ ['username'], ['domsvc'], ['listnum'] ], + }, + + 'mailinglist' => { + 'columns' => [ + 'listnum', 'serial', '', '', '', '', + 'listname', 'varchar', '', $char_d, '', '', + ], + 'primary_key' => 'listnum', + 'unique' => [], + 'index' => [], + }, + + 'mailinglistmember' => { + 'columns' => [ + 'membernum', 'serial', '', '', '', '', + 'listnum', 'int', '', '', '', '', + 'svcnum', 'int', 'NULL', '', '', '', + 'email', 'varchar', 'NULL', 255, '', '', + ], + 'primary_key' => 'membernum', + 'unique' => [], + 'index' => [['listnum'],['svcnum'],['email']], + }, + # name type nullability length default local diff --git a/FS/FS/Setup.pm b/FS/FS/Setup.pm index d8e32209e..edfe912ea 100644 --- a/FS/FS/Setup.pm +++ b/FS/FS/Setup.pm @@ -153,7 +153,7 @@ sub populate_initial_data { die $@ if $@; $class->_populate_initial_data(%opt) - if $class->can('_populate_initial_data'); + if $class->can('_populate_inital_data'); my @records = @{ $data->{$table} }; diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index e3a4604b4..e042c05b1 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -128,7 +128,7 @@ sub forksuidsetup { } } else { - warn "NO CONFIGURATION TABLE FOUND"; + warn "NO CONFIGURATION TABLE FOUND" unless $FS::Schema::setup_hack; } unless ( $callback_hack ) { diff --git a/FS/FS/Upgrade.pm b/FS/FS/Upgrade.pm index c39680ef7..ff577f2f2 100644 --- a/FS/FS/Upgrade.pm +++ b/FS/FS/Upgrade.pm @@ -99,7 +99,6 @@ sub upgrade_data { #reason type and reasons 'reason_type' => [], - 'reason' => [], 'cust_pkg_reason' => [], #need part_pkg before cust_credit... @@ -129,9 +128,6 @@ sub upgrade_data { #fixup access rights 'access_right' => [], - #change tax_rate column types - 'tax_rate' => [], - #change recur_flat and enable_prorate 'part_pkg_option' => [], diff --git a/FS/FS/access_user.pm b/FS/FS/access_user.pm index 8cc8b64fc..1bf6e9387 100644 --- a/FS/FS/access_user.pm +++ b/FS/FS/access_user.pm @@ -10,6 +10,7 @@ use FS::option_Common; use FS::access_user_pref; use FS::access_usergroup; use FS::agent; +use FS::cust_main; @ISA = qw( FS::m2m_Common FS::option_Common FS::Record ); #@ISA = qw( FS::m2m_Common FS::option_Common ); @@ -220,6 +221,9 @@ sub replace { $dbh->rollback or die $dbh->errstr if $oldAutoCommit; return $error; } + } elsif ( $old->disabled && !$new->disabled + && $new->_password =~ /changeme/i ) { + return "Must change password when enabling this account"; } my $error = $new->SUPER::replace($old, @_); @@ -254,6 +258,7 @@ sub check { || $self->ut_text('_password') || $self->ut_text('last') || $self->ut_text('first') + || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum') || $self->ut_enum('disabled', [ '', 'Y' ] ) ; return $error if $error; @@ -272,6 +277,18 @@ sub name { $self->get('last'). ', '. $self->first; } +=item user_cust_main + +Returns the FS::cust_main object (see L<FS::cust_main>), if any, for this +user. + +=cut + +sub user_cust_main { + my $self = shift; + qsearchs( 'cust_main', { 'custnum' => $self->user_custnum } ); +} + =item access_usergroup Returns links to the the groups this user is a part of, as FS::access_usergroup diff --git a/FS/FS/cust_bill_ApplicationCommon.pm b/FS/FS/cust_bill_ApplicationCommon.pm index fd6fb9e73..8ba57f36f 100644 --- a/FS/FS/cust_bill_ApplicationCommon.pm +++ b/FS/FS/cust_bill_ApplicationCommon.pm @@ -5,11 +5,6 @@ use vars qw( @ISA $DEBUG $me $skip_apply_to_lineitems_hack ); use List::Util qw(min); use FS::Schema qw( dbdef ); use FS::Record qw( qsearch qsearchs dbh ); -use FS::cust_pkg; -use FS::cust_svc; -use FS::cust_bill_pkg; -use FS::part_svc; -use FS::part_export; @ISA = qw( FS::Record ); @@ -335,30 +330,6 @@ sub apply_to_lineitems { $dbh->rollback if $oldAutoCommit; return $error; } - - # trigger export_insert_on_payment - if ( $conf->exists('trigger_export_insert_on_payment') - && $cust_bill_pkg->pkgnum > 0 ) - { - if ( my $cust_pkg = $cust_bill_pkg->cust_pkg ) { - - foreach my $cust_svc ( $cust_pkg->cust_svc ) { - my $svc_x = $cust_svc->svc_x; - my @part_export = grep { $_->can('export_insert_on_payment') } - $cust_svc->part_svc->part_export; - - foreach my $part_export ( $cust_svc->part_svc->part_export ) { - $error = $part_export->_export_insert_on_payment($svc_x); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - } - } - # done trigger export_insert_on_payment - } #everything should always be applied to line items in full now... sanity check diff --git a/FS/FS/cust_bill_pkg_detail.pm b/FS/FS/cust_bill_pkg_detail.pm index f2e60d2f4..4d9ee8191 100644 --- a/FS/FS/cust_bill_pkg_detail.pm +++ b/FS/FS/cust_bill_pkg_detail.pm @@ -241,8 +241,8 @@ sub _upgrade_data { # class method warn "$me upgrading $class\n" if $DEBUG; - my $columndef = dbdef->table($class->table)->column('classnum'); - unless ($columndef->type eq 'int4') { + my $type = dbdef->table($class->table)->column('classnum')->type; + unless ( $type =~ /^int/i || $type =~ /int$/i ) { my $dbh = dbh; if ( $dbh->{Driver}->{Name} eq 'Pg' ) { diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index 6c3effa13..d0aa3a4b4 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -14,6 +14,7 @@ use FS::cust_credit_bill; use FS::part_pkg; use FS::reason_type; use FS::reason; +use FS::cust_event; @ISA = qw( FS::cust_main_Mixin FS::Record ); $me = '[ FS::cust_credit ]'; @@ -301,6 +302,7 @@ sub check { || $self->ut_textn('addlinfo') || $self->ut_enum('closed', [ '', 'Y' ]) || $self->ut_foreign_keyn('pkgnum', 'cust_pkg', 'pkgnum') + || $self->ut_foreign_keyn('eventnum', 'cust_event', 'eventnum') ; return $error if $error; diff --git a/FS/FS/cust_event.pm b/FS/FS/cust_event.pm index d2fcfc1e2..52b5911dc 100644 --- a/FS/FS/cust_event.pm +++ b/FS/FS/cust_event.pm @@ -1,18 +1,16 @@ package FS::cust_event; use strict; +use base qw( FS::cust_main_Mixin FS::Record ); use vars qw( @ISA $DEBUG $me ); use Carp qw( croak confess ); use FS::Record qw( qsearch qsearchs dbdef ); -use FS::cust_main_Mixin; use FS::part_event; #for cust_X use FS::cust_main; use FS::cust_pkg; use FS::cust_bill; -@ISA = qw(FS::cust_main_Mixin FS::Record); - $DEBUG = 0; $me = '[FS::cust_event]'; @@ -230,7 +228,7 @@ sub do_event { my $error; { local $SIG{__DIE__}; # don't want Mason __DIE__ handler active - $error = eval { $part_event->do_action($object); }; + $error = eval { $part_event->do_action($object, $self); }; } my $status = ''; diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 5116049f3..88aceb935 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -7320,7 +7320,7 @@ sub referral_cust_main_ncancelled { Like referral_cust_main, except returns a flat list of all unsuspended (and uncancelled) packages for each customer. The number of items in this list may -be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ). +be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ). =cut @@ -7382,8 +7382,10 @@ sub credit { $cust_credit->set('reason', $reason) } - $cust_credit->addlinfo( delete $options{'addlinfo'} ) - if exists($options{'addlinfo'}); + for (qw( addlinfo eventnum )) { + $cust_credit->$_( delete $options{$_} ) + if exists($options{$_}); + } $cust_credit->insert(%options); diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index d8b7575b6..89eadd599 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1703,7 +1703,9 @@ sub extra_part_svc { #seems to benchmark slightly faster... qsearch( { - 'select' => 'DISTINCT ON (svcpart) part_svc.*', + #'select' => 'DISTINCT ON (svcpart) part_svc.*', + #MySQL doesn't grok DISINCT ON + 'select' => 'DISTINCT part_svc.*', 'table' => 'part_svc', 'addl_from' => 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart diff --git a/FS/FS/export_device.pm b/FS/FS/export_device.pm deleted file mode 100644 index 69e382649..000000000 --- a/FS/FS/export_device.pm +++ /dev/null @@ -1,136 +0,0 @@ -package FS::export_device; - -use strict; -use base qw( FS::Record ); -use FS::Record qw( qsearch qsearchs dbh ); -use FS::part_export; -use FS::part_device; - -=head1 NAME - -FS::export_device - Object methods for export_device records - -=head1 SYNOPSIS - - use FS::export_device; - - $record = new FS::export_device \%hash; - $record = new FS::export_device { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::export_device object links a device definition (see L<FS::part_device>) -to an export (see L<FS::part_export>). FS::export_device inherits from -FS::Record. The following fields are currently supported: - -=over 4 - -=item exportdevicenum - primary key - -=item exportnum - export (see L<FS::part_export>) - -=item devicepart - device definition (see L<FS::part_device>) - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new record. To add the record to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -sub table { 'export_device'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -# may want to check for duplicates against either services or devices -# cf FS::export_svc - -=item delete - -Delete this record from the database. - -=cut - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -=item check - -Checks all fields to make sure this is a valid record. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -sub check { - my $self = shift; - - $self->ut_numbern('exportdevicenum') - || $self->ut_number('exportnum') - || $self->ut_foreign_key('exportnum', 'part_export', 'exportnum') - || $self->ut_number('devicepart') - || $self->ut_foreign_key('devicepart', 'part_device', 'devicepart') - || $self->SUPER::check - ; -} - -=item part_export - -Returns the FS::part_export object (see L<FS::part_export>). - -=cut - -sub part_export { - my $self = shift; - qsearchs( 'part_export', { 'exportnum' => $self->exportnum } ); -} - -=item part_device - -Returns the FS::part_device object (see L<FS::part_device>). - -=cut - -sub part_device { - my $self = shift; - qsearchs( 'part_device', { 'svcpart' => $self->devicepart } ); -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::part_export>, L<FS::part_device>, L<FS::Record>, schema.html from the base -documentation. - -=cut - -1; - diff --git a/FS/FS/h_svc_mailinglist.pm b/FS/FS/h_svc_mailinglist.pm new file mode 100644 index 000000000..3d1fd272a --- /dev/null +++ b/FS/FS/h_svc_mailinglist.pm @@ -0,0 +1,33 @@ +package FS::h_svc_mailinglist; + +use strict; +use vars qw( @ISA ); +use FS::h_Common; +use FS::svc_mailinglist; + +@ISA = qw( FS::h_Common FS::svc_mailinglist ); + +sub table { 'h_svc_mailinglist' }; + +=head1 NAME + +FS::h_svc_mailinglist - Historical mailing list objects + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +An FS::h_svc_mailinglist object represents a historical mailing list. +FS::h_svc_mailinglist inherits from FS::h_Common and FS::svc_mailinglist. + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::h_Common>, L<FS::svc_mailinglist>, L<FS::Record>, schema.html from the +base documentation. + +=cut + +1; + diff --git a/FS/FS/mailinglist.pm b/FS/FS/mailinglist.pm new file mode 100644 index 000000000..129461092 --- /dev/null +++ b/FS/FS/mailinglist.pm @@ -0,0 +1,173 @@ +package FS::mailinglist; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs dbh ); +use FS::mailinglistmember; +use FS::svc_mailinglist; + +=head1 NAME + +FS::mailinglist - Object methods for mailinglist records + +=head1 SYNOPSIS + + use FS::mailinglist; + + $record = new FS::mailinglist \%hash; + $record = new FS::mailinglist { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::mailinglist object represents a mailing list FS::mailinglist inherits +from FS::Record. The following fields are currently supported: + +=over 4 + +=item listnum + +primary key + +=item listname + +Mailing list name + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new mailing list. To add the mailing list to the database, see +L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'mailinglist'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +sub delete { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + foreach my $member ( $self->mailinglistmember ) { + my $error = $member->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + my $error = $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid mailing list. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('listnum') + || $self->ut_text('listname') + ; + return $error if $error; + + $self->SUPER::check; +} + +=item mailinglistmember + +=cut + +sub mailinglistmember { + my $self = shift; + qsearch('mailinglistmember', { 'listnum' => $self->listnum } ); +} + +=item svc_mailinglist + +=cut + +sub svc_mailinglist { + my $self = shift; + qsearchs('svc_mailinglist', { 'listnum' => $self->listnum } ); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::mailinglistmember>, L<FS::svc_mailinglist>, L<FS::Record>, schema.html +from the base documentation. + +=cut + +1; + diff --git a/FS/FS/mailinglistmember.pm b/FS/FS/mailinglistmember.pm new file mode 100644 index 000000000..8655d61b2 --- /dev/null +++ b/FS/FS/mailinglistmember.pm @@ -0,0 +1,239 @@ +package FS::mailinglistmember; + +use strict; +use base qw( FS::Record ); +use Scalar::Util qw( blessed ); +use FS::Record qw( dbh qsearchs ); # qsearch ); +use FS::mailinglist; +use FS::svc_acct; + +=head1 NAME + +FS::mailinglistmember - Object methods for mailinglistmember records + +=head1 SYNOPSIS + + use FS::mailinglistmember; + + $record = new FS::mailinglistmember \%hash; + $record = new FS::mailinglistmember { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::mailinglistmember object represents a mailing list member. +FS::mailinglistmember inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item membernum + +primary key + +=item listnum + +listnum + +=item svcnum + +svcnum + +=item email + +email + + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new mailing list member. To add the member to the database, see + L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'mailinglistmember'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub insert { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::insert + || $self->export('mailinglistmember_insert'); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} + +=item delete + +Delete this record from the database. + +=cut + +sub delete { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::delete + || $self->export('mailinglistmember_delete'); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +sub replace { + my $new = shift; + + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $new->replace_old; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $new->SUPER::replace($old) + || $new->export('mailinglistmember_replace', $old); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} + +=item check + +Checks all fields to make sure this is a valid member. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('membernum') + || $self->ut_foreign_key('listnum', 'mailinglist', 'listnum') + || $self->ut_foreign_keyn('svcnum', 'svc_acct', 'svcnum') + || $self->ut_textn('email') #XXX ut_email! from svc_forward, cust_main_invoice + ; + return $error if $error; + + $self->SUPER::check; +} + +=item mailinglist + +=cut + +sub mailinglist { + my $self = shift; + qsearchs('mailinglist', { 'listnum' => $self->listnum } ); +} + +=item email_address + +=cut + +sub email_address { + my $self = shift; + #XXX svcnum + $self->email; +} + +=item export + +=cut + +sub export { + my( $self, $method ) = ( shift, shift ); + my $svc_mailinglist = $self->mailinglist->svc_mailinglist + or return ''; + $svc_mailinglist->export($method, $self, @_); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_device.pm b/FS/FS/part_device.pm index 49635841e..79a534ae7 100644 --- a/FS/FS/part_device.pm +++ b/FS/FS/part_device.pm @@ -1,10 +1,8 @@ package FS::part_device; use strict; -use base qw( FS::Record FS::m2m_Common ); -use FS::Record qw( qsearch qsearchs ); -use FS::part_export; -use FS::export_device; +use base qw( FS::Record ); +use FS::Record; # qw( qsearch qsearchs ); =head1 NAME @@ -109,18 +107,6 @@ sub check { $self->SUPER::check; } -=item part_export - -Returns a list of all exports (see L<FS::part_export>) for this device. - -=cut - -sub part_export { - my $self = shift; - map { qsearchs( 'part_export', { 'exportnum' => $_->exportnum } ) } - qsearch( 'export_device', { 'devicepart' => $self->devicepart } ); -} - sub process_batch_import { my $job = shift; diff --git a/FS/FS/part_event/Action/Mixin/credit_pkg.pm b/FS/FS/part_event/Action/Mixin/credit_pkg.pm new file mode 100644 index 000000000..aeda92f91 --- /dev/null +++ b/FS/FS/part_event/Action/Mixin/credit_pkg.pm @@ -0,0 +1,63 @@ +package FS::part_event::Action::Mixin::credit_pkg; + +use strict; + +sub eventtable_hashref { + { 'cust_pkg' => 1 }; +} + +sub option_fields { + ( + 'reasonnum' => { 'label' => 'Credit reason', + 'type' => 'select-reason', + 'reason_class' => 'R', + }, + 'percent' => { 'label' => 'Percent', + 'type' => 'input-percentage', + 'default' => '100', + }, + 'what' => { 'label' => 'Of', + 'type' => 'select', + #add additional ways to specify in the package def + 'options' => [ qw( base_recur_permonth unit_setup recur_cost_permonth setup_cost ) ], + 'labels' => { 'base_recur_permonth' => 'Base monthly fee', + 'unit_setup' => 'Setup fee', + 'recur_cost_permonth' => 'Monthly cost', + 'setup_cost' => 'Setup cost', + }, + }, + ); + +} + +#my %no_cust_pkg = ( 'setup_cost' => 1 ); + +sub _calc_credit { + my( $self, $cust_pkg ) = @_; + + my $cust_main = $self->cust_main($cust_pkg); + + my $part_pkg = $cust_pkg->part_pkg; + + my $what = $self->option('what'); + + #false laziness w/Condition/cust_payments_pkg.pm + if ( $what =~ /_permonth$/ ) { #huh. yuck. + if ( $part_pkg->freq !~ /^\d+$/ ) { + die 'WARNING: Not crediting for package '. $cust_pkg->pkgnum. + ' ( customer '. $cust_pkg->custnum. ')'. + ' - credits not (yet) available for '. + ' packages with '. $part_pkg->freq_pretty. ' frequency'; + } + } + + my $percent = $self->option('percent'); + + #my @arg = $no_cust_pkg{$what} ? () : ($cust_pkg); + my @arg = ($what eq 'setup_cost') ? () : ($cust_pkg); + + sprintf('%.2f', $part_pkg->$what(@arg) * $percent / 100 ); + +} + +1; diff --git a/FS/FS/part_event/Action/pkg_agent_credit.pm b/FS/FS/part_event/Action/pkg_agent_credit.pm new file mode 100644 index 000000000..4bcee983b --- /dev/null +++ b/FS/FS/part_event/Action/pkg_agent_credit.pm @@ -0,0 +1,39 @@ +package FS::part_event::Action::pkg_agent_credit; + +use strict; +use base qw( FS::part_event::Action::pkg_referral_credit ); + +sub description { 'Credit the agent a specific amount'; } + +#a little false laziness w/pkg_referral_credit +sub do_action { + my( $self, $cust_pkg, $cust_event ) = @_; + + my $cust_main = $self->cust_main($cust_pkg); + + my $agent = $cust_main->agent; + return "No customer record for agent ". $agent->agent + unless $agent->agent_custnum; + + my $agent_cust_main = $agent->agent_cust_main; + #? or return "No customer record for agent ". $agent->agent; + + my $amount = $self->_calc_credit($cust_pkg); + return '' unless $amount > 0; + + my $reasonnum = $self->option('reasonnum'); + + my $error = $agent_cust_main->credit( + $amount, + \$reasonnum, + 'eventnum' => $cust_event->eventnum, + 'addlinfo' => 'for customer #'. $cust_main->display_custnum. + ': '.$cust_main->name, + ); + die "Error crediting customer ". $agent_cust_main->custnum. + " for agent commission: $error" + if $error; + +} + +1; diff --git a/FS/FS/part_event/Action/pkg_agent_credit_pkg.pm b/FS/FS/part_event/Action/pkg_agent_credit_pkg.pm new file mode 100644 index 000000000..b3e11817d --- /dev/null +++ b/FS/FS/part_event/Action/pkg_agent_credit_pkg.pm @@ -0,0 +1,9 @@ +package FS::part_event::Action::pkg_agent_credit_pkg; + +use strict; +use base qw( FS::part_event::Action::Mixin::credit_pkg + FS::part_event::Action::pkg_agent_credit ); + +sub description { 'Credit the agent an amount based on the referred package'; } + +1; diff --git a/FS/FS/part_event/Action/pkg_employee_credit.pm b/FS/FS/part_event/Action/pkg_employee_credit.pm new file mode 100644 index 000000000..e4913a21f --- /dev/null +++ b/FS/FS/part_event/Action/pkg_employee_credit.pm @@ -0,0 +1,44 @@ +package FS::part_event::Action::pkg_employee_credit; + +use strict; +use base qw( FS::part_event::Action::pkg_referral_credit ); +use FS::Record qw(qsearchs); +use FS::access_user; + +sub description { 'Credit the ordering employee a specific amount'; } + +#a little false laziness w/pkg_referral_credit +sub do_action { + my( $self, $cust_pkg, $cust_event ) = @_; + + my $cust_main = $self->cust_main($cust_pkg); + + #yuck. this is why text $otaker is gone in 2.1 + my $otaker = $cust_pkg->otaker; + my $employee = qsearchs('access_user', { 'username' => $otaker } ) + or return "No employee for username $otaker"; + return "No customer record for employee ". $employee->username + unless $employee->user_custnum; + + my $employee_cust_main = $employee->user_cust_main; + #? or return "No customer record for employee ". $employee->username; + + my $amount = $self->_calc_credit($cust_pkg); + return '' unless $amount > 0; + + my $reasonnum = $self->option('reasonnum'); + + my $error = $employee_cust_main->credit( + $amount, + \$reasonnum, + 'eventnum' => $cust_event->eventnum, + 'addlinfo' => 'for customer #'. $cust_main->display_custnum. + ': '.$cust_main->name, + ); + die "Error crediting customer ". $employee_cust_main->custnum. + " for employee commission: $error" + if $error; + +} + +1; diff --git a/FS/FS/part_event/Action/pkg_employee_credit_pkg.pm b/FS/FS/part_event/Action/pkg_employee_credit_pkg.pm new file mode 100644 index 000000000..e3b867fb2 --- /dev/null +++ b/FS/FS/part_event/Action/pkg_employee_credit_pkg.pm @@ -0,0 +1,9 @@ +package FS::part_event::Action::pkg_employee_credit_pkg; + +use strict; +use base qw( FS::part_event::Action::Mixin::credit_pkg + FS::part_event::Action::pkg_employee_credit ); + +sub description { 'Credit the ordering employee an amount based on the referred package'; } + +1; diff --git a/FS/FS/part_event/Action/pkg_referral_credit.pm b/FS/FS/part_event/Action/pkg_referral_credit.pm index 98d982066..e7c92d650 100644 --- a/FS/FS/part_event/Action/pkg_referral_credit.pm +++ b/FS/FS/part_event/Action/pkg_referral_credit.pm @@ -22,9 +22,8 @@ sub option_fields { } -#a little false laziness w/pkg_referral_credit_pkg sub do_action { - my( $self, $cust_pkg ) = @_; + my( $self, $cust_pkg, $cust_event ) = @_; my $cust_main = $self->cust_main($cust_pkg); @@ -36,14 +35,17 @@ sub do_action { return 'Referring customer is cancelled' if $referring_cust_main->status eq 'cancelled'; - my $amount = $self->_calc_referral_credit($cust_pkg); + my $amount = $self->_calc_credit($cust_pkg); + return '' unless $amount > 0; + my $reasonnum = $self->option('reasonnum'); my $error = $referring_cust_main->credit( $amount, \$reasonnum, - 'addlinfo' => - 'for customer #'. $cust_main->display_custnum. ': '.$cust_main->name, + 'eventnum' => $cust_event->eventnum, + 'addlinfo' => 'for customer #'. $cust_main->display_custnum. + ': '.$cust_main->name, ); die "Error crediting customer ". $cust_main->referral_custnum. " for referral: $error" @@ -51,7 +53,7 @@ sub do_action { } -sub _calc_referral_credit { +sub _calc_credit { my( $self, $cust_pkg ) = @_; $self->option('amount'); diff --git a/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm b/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm index eb9b5107c..667c4ce19 100644 --- a/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm +++ b/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm @@ -1,58 +1,9 @@ package FS::part_event::Action::pkg_referral_credit_pkg; use strict; -use base qw( FS::part_event::Action::pkg_referral_credit ); +use base qw( FS::part_event::Action::Mixin::credit_pkg + FS::part_event::Action::pkg_referral_credit ); sub description { 'Credit the referring customer an amount based on the referred package'; } -#sub eventtable_hashref { -# { 'cust_pkg' => 1 }; -#} - -sub option_fields { - ( - 'reasonnum' => { 'label' => 'Credit reason', - 'type' => 'select-reason', - 'reason_class' => 'R', - }, - 'percent' => { 'label' => 'Percent', - 'type' => 'input-percentage', - 'default' => '100', - }, - 'what' => { 'label' => 'Of', - 'type' => 'select', - #also add some way to specify in the package def, no? - 'options' => [ qw( base_recur_permonth ) ], - 'labels' => { 'base_recur_permonth' => 'Base monthly fee', }, - }, - ); - -} - -sub _calc_referral_credit { - my( $self, $cust_pkg ) = @_; - - my $cust_main = $self->cust_main($cust_pkg); - - my $part_pkg = $cust_pkg->part_pkg; - - my $what = $self->option('what'); - - #false laziness w/Condition/cust_payments_pkg.pm - if ( $what eq 'base_recur_permonth' ) { #huh. yuck. - if ( $part_pkg->freq !~ /^\d+$/ ) { - die 'WARNING: Not crediting customer '. $cust_main->referral_custnum. - ' for package '. $cust_pkg->pkgnum. - ' ( customer '. $cust_pkg->custnum. ')'. - ' - Referral credits not (yet) available for '. - ' packages with '. $part_pkg->freq_pretty. ' frequency'; - } - } - - my $percent = $self->option('percent'); - - sprintf('%.2f', $part_pkg->$what($cust_pkg) * $percent / 100 ); - -} - 1; diff --git a/FS/FS/part_event/Condition/balance.pm b/FS/FS/part_event/Condition/balance.pm index 65670c030..3b8854ab8 100644 --- a/FS/FS/part_event/Condition/balance.pm +++ b/FS/FS/part_event/Condition/balance.pm @@ -40,7 +40,7 @@ sub condition_sql { my $balance_sql = FS::cust_main->balance_sql; - "$balance_sql > CAST( $over AS numeric )"; + "$balance_sql > CAST( $over AS DECIMAL(10,2) )"; } diff --git a/FS/FS/part_event/Condition/balance_age.pm b/FS/FS/part_event/Condition/balance_age.pm index f1a970796..fc3461210 100644 --- a/FS/FS/part_event/Condition/balance_age.pm +++ b/FS/FS/part_event/Condition/balance_age.pm @@ -38,7 +38,7 @@ sub condition_sql { my $balance_sql = FS::cust_main->balance_date_sql( $age ); - "$balance_sql > CAST( $over AS numeric )"; + "$balance_sql > CAST( $over AS DECIMAL(10,2) )"; } sub order_sql { diff --git a/FS/FS/part_event/Condition/balance_under.pm b/FS/FS/part_event/Condition/balance_under.pm index 9c7159011..2002c7018 100644 --- a/FS/FS/part_event/Condition/balance_under.pm +++ b/FS/FS/part_event/Condition/balance_under.pm @@ -34,7 +34,7 @@ sub condition_sql { my $balance_sql = FS::cust_main->balance_sql; - "$balance_sql <= CAST( $under AS numeric )"; + "$balance_sql <= CAST( $under AS DECIMAL(10,2) )"; } diff --git a/FS/FS/part_event/Condition/cust_bill_has_service.pm b/FS/FS/part_event/Condition/cust_bill_has_service.pm index 91d75ddac..d85af261e 100644 --- a/FS/FS/part_event/Condition/cust_bill_has_service.pm +++ b/FS/FS/part_event/Condition/cust_bill_has_service.pm @@ -38,14 +38,16 @@ sub condition { } sub condition_sql { - my( $class, $table ) = @_; + my( $class, $table, %opt ) = @_; + + my $integer = $opt{'driver_name'} =~ /^mysql/ ? 'UNSIGNED INTEGER' : 'INTEGER'; my $servicenum = $class->condition_sql_option('has_service'); my $sql = qq| 0 < ( SELECT COUNT(cs.svcpart) FROM cust_bill_pkg cbp, cust_svc cs WHERE cbp.invnum = cust_bill.invnum AND cs.pkgnum = cbp.pkgnum - AND cs.svcpart = CAST( $servicenum AS integer ) + AND cs.svcpart = CAST( $servicenum AS $integer ) ) |; return $sql; diff --git a/FS/FS/part_event/Condition/cust_bill_owed.pm b/FS/FS/part_event/Condition/cust_bill_owed.pm index 0fd992282..d8c77c777 100644 --- a/FS/FS/part_event/Condition/cust_bill_owed.pm +++ b/FS/FS/part_event/Condition/cust_bill_owed.pm @@ -48,7 +48,7 @@ sub condition_sql { my $owed_sql = FS::cust_bill->owed_sql; - "$owed_sql > CAST( $over AS numeric )"; + "$owed_sql > CAST( $over AS DECIMAL(10,2) )"; } 1; diff --git a/FS/FS/part_event/Condition/cust_bill_owed_under.pm b/FS/FS/part_event/Condition/cust_bill_owed_under.pm index a0bf92f27..4eb6439b6 100644 --- a/FS/FS/part_event/Condition/cust_bill_owed_under.pm +++ b/FS/FS/part_event/Condition/cust_bill_owed_under.pm @@ -43,7 +43,7 @@ sub condition_sql { my $owed_sql = FS::cust_bill->owed_sql; - "$owed_sql <= CAST( $under AS numeric )"; + "$owed_sql <= CAST( $under AS DECIMAL(10,2) )"; } 1; diff --git a/FS/FS/part_event_condition.pm b/FS/FS/part_event_condition.pm index d13e84927..32f19a3ae 100644 --- a/FS/FS/part_event_condition.pm +++ b/FS/FS/part_event_condition.pm @@ -2,7 +2,7 @@ package FS::part_event_condition; use strict; use vars qw( @ISA $DEBUG @SKIP_CONDITION_SQL ); -use FS::UID qw(dbh); +use FS::UID qw( dbh driver_name ); use FS::Record qw( qsearch qsearchs ); use FS::option_Common; use FS::part_event; #for order_conditions_sql... @@ -285,7 +285,9 @@ sub where_conditions_sql { map { my $conditionname = $_; my $coderef = $conditions{$conditionname}->{condition_sql}; - my $sql = &$coderef( $eventtable, 'time'=>$time ); + my $sql = &$coderef( $eventtable, 'time' => $time, + 'driver_name' => driver_name(), + ); die "$coderef is not a CODEREF" unless ref($coderef) eq 'CODE'; "( cond_$conditionname.conditionname IS NULL OR $sql )"; } diff --git a/FS/FS/part_export/communigate_pro.pm b/FS/FS/part_export/communigate_pro.pm index 2084f152b..7f5cece59 100644 --- a/FS/FS/part_export/communigate_pro.pm +++ b/FS/FS/part_export/communigate_pro.pm @@ -33,11 +33,11 @@ tie %options, 'Tie::IxHash', ; %info = ( - 'svc' => [qw( svc_acct svc_domain svc_forward )], - 'desc' => 'Real-time export of accounts and domains to a CommuniGate Pro mail server', + 'svc' => [qw( svc_acct svc_domain svc_forward svc_mailinglist )], + 'desc' => 'Real-time export of accounts, domains, mail forwards and mailing lists to a CommuniGate Pro mail server', 'options' => \%options, 'notes' => <<'END' -Real time export of accounts and domains to a +Real time export of accounts, domains, mail forwards and mailing lists to a <a href="http://www.stalker.com/CommuniGatePro/">CommuniGate Pro</a> mail server. The <a href="http://www.stalker.com/CGPerl/">CommuniGate Pro Perl Interface</a> @@ -200,6 +200,31 @@ sub _export_insert_svc_forward { ''; } +sub _export_insert_svc_mailinglist { + my( $self, $svc_mlist ) = (shift, shift); + + my @members = map $_->email_address, + $svc_mlist->mailinglist->mailinglistmember; + + #real-time here, presuming CGP does some dup detection + eval { $self->communigate_pro_runcommand( + 'CreateGroup', + $svc_mlist->username.'@'.$svc_mlist->domain, + { 'RealName' => $svc_mlist->listname, + 'SetReplyTo' => ( $svc_mlist->reply_to ? 'YES' : 'NO' ), + 'RemoveAuthor' => ( $svc_mlist->remove_from ? 'YES' : 'NO' ), + 'RejectAuto' => ( $svc_mlist->reject_auto ? 'YES' : 'NO' ), + 'RemoveToAndCc' => ( $svc_mlist->remove_to_and_cc ? 'YES' : 'NO' ), + 'Members' => \@members, + } + ); + }; + return $@ if $@; + + ''; + +} + sub _export_replace { my( $self, $new, $old ) = (shift, shift, shift); @@ -385,6 +410,39 @@ sub _export_replace_svc_forward { ''; } +sub _export_replace_svc_mailinglist { + my( $self, $new, $old ) = (shift, shift, shift); + + my $oldGroupName = $old->username.'@'.$old->domain; + my $newGroupName = $new->username.'@'.$new->domain; + + if ( $oldGroupName ne $newGroupName ) { + eval { $self->communigate_pro_runcommand( + 'RenameGroup', $oldGroupName, $newGroupName ); }; + return $@ if $@; + } + + my @members = map $_->email_address, + $new->mailinglist->mailinglistmember; + + #real-time here, presuming CGP does some dup detection + eval { $self->communigate_pro_runcommand( + 'SetGroup', $newGroupName, + { 'RealName' => $new->listname, + 'SetReplyTo' => ( $new->reply_to ? 'YES' : 'NO' ), + 'RemoveAuthor' => ( $new->remove_from ? 'YES' : 'NO' ), + 'RejectAuto' => ( $new->reject_auto ? 'YES' : 'NO' ), + 'RemoveToAndCc' => ( $new->remove_to_and_cc ? 'YES' : 'NO' ), + 'Members' => \@members, + } + ); + }; + return $@ if $@; + + ''; + +} + sub _export_delete { my( $self, $svc_x ) = (shift, shift); @@ -418,6 +476,21 @@ sub _export_delete_svc_forward { ); } +sub _export_delete_svc_mailinglist { + my( $self, $svc_mailinglist ) = (shift, shift); + + #real-time here, presuming CGP does some dup detection + eval { $self->communigate_pro_runcommand( + 'DeleteGroup', + $svc_mailinglist->username.'@'.$svc_mailinglist->domain, + ); + }; + return $@ if $@; + + ''; + +} + sub _export_suspend { my( $self, $svc_x ) = (shift, shift); @@ -479,6 +552,20 @@ sub _export_unsuspend_svc_domain { } +sub export_mailinglistmember_insert { + my( $self, $svc_mailinglist, $mailinglistmember ) = (shift, shift, shift); + $svc_mailinglist->replace(); +} + +sub export_mailinglistmember_replace { + my( $self, $svc_mailinglist, $new, $old ) = (shift, shift, shift, shift); + die "no way to do this from the UI right now"; +} + +sub export_mailinglistmember_delete { + my( $self, $svc_mailinglist, $mailinglistmember ) = (shift, shift, shift); + $svc_mailinglist->replace(); +} sub export_getsettings { my($self, $svc_x) = (shift, shift); @@ -647,6 +734,22 @@ sub export_getsettings_svc_acct { } +sub export_getsettings_svc_mailinglist { + my($self, $svc_mailinglist, $settingsref, $defaultref ) = @_; + + my $settings = eval { $self->communigate_pro_runcommand( + 'GetGroup', + $svc_mailinglist->username.'@'.$svc_mailinglist->domain, + ) }; + return $@ if $@; + + $settings->{'Members'} = join(', ', @{ $settings->{'Members'} } ); + + %{$settingsref} = %$settings; + + ''; +} + sub communigate_pro_queue { my( $self, $svcnum, $method ) = (shift, shift, shift); my $jobnum = ''; #don't actually care diff --git a/FS/FS/part_export/domreg_opensrs.pm b/FS/FS/part_export/domreg_opensrs.pm index a9afc91cc..1799ed09e 100644 --- a/FS/FS/part_export/domreg_opensrs.pm +++ b/FS/FS/part_export/domreg_opensrs.pm @@ -1,8 +1,7 @@ package FS::part_export::domreg_opensrs; -use vars qw(@ISA %info %options $conf $me $DEBUG); +use vars qw(@ISA %info %options $conf); use Tie::IxHash; -use DateTime; use FS::Record qw(qsearchs qsearch); use FS::Conf; use FS::part_export::null; @@ -39,8 +38,6 @@ gateway when setting up this export. =cut @ISA = qw(FS::part_export::null); -$me = '[' . __PACKAGE__ . ']'; -$DEBUG = 1; my @tldlist = qw/com net org biz info name mobi at be ca cc ch cn de dk es eu fr it mx nl tv uk us/; @@ -53,10 +50,6 @@ tie %options, 'Tie::IxHash', }, 'masterdomain' => { label => 'Master domain at OpenSRS', }, - 'wait_for_pay' => { label => 'Do not provision until payment is received', - type => 'checkbox', - default => '0', - }, 'debug_level' => { label => 'Net::OpenSRS debug level', type => 'select', options => [ 0, 1, 2, 3 ], @@ -220,7 +213,6 @@ sub testmode { return 'live' if $self->machine eq "rr-n1-tor.opensrs.net"; return 'test' if $self->machine eq "horizon.opensrs.net"; undef; - } =item _export_insert @@ -249,20 +241,6 @@ sub _export_insert { return "Unknown domain action " . $svc_domain->action; } -sub _export_insert_on_payment { - my( $self, $svc_domain ) = ( shift, shift ); - warn "$me:_export_insert_on_payment called\n" if $DEBUG; - return '' unless $self->option('wait_for_pay'); - - my $queue = new FS::queue { - 'svcnum' => $svc_domain->svcnum, - 'job' => 'FS::part_export::domreg_opensrs::renew_through', - }; - $queue->insert( $self, $svc_domain ); #_export_insert with 'R' action? - - return ''; -} - ## Domain registration exports do nothing on replace. Mainly because we haven't decided what they should do. #sub _export_replace { # my( $self, $new, $old ) = (shift, shift, shift); @@ -398,11 +376,10 @@ sub register { my $srs = $self->get_srs; -# cookie not required for registration -# my $cookie = $srs->get_cookie( $self->option('masterdomain') ); -# if (!$cookie) { -# return "Unable to get cookie at OpenSRS: " . $srs->last_response(); -# } + my $cookie = $srs->get_cookie( $self->option('masterdomain') ); + if (!$cookie) { + return "Unable to get cookie at OpenSRS: " . $srs->last_response(); + } # return "Domain registration not enabled" if !$self->option('register'); return $srs->last_response() if !$srs->register_domain( $svc_domain->domain, $c); @@ -477,84 +454,6 @@ sub renew { return ''; # Should only get here if renewal succeeded } -=item renew_through [ EPOCH_DATE ] - -Attempts to renew the domain through the specified date. If no date is -provided it is gleaned from the associated cust_pkg bill date - -Like most export functions, returns an error message on failure or undef on success. - -=cut - -sub renew_through { - my ( $self, $svc_domain, $date ) = @_; - - warn "$me: renew_through called\n" if $DEBUG; - eval "use Net::OpenSRS;"; - return $@ if $@; - - unless ( $date ) { - my $cust_pkg = $svc_domain->cust_svc->cust_pkg; - return "Can't renew: no date specified and domain is not in a package." - unless $cust_pkg; - $date = $cust_pkg->bill; - } - - my $err = $self->is_supported_domain( $svc_domain ); - return $err if $err; - - warn "$me: checking status\n" if $DEBUG; - my $rv = $self->get_status($svc_domain); - return "Domain ". $svc_domain->domain. " is not renewable" - unless $rv->{expdate}; - - return "Can't parse expiration date for ". $svc_domain->domain - unless $rv->{expdate} =~ /^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})/; - - my ($year,$month,$day,$hour,$minute,$second) = ($1,$2,$3,$4,$5,$6); - my $exp = DateTime->new( year => $year, - month => $month, - day => $day, - hour => $hour, - minute => $minute, - second => $second, - time_zone => 'America/New_York',#timezone of opensrs - ); - - my $bill = DateTime-> - from_epoch( 'epoch' => $date, - 'time_zone' => DateTime::TimeZone->new( name => 'local' ), - ); - - my $years = 0; - while ( DateTime->compare( $bill, $exp ) > 0 ) { - $years++; - $exp->add( 'years' => 1 ); - - return "Can't renew ". $svc_domain->domain. " for more than 10 years." - if $years > 10; #no infinite loop - } - - warn "$me: renewing ". $svc_domain->domain. "for $years years\n" if $DEBUG; - my $srs = $self->get_srs; - $rv = $srs->make_request( - { - action => 'renew', - object => 'domain', - attributes => { - domain => $svc_domain->domain, - auto_renew => 0, - handle => 'process', - period => $years, - currentexpirationyear => $year, - } - } - ); - return $rv->{response_text} unless $rv->{is_success}; - - return ''; # Should only get here if renewal succeeded -} - =item revoke Attempts to revoke the domain registration. Only succeeds if invoked during the OpenSRS diff --git a/FS/FS/part_export/indosoft.pm b/FS/FS/part_export/indosoft.pm new file mode 100644 index 000000000..b5734019b --- /dev/null +++ b/FS/FS/part_export/indosoft.pm @@ -0,0 +1,219 @@ +package FS::part_export::indosoft; + +use vars qw(@ISA %info $insert_hack); +use Tie::IxHash; +use Date::Format; +use FS::part_export; + +@ISA = qw(FS::part_export); + +tie my %options, 'Tie::IxHash', + 'url' => { label => 'Voicebridge API URL' }, + 'account_id' => { label => 'Voicebridge Account ID' }, +; + +%info = ( + 'svc' => 'svc_phone', #svc_bridge? svc_confbridge? + 'desc' => + 'Export conferences to the Indosoft Conference Bridge', + 'options' => \%options, + 'notes' => <<'END' +Export conferences to the Indosoft conference bridge. +Net::Indosoft::Voicebridge is required. +END +); + +$insert_hack = 0; + +sub rebless { shift; } + +sub _export_insert { + my($self, $svc_phone) = (shift, shift); + + my $cust_main = $svc_phone->cust_svc->cust_pkg->cust_main; + + my $address = $cust_main->address1; + $address .= ' '.$cust_main->address2 if $cust_main->address2; + + my $phone = $cust_main->daytime || $cust_main->night; + + my @email = $cust_main->invoicing_list_emailonly; + + #svc_phone->location_hash stuff? well that was for e911.. this shouldn't + # even be svc_phone + + #add client + my $client_return = eval { + indosoft_runcommand( 'addClient', + 'account_id' => $self->option('account_id'), + + 'client_contact_name' => $cust_main->name, #or just first last? + 'client_contact_password' => $svc_phone->sip_password, # ? + + 'client_contact_addr' => $address, + 'client_contact_city' => $cust_main->city, + 'client_contact_state' => $cust_main->state, + 'client_contact_country' => $cust_main->country, + 'client_contact_zip' => $cust_main->zip, + + 'client_contact_phone' => $phone, + 'client_contact_fax' => $cust_main->fax, + 'client_contact_email' => $email[0], + ); + }; + return $@ if $@; + + my $client_id = $client_return->{client_id}; + + #add conference + my $conf_return = eval { + indosoft_runcommand( 'addConference', + 'client_id' => $client_id, + 'conference_name' => $cust_main->name, + 'conference_desc' => $svc_phone->svcnum. ' for '. $cust_main->name, + 'start_time' => time2str('%Y-%d-$m %T', time), #now, right?? '2010-20-04 16:20:00', + #'moderated_flag' => 0, + #'entry_ann_flag' => 0 + #'record_flag' => 0 + #'moh_flag' => 0 + #'talk_detect_flag' => 0 + #'play_user_cnt_flag' => 0 + #'wait_for_admin' => 0 + #'stop_on_admin_exit' => 0 + #'second_pin' => 0 + #'secondary_pin' => 0, + #'allow_sub-conf' => 0, + #'duration' => 0, + #'conference_type' => 'reservation', #'reservationless', + ); + }; + return $@ if $@; + + my $conference_id = $conf_return->{conference_id}; + + #put conference_id in svc_phone.phonenum (and client_id in... phone_name???) + local($insert_hack) = 1; + $svc_phone->phonenum($conference_id); + $svc_phone->phone_name($client_id); + #my $error = $svc_phone->replace; + #return $error if $error; + $svc_phone->replace; + +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + return "can't change phone number as conference_id with indosoft" + if $old->phonenum ne $new->phonenum && ! $insert_hack; + return ''; + + #change anything? +} + +sub _export_delete { + my( $self, $svc_phone ) = (shift, shift); + + #delete conference + my $conf_return = eval { + indosoft_runcommand( 'deleteConference', + 'conference_id' => $svc_phone->phonenum, + ); + }; + return $@ if $@; + + #delete client + my $client_return = eval { + indosoft_runcommand( 'deleteClient', + 'client_id' => $svc_phone->phone_name, + ) + }; + return $@ if $@; + + ''; + +} + +# #these three are optional +# # fallback for svc_acct will change and restore password +# sub _export_suspend { +# my( $self, $svc_phone ) = (shift, shift); +# $err_or_queue = $self->indosoft_queue( $svc_phone->svcnum, +# 'suspend', $svc_phone->username ); +# ref($err_or_queue) ? '' : $err_or_queue; +# } +# +# sub _export_unsuspend { +# my( $self, $svc_phone ) = (shift, shift); +# $err_or_queue = $self->indosoft_queue( $svc_phone->svcnum, +# 'unsuspend', $svc_phone->username ); +# ref($err_or_queue) ? '' : $err_or_queue; +# } +# +# sub export_links { +# my($self, $svc_phone, $arrayref) = (shift, shift, shift); +# #push @$arrayref, qq!<A HREF="http://example.com/~!. $svc_phone->username. +# # qq!">!. $svc_phone->username. qq!</A>!; +# ''; +# } + +### + +sub indosoft_runcommand { + my( $self, $method ) = (shift, shift); + + indosoft_command( + $self->option('url'), + $method, + @_, + ); + +} + +sub indosoft_command { + my( $url, $method, @args ) = @_; + + eval 'use Net::Indosoft::Voicebridge;'; + die $@ if $@; + + my $vb = new Net::Indosoft::Voicebridge( 'url' => $url ); + + my $return = $vb->$method( @args ); + + die "Indosoft error: ". $return->{'error'} if $return->{'error'}; + + $return; + +} + + +# #a good idea to queue anything that could fail or take any time +# sub indosoft_queue { +# my( $self, $svcnum, $method ) = (shift, shift, shift); +# my $queue = new FS::queue { +# 'svcnum' => $svcnum, +# 'job' => "FS::part_export::indosoft::indosoft_$method", +# }; +# $queue->insert( @_ ) or $queue; +# } +# +# sub indosoft_insert { #subroutine, not method +# my( $username, $password ) = @_; +# #do things with $username and $password +# } +# +# sub indosoft_replace { #subroutine, not method +# } +# +# sub indosoft_delete { #subroutine, not method +# my( $username ) = @_; +# #do things with $username +# } +# +# sub indosoft_suspend { #subroutine, not method +# } +# +# sub indosoft_unsuspend { #subroutine, not method +# } + + +1; diff --git a/FS/FS/part_export/prizm.pm b/FS/FS/part_export/prizm.pm index 02e89c6d3..6a0554b6c 100644 --- a/FS/FS/part_export/prizm.pm +++ b/FS/FS/part_export/prizm.pm @@ -206,29 +206,6 @@ sub _export_insert { # } # } -# here we cope with a problem of prizm failing to insert for reason -# of duplicate mac addr, but doing so inconsistently... a race in prizm? - - $self->prizm_command( 'CustomerIfService', 'removeElementFromCustomer', - 0, - $cust_main->custnum, - 0, - $svc->mac_addr, - ); - - $err_or_som = $self->prizm_command( 'NetworkIfService', 'getPrizmElements', - [ 'MAC Address' ], - [ $svc->mac_addr ], - [ '=' ], - ); - if ( ref($err_or_som) && $err_or_som->result->[0] ) { # ignore errors - $self->prizm_command( 'NetworkIfService', 'deleteElement', - $err_or_som->result->[0], - 1, - ); - } -# end of coping - my $performance_profile = $svc->performance_profile; $performance_profile ||= $svc->cust_svc->cust_pkg->part_pkg->pkg; diff --git a/FS/FS/part_export/thirdlane.pm b/FS/FS/part_export/thirdlane.pm index bb18dd4fd..60c099748 100644 --- a/FS/FS/part_export/thirdlane.pm +++ b/FS/FS/part_export/thirdlane.pm @@ -157,7 +157,7 @@ sub _export_replace { if ( $old->pbxsvc ) { my $result = $self->_thirdlane_command( 'asterisk::rpc_did_unassign', - $self->_thirdlane_did($svc_x), + $self->_thirdlane_did($old), ); $result eq '0' or return 'Thirdlane API failure (rpc_did_unassign)'; } @@ -165,7 +165,7 @@ sub _export_replace { if ( $new->pbxsvc ) { my $result = $self->_thirdlane_command( 'asterisk::rpc_did_assign', - $self->_thirdlane_did($svc_x), + $self->_thirdlane_did($new), $new->pbx_title, ); $result eq '0' or return 'Thirdlane API failure (rpc_did_assign)'; @@ -190,7 +190,7 @@ sub _export_replace { ''; #we don't care then } else { - die "guru meditation #11: $svc_x is not FS::svc_pbx, FS::svc_phone or FS::svc_acct"; + die "guru meditation #11: $new is not FS::svc_pbx, FS::svc_phone or FS::svc_acct"; } } @@ -278,11 +278,11 @@ sub _thirdlane_command { } sub _thirdlane_did { - my($self, $svc_x) = @_; + my($self, $svc_phone) = @_; if ( $self->option('omit_countrycode') ) { - $svc_x->phonenum; + $svc_phone->phonenum; } else { - $svc_x->countrycode. $svc_x->phonenum; + $svc_phone->countrycode. $svc_phone->phonenum; } } diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 46f4e7241..276889d62 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -1179,6 +1179,18 @@ sub calc_units { 0; } #fallback for everything except bulk.pm sub hide_svc_detail { 0; } +=item recur_cost_permonth CUST_PKG + +recur_cost divided by freq (only supported for monthly and longer frequencies) + +=cut + +sub recur_cost_permonth { + my($self, $cust_pkg) = @_; + return 0 unless $self->freq =~ /^\d+$/ && $self->freq > 0; + sprintf('%.2f', $self->recur_cost / $self->freq ); +} + =item format OPTION DATA Returns data formatted according to the function 'format' described diff --git a/FS/FS/part_pkg/voip_cdr.pm b/FS/FS/part_pkg/voip_cdr.pm index 0c87581ed..38e5941a9 100644 --- a/FS/FS/part_pkg/voip_cdr.pm +++ b/FS/FS/part_pkg/voip_cdr.pm @@ -535,6 +535,9 @@ sub calc_usage { # length($cdr->billsec) ? $cdr->billsec : $cdr->duration; $seconds = $use_duration ? $cdr->duration : $cdr->billsec; + $seconds -= $rate_detail->conn_sec; + $seconds = 0 if $seconds < 0; + $seconds += $granularity - ( $seconds % $granularity ) if $seconds # don't granular-ize 0 billsec calls (bills them) && $granularity; # 0 is per call @@ -546,12 +549,15 @@ sub calc_usage { $included_min{$regionnum} -= $minutes; + $charge = sprintf('%.2f', $rate_detail->conn_charge); + if ( $included_min{$regionnum} < 0 ) { my $charge_min = 0 - $included_min{$regionnum}; #XXX should preserve #(display?) this $included_min{$regionnum} = 0; - $charge = sprintf('%.2f', ( $rate_detail->min_charge * $charge_min ) - + 0.00000001 ); #so 1.005 rounds to 1.01 + $charge += sprintf('%.2f', ($rate_detail->min_charge * $charge_min) + + 0.00000001 ); #so 1.005 rounds to 1.01 + $charge = sprintf('%.2f', $charge); $charges += $charge; } diff --git a/FS/FS/pay_batch.pm b/FS/FS/pay_batch.pm index 6a2755494..59ff2c3a0 100644 --- a/FS/FS/pay_batch.pm +++ b/FS/FS/pay_batch.pm @@ -272,12 +272,11 @@ sub import_results { }; push @all_values, [ $csv->fields(), $line ]; }elsif ($filetype eq 'fixed'){ - my @values = ( $line =~ /$formatre/ ); + my @values = ( $line =~ /$formatre/, $line ); unless (@values) { $dbh->rollback if $oldAutoCommit; return "can't parse: ". $line; }; - push @values, $line; push @all_values, \@values; }else{ $dbh->rollback if $oldAutoCommit; diff --git a/FS/FS/pay_batch/RBC.pm b/FS/FS/pay_batch/RBC.pm index 26ff95971..daf6548da 100644 --- a/FS/FS/pay_batch/RBC.pm +++ b/FS/FS/pay_batch/RBC.pm @@ -14,7 +14,7 @@ $name = 'RBC'; %import_info = ( 'filetype' => 'fixed', 'formatre' => - '^(.).{18}(.{4}).{3}(.).{11}(.{19}).{6}(.{30}).{17}(.{9})(.{18}).{6}(.{14}).{23}(.).{9}\r?$', + '^(.).{18}(.{4}).{3}(.).{11}(.{19}).{6}(.{30}).{17}(.{9})(.{18}).{6}(.{14}).{23}(.).{9}$', 'fields' => [ qw( recordtype batchnum diff --git a/FS/FS/phone_device.pm b/FS/FS/phone_device.pm index ba765e026..914f735b6 100644 --- a/FS/FS/phone_device.pm +++ b/FS/FS/phone_device.pm @@ -97,7 +97,7 @@ sub insert { return $error; } - $self->export('device_insert'); + $self->svc_phone->export('device_insert', $self); #call device export $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -124,7 +124,7 @@ sub delete { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - $self->export('device_delete'); + $self->svc_phone->export('device_delete', $self); #call device export my $error = $self->SUPER::delete; if ( $error ) { @@ -167,7 +167,7 @@ sub replace { return $error; } - $new->export('device_replace', $old); + $new->svc_phone->export('device_replace', $new, $old); #call device export $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -227,64 +227,6 @@ sub svc_phone { qsearchs( 'svc_phone', { 'svcnum' => $self->svcnum } ); } -=item export HOOK [ EXPORT_ARGS ] - -Runs the provided export hook (i.e. "device_insert") for this service. - -=cut - -sub export { - my( $self, $method ) = ( shift, shift ); - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $svc_phone = $self->svc_phone; - my $error = $svc_phone->export($method, $self, @_); #call device export - if ( $error ) { #netsapiens at least - $dbh->rollback if $oldAutoCommit; - return "error exporting $method event to svc_phone ". $svc_phone->svcnum. - " (transaction rolled back): $error"; - } - - $method = "export_$method" unless $method =~ /^export_/; - - foreach my $part_export ( $self->part_device->part_export ) { - next unless $part_export->can($method); - my $error = $part_export->$method($svc_phone, $self, @_); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error exporting $method event to ". $part_export->exporttype. - " (transaction rolled back): $error"; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - -=item export_links - -Returns a list of html elements associated with this device's exports. - -=cut - -sub export_links { - my $self = shift; - my $return = []; - $self->export('export_device_links', $return); - $return; -} - =back =head1 BUGS diff --git a/FS/FS/prepay_credit.pm b/FS/FS/prepay_credit.pm index e5773aebd..302ba37c7 100644 --- a/FS/FS/prepay_credit.pm +++ b/FS/FS/prepay_credit.pm @@ -136,7 +136,7 @@ sub agent { =over 4 -=item generate NUM TYPE LENGTH HASHREF +=item generate NUM TYPE HASHREF Generates the specified number of prepaid cards. Returns an array reference of the newly generated card identifiers, or a scalar error message. @@ -145,12 +145,11 @@ the newly generated card identifiers, or a scalar error message. #false laziness w/agent::generate_reg_codes sub generate { - my( $num, $type, $length, $hashref ) = @_; + my( $num, $type, $hashref ) = @_; my @codeset = (); push @codeset, ( 'A'..'Z' ) if $type =~ /alpha/; push @codeset, ( '1'..'9' ) if $type =~ /numeric/; - $length ||= 8; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -164,11 +163,11 @@ sub generate { my $dbh = dbh; my $condup = 0; #don't retry forever - + my @cards = (); for ( 1 ... $num ) { - my $identifier = join('', map($codeset[int(rand $#codeset)], (1..$length) ) ); + my $identifier = join('', map($codeset[int(rand $#codeset)], (0..7) ) ); redo if qsearchs('prepay_credit',{identifier=>$identifier}) && $condup++<23; $condup = 0; diff --git a/FS/FS/rate_detail.pm b/FS/FS/rate_detail.pm index b7b23babe..f6cdedf6e 100644 --- a/FS/FS/rate_detail.pm +++ b/FS/FS/rate_detail.pm @@ -232,6 +232,31 @@ sub granularities { %granularities; } +=item conn_secs + + Returns an (ordered) hash of conn_sec => name pairs + +=cut + +tie my %conn_secs, 'Tie::IxHash', + '0' => 'connection', + '1' => 'first second', + '6' => 'first 6 seconds', + '30' => 'first 30 seconds', # '1/2 minute', + '60' => 'first minute', + '120' => 'first 2 minutes', + '180' => 'first 3 minutes', + '300' => 'first 5 minutes', +; + +sub conn_secs { + %conn_secs; +} + +=item process_edit_import + +=cut + use Storable qw(thaw); use Data::Dumper; use MIME::Base64; @@ -311,6 +336,10 @@ sub process_edit_import { } +=item edit_import + +=cut + #false laziness w/ #FS::Record::batch_import, grep "edit_import" for differences #could be turned into callbacks or something use Text::CSV_XS; @@ -569,8 +598,6 @@ sub edit_import { } - - =back =head1 BUGS diff --git a/FS/FS/reason.pm b/FS/FS/reason.pm index 5311ec5aa..377da4985 100644 --- a/FS/FS/reason.pm +++ b/FS/FS/reason.pm @@ -114,60 +114,6 @@ sub reasontype { qsearchs( 'reason_type', { 'typenum' => shift->reason_type } ); } -# _upgrade_data -# -# Used by FS::Upgrade to migrate to a new database. -# -# - -sub _upgrade_data { # class method - my ($self, %opts) = @_; - my $dbh = dbh; - - warn "$me upgrading $self\n" if $DEBUG; - - my $column = dbdef->table($self->table)->column('reason'); - unless ($column->type eq 'text') { # assume history matches main table - - # ideally this would be supported in DBIx-DBSchema and friends - warn "$me Shifting reason column to type 'text'\n" if $DEBUG; - foreach my $table ( $self->table, 'h_'. $self->table ) { - my @sql = (); - - $column = dbdef->table($self->table)->column('reason'); - my $columndef = $column->line($dbh); - $columndef =~ s/varchar\(\d+\)/text/i; - - if ( $dbh->{Driver}->{Name} eq 'Pg' ) { - - my $notnull = $columndef =~ s/not null//i; - push @sql,"ALTER TABLE $table RENAME reason TO freeside_upgrade_reason"; - push @sql,"ALTER TABLE $table ADD $columndef"; - push @sql,"UPDATE $table SET reason = freeside_upgrade_reason"; - push @sql,"ALTER TABLE $table ALTER reason SET NOT NULL" - if $notnull; - push @sql,"ALTER TABLE $table DROP freeside_upgrade_reason"; - - } elsif ( $dbh->{Driver}->{Name} =~ /^mysql/i ){ - - #crap, this isn't working - #push @sql,"ALTER TABLE $table MODIFY reason ". $column->line($dbh); - warn "WARNING: reason table upgrade not yet supported for mysql, sorry"; - - } else { - die "watchu talkin' 'bout, Willis? (unsupported database type)"; - } - - foreach (@sql) { - my $sth = $dbh->prepare($_) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - } - } - } - - ''; - -} =back =head1 BUGS diff --git a/FS/FS/reason_type.pm b/FS/FS/reason_type.pm index 4425c64a0..482ea34e8 100644 --- a/FS/FS/reason_type.pm +++ b/FS/FS/reason_type.pm @@ -162,7 +162,9 @@ sub _populate_initial_data { # class method # my $error = $object->insert(); # die "error inserting $self into database: $error\n" # if $error; - $conf->set($_, $object->typenum); +# # or clause for 1.7.x + $conf->set($_, $object->typenum) + or die "failed setting config"; } ''; diff --git a/FS/FS/svc_mailinglist.pm b/FS/FS/svc_mailinglist.pm new file mode 100644 index 000000000..ba297eedc --- /dev/null +++ b/FS/FS/svc_mailinglist.pm @@ -0,0 +1,330 @@ +package FS::svc_mailinglist; + +use strict; +use base qw( FS::svc_Domain_Mixin FS::svc_Common ); +use Scalar::Util qw( blessed ); +use FS::Record qw( qsearchs dbh ); # qsearch ); +use FS::svc_domain; +use FS::mailinglist; + +=head1 NAME + +FS::svc_mailinglist - Object methods for svc_mailinglist records + +=head1 SYNOPSIS + + use FS::svc_mailinglist; + + $record = new FS::svc_mailinglist \%hash; + $record = new FS::svc_mailinglist { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::svc_mailinglist object represents a mailing list customer service. +FS::svc_mailinglist inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item svcnum + +primary key + +=item username + +username + +=item domsvc + +domsvc + +=item listnum + +listnum + +=item reply_to_group + +reply_to_group + +=item remove_author + +remove_author + +=item reject_auto + +reject_auto + +=item remove_to_and_cc + +remove_to_and_cc + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'svc_mailinglist'; } + +sub table_info { + { + 'name' => 'Mailing list', + 'display_weight' => 80, + 'cancel_weight' => 55, + 'fields' => { + 'username' => { 'label' => 'List address', + 'disable_default' => 1, + 'disable_fixed' => 1, + 'disable_inventory' => 1, + }, + 'domsvc' => { 'label' => 'List address domain', + 'disable_inventory' => 1, + }, + 'domain' => 'List address domain', + 'listnum' => { 'label' => 'List name', + 'disable_inventory' => 1, + }, + 'listname' => 'List name', #actually mailinglist.listname + 'reply_to' => { 'label' => 'Reply-To list', + 'type' => 'checkbox', + 'disable_inventory' => 1, + 'disable_select' => 1, + }, + 'remove_from' => { 'label' => 'Remove From: from messages', + 'type' => 'checkbox', + 'disable_inventory' => 1, + 'disable_select' => 1, + }, + 'reject_auto' => { 'label' => 'Reject automatic messages', + 'type' => 'checkbox', + 'disable_inventory' => 1, + 'disable_select' => 1, + }, + 'remove_to_and_cc' => { 'label' => 'Remove To: and Cc: from messages', + 'type' => 'checkbox', + 'disable_inventory' => 1, + 'disable_select' => 1, + }, + }, + }; +} + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub insert { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error; + + #attach to existing lists? sound scary + #unless ( $self->listnum ) { + my $mailinglist = new FS::mailinglist { + 'listname' => $self->get('listname'), + }; + $error = $mailinglist->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $self->listnum($mailinglist->listnum); + #} + + $error = $self->SUPER::insert(@_); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} + +=item delete + +Delete this record from the database. + +=cut + +sub delete { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->mailinglist->delete || $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +sub replace { + my $new = shift; + + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $new->replace_old; + + return "can't change listnum" if $old->listnum != $new->listnum; #? + + my %options = @_; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + if ( $new->get('listname') && $new->get('listname') ne $old->listname ) { + my $mailinglist = $old->mailinglist; + $mailinglist->listname($new->get('listname')); + my $error = $mailinglist->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error if $error; + } + } + + my $error = $new->SUPER::replace($old, %options); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error if $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; #no error + + +} + +=item check + +Checks all fields to make sure this is a valid record. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('svcnum') + || $self->ut_text('username') + || $self->ut_foreign_key('domsvc', 'svc_domain', 'svcnum') + #|| $self->ut_foreign_key('listnum', 'mailinglist', 'listnum') + || $self->ut_foreign_keyn('listnum', 'mailinglist', 'listnum') + || $self->ut_enum('reply_to_group', [ '', 'Y' ] ) + || $self->ut_enum('remove_author', [ '', 'Y' ] ) + || $self->ut_enum('reject_auto', [ '', 'Y' ] ) + || $self->ut_enum('remove_to_and_cc', [ '', 'Y' ] ) + ; + return $error if $error; + + return "Can't remove listnum" if $self->svcnum && ! $self->listnum; + + $self->SUPER::check; +} + +=item mailinglist + +=cut + +sub mailinglist { + my $self = shift; + qsearchs('mailinglist', { 'listnum' => $self->listnum } ); +} + +=item listname + +=cut + +sub listname { + my $self = shift; + my $mailinglist = $self->mailinglist; + $mailinglist ? $mailinglist->listname : ''; +} + +=item label + +=cut + +sub label { + my $self = shift; + $self->listname. ' <'. $self->username. '@'. $self->domain. '>'; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/tax_rate.pm b/FS/FS/tax_rate.pm index 45f3f5814..75e72c542 100644 --- a/FS/FS/tax_rate.pm +++ b/FS/FS/tax_rate.pm @@ -502,7 +502,9 @@ given customer (see L<FS::cust_main>) =cut + #hot sub tax_on_tax { + #akshun my $self = shift; my $cust_main = shift; @@ -1263,7 +1265,7 @@ sub _remember_tax_products { if $part_pkg_taxproduct && $part_pkg_taxproduct->data_vendor eq $format; foreach my $option ( $part_pkg->part_pkg_option ) { - next unless $option->optionname =~ /^usage_taxproductnum_(\w)$/; + next unless $option->optionname =~ /^usage_taxproductnum_(\w+)$/; my $class = $1; $part_pkg_taxproduct = $part_pkg->taxproduct($class); @@ -1755,111 +1757,6 @@ sub browse_queries { return ($query, "SELECT COUNT(*) FROM tax_rate $extra_sql"); } -# _upgrade_data -# -# Used by FS::Upgrade to migrate to a new database. -# -# - -sub _upgrade_data { # class method - my ($self, %opts) = @_; - my $dbh = dbh; - - warn "$me upgrading $self\n" if $DEBUG; - - my @column = qw ( tax excessrate usetax useexcessrate fee excessfee - feebase feemax ); - - if ( $dbh->{Driver}->{Name} eq 'Pg' ) { - - eval "use DBI::Const::GetInfoType;"; - die $@ if $@; - - my $major_version = 0; - $dbh->get_info( $GetInfoType{SQL_DBMS_VER} ) =~ /^(\d{2})/ - && ( $major_version = sprintf("%d", $1) ); - - if ( $major_version > 7 ) { - - # ideally this would be supported in DBIx-DBSchema and friends - - foreach my $column ( @column ) { - my $columndef = dbdef->table($self->table)->column($column); - unless ($columndef->type eq 'numeric') { - - warn "updating tax_rate column $column to numeric\n" if $DEBUG; - my $sql = "ALTER TABLE tax_rate ALTER $column TYPE numeric(14,8)"; - my $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - - warn "updating h_tax_rate column $column to numeric\n" if $DEBUG; - $sql = "ALTER TABLE h_tax_rate ALTER $column TYPE numeric(14,8)"; - $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - - } - } - - } elsif ( $dbh->{pg_server_version} =~ /^704/ ) { - - # ideally this would be supported in DBIx-DBSchema and friends - - foreach my $column ( @column ) { - my $columndef = dbdef->table($self->table)->column($column); - unless ($columndef->type eq 'numeric') { - - warn "updating tax_rate column $column to numeric\n" if $DEBUG; - - foreach my $table ( qw( tax_rate h_tax_rate ) ) { - - my $sql = "ALTER TABLE $table RENAME $column TO old_$column"; - my $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - - my $def = dbdef->table($table)->column($column); - $def->type('numeric'); - $def->length('14,8'); - my $null = $def->null; - $def->null('NULL'); - - $sql = "ALTER TABLE $table ADD COLUMN ". $def->line($dbh); - $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - - $sql = "UPDATE $table SET $column = CAST( old_$column AS numeric )"; - $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - - unless ( $null eq 'NULL' ) { - $sql = "ALTER TABLE $table ALTER $column SET NOT NULL"; - $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - } - - $sql = "ALTER TABLE $table DROP old_$column"; - $sth = $dbh->prepare($sql) or die $dbh->errstr; - $sth->execute or die $sth->errstr; - - } - } - } - - } else { - - warn "WARNING: tax_rate table upgrade unsupported for this Pg version\n"; - - } - - } else { - - warn "WARNING: tax_rate table upgrade only supported for Pg 8+\n"; - - } - - ''; - -} - =back =head1 BUGS diff --git a/FS/MANIFEST b/FS/MANIFEST index 365e31854..4755f1f64 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -465,3 +465,14 @@ FS/h_svc_www.pm t/h_svc_www.t FS/location_Mixin.pm t/location_Mixin.t +FS/svc_mailinglist.pm +t/svc_mailinglist.t +FS/mailinglist.pm +t/mailinglist.t +FS/mailinglistmember.pm +t/mailinglistmember.t +FS/part_event/Action/Mixin/credit_pkg.pm +FS/part_event/Action/pkg_agent_credit.pm +FS/part_event/Action/pkg_agent_credit_pkg.pm +FS/part_event/Action/pkg_employee_credit.pm +FS/part_event/Action/pkg_employee_credit_pkg.pm diff --git a/FS/bin/freeside-upgrade b/FS/bin/freeside-upgrade index 97c704c91..f4ff1c28e 100755 --- a/FS/bin/freeside-upgrade +++ b/FS/bin/freeside-upgrade @@ -4,7 +4,7 @@ use strict; use vars qw($opt_d $opt_s $opt_q $opt_v $opt_r); use vars qw($DEBUG $DRY_RUN); use Getopt::Std; -use DBIx::DBSchema 0.31; +use DBIx::DBSchema 0.31; #0.39 use FS::UID qw(adminsuidsetup checkeuid datasrc driver_name); #getsecrets); use FS::CurrentUser; use FS::Schema qw( dbdef dbdef_dist reload_dbdef ); @@ -30,6 +30,11 @@ $FS::UID::callback_hack = 1; my $dbh = adminsuidsetup($user); $FS::UID::callback_hack = 0; +if ( driver_name =~ /^mysql/i ) { #until 0.39 is required above + eval "use DBIx::DBSchema 0.39;"; + die $@ if $@; +} + #needs to match FS::Schema... my $dbdef_file = "%%%FREESIDE_CONF%%%/dbdef.". datasrc; diff --git a/FS/bin/freeside-void-payments b/FS/bin/freeside-void-payments index 8c1f3dbdf..412033ccc 100755 --- a/FS/bin/freeside-void-payments +++ b/FS/bin/freeside-void-payments @@ -34,8 +34,9 @@ elsif($opt{'a'}) { or die "Agent has no payment gateway for method '$method'."; } -if(defined($opt{'X'}) and !qsearchs('reason', { reasonnum => opt{'X'} })) { - die "Cancellation reason not found: '".$opt{'X'}."'"; +if(defined($opt{'X'})) { + die "Cancellation reason not found: '".$opt{'X'}."'" + if(! qsearchs('reason', { reasonnum => $opt{'X'} } ) ); } my ($processor, $login, $password, $action, @bop_options) = @@ -132,21 +133,7 @@ if($opt{'v'}) { } sub usage { - die "Usage:\n\n freeside-void-payments [ options ] user - - options: - -a agentnum use agentnum's gateway information - -g gatewaynum use gatewaynum - -f file read transaction numbers from file - -c use ECHECK gateway instead of CARD - -r reason specify void reason (as a string) - -v be verbose - -s start-date - -e end-date limit by payment return date - -X reasonnum cancel customers whose payments are voided - (specify cancellation reason number) - -"; + die "Usage:\n\n freeside-void-payments [ -f file | [ -s start-date ] [ -e end-date ] ] [ -r 'reason' ] [ -g gatewaynum | -a agentnum ] [ -c ] [ -v ] [ -n ] [-X reasonnum ] user\n"; } __END__ @@ -159,17 +146,10 @@ freeside-void-payments - Automatically void a list of returned payments. =head1 SYNOPSIS - freeside-void-payments [ -f file | [ -s start-date ] [ -e end-date ] ] - [ -r 'reason' ] - [ -g gatewaynum | -a agentnum ] - [ -c ] [ -v ] - [ -X reasonnum ] - user + freeside-void-payments [ -f file | [ -s start-date ] [ -e end-date ] ] [ -r 'reason' ] [ -g gatewaynum | -a agentnum ] [ -c ] [ -v ] [ -n ] user =head1 DESCRIPTION -=pod - Voids payments that were returned by the payment processor. Can be run periodically from crontab or manually after receiving a list of returned payments. Normally this is a meaningful operation only for @@ -182,12 +162,12 @@ generally how the processor will identify them later. -f: Read the list of authorization numbers from the specified file. If they are not from the default payment gateway, -g or -a must be given to identify the gateway. - + If -f is not given, the script will attempt to contact the gateway and download a list of returned transactions. To support this, the Business::OnlinePayment module for the processor must implement - the get_returns() method. For an example, see - Business::OnlinePayment::WesternACH. + the I<get_returns()> method. For an example, see + L<Business::OnlinePayment::WesternACH>. -s, -e: Specify the starting and ending dates for the void list. This has no effect if -f is given. The end date defaults to @@ -195,7 +175,7 @@ generally how the processor will identify them later. -r: The reason for voiding the payments, to be stored in the database. - -g: The FS::payment_gateway number for the gateway that handled + -g: The L<FS::payment_gateway> number for the gateway that handled these payments. If -f is not given, this determines which gateway will be contacted. This overrides -a. @@ -207,9 +187,12 @@ generally how the processor will identify them later. -v: Be verbose. - -X: Automatically cancel all packages belonging to customers whose - payments were returned. Requires a cancellation reasonnum - (from FS::reason). + -X: Automatically cancel all packages belonging to customers whose payments + were returned. Requires a cancellation reasonnum (from L<FS::reason>). + +A warning will be emitted for each transaction that can't be found. +This may happen if it's already been voided, or if the gateway +doesn't match. =head1 EXAMPLE @@ -230,7 +213,7 @@ day at 8:30 every morning: =head1 BUGS -Most payment gateways don't support it. +Most payment gateways don't support it, making the script largely useless. =head1 SEE ALSO diff --git a/FS/t/h_svc_mailinglist.t b/FS/t/h_svc_mailinglist.t new file mode 100644 index 000000000..d75575a81 --- /dev/null +++ b/FS/t/h_svc_mailinglist.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::h_svc_mailinglist; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/export_device.t b/FS/t/mailinglist.t index 4688326a7..45b7dd583 100644 --- a/FS/t/export_device.t +++ b/FS/t/mailinglist.t @@ -1,5 +1,5 @@ BEGIN { $| = 1; print "1..1\n" } END {print "not ok 1\n" unless $loaded;} -use FS::export_device; +use FS::mailinglist; $loaded=1; print "ok 1\n"; diff --git a/FS/t/mailinglistmember.t b/FS/t/mailinglistmember.t new file mode 100644 index 000000000..1ceb2f567 --- /dev/null +++ b/FS/t/mailinglistmember.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::mailinglistmember; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/svc_mailinglist.t b/FS/t/svc_mailinglist.t new file mode 100644 index 000000000..73896da3c --- /dev/null +++ b/FS/t/svc_mailinglist.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::svc_mailinglist; +$loaded=1; +print "ok 1\n"; |