diff options
Diffstat (limited to 'FS')
31 files changed, 305 insertions, 454 deletions
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 6756c9c32..660a072b8 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -655,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' => { 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/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_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/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/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/pkg_agent_credit.pm b/FS/FS/part_event/Action/pkg_agent_credit.pm index 250273846..4bcee983b 100644 --- a/FS/FS/part_event/Action/pkg_agent_credit.pm +++ b/FS/FS/part_event/Action/pkg_agent_credit.pm @@ -7,7 +7,7 @@ sub description { 'Credit the agent a specific amount'; } #a little false laziness w/pkg_referral_credit sub do_action { - my( $self, $cust_pkg ) = @_; + my( $self, $cust_pkg, $cust_event ) = @_; my $cust_main = $self->cust_main($cust_pkg); @@ -26,8 +26,9 @@ sub do_action { my $error = $agent_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 ". $agent_cust_main->custnum. " for agent commission: $error" diff --git a/FS/FS/part_event/Action/pkg_employee_credit.pm b/FS/FS/part_event/Action/pkg_employee_credit.pm index 94fc5f3b1..e4913a21f 100644 --- a/FS/FS/part_event/Action/pkg_employee_credit.pm +++ b/FS/FS/part_event/Action/pkg_employee_credit.pm @@ -9,7 +9,7 @@ sub description { 'Credit the ordering employee a specific amount'; } #a little false laziness w/pkg_referral_credit sub do_action { - my( $self, $cust_pkg ) = @_; + my( $self, $cust_pkg, $cust_event ) = @_; my $cust_main = $self->cust_main($cust_pkg); @@ -31,8 +31,9 @@ sub do_action { my $error = $employee_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 ". $employee_cust_main->custnum. " for employee commission: $error" diff --git a/FS/FS/part_event/Action/pkg_referral_credit.pm b/FS/FS/part_event/Action/pkg_referral_credit.pm index da872e7ff..e7c92d650 100644 --- a/FS/FS/part_event/Action/pkg_referral_credit.pm +++ b/FS/FS/part_event/Action/pkg_referral_credit.pm @@ -23,7 +23,7 @@ sub option_fields { } sub do_action { - my( $self, $cust_pkg ) = @_; + my( $self, $cust_pkg, $cust_event ) = @_; my $cust_main = $self->cust_main($cust_pkg); @@ -43,8 +43,9 @@ sub do_action { 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" 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/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/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/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/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/export_device.t b/FS/t/export_device.t deleted file mode 100644 index 4688326a7..000000000 --- a/FS/t/export_device.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::export_device; -$loaded=1; -print "ok 1\n"; |