summaryrefslogtreecommitdiff
path: root/FS
diff options
context:
space:
mode:
Diffstat (limited to 'FS')
-rw-r--r--FS/FS/Setup.pm2
-rw-r--r--FS/FS/UI/Web.pm36
-rw-r--r--FS/FS/cust_bill_ApplicationCommon.pm29
-rw-r--r--FS/FS/export_device.pm136
-rw-r--r--FS/FS/part_device.pm18
-rw-r--r--FS/FS/part_export/dashcs_e911.pm153
-rw-r--r--FS/FS/part_export/domreg_opensrs.pm111
-rw-r--r--FS/FS/part_export/prizm.pm23
-rw-r--r--FS/FS/pay_batch.pm3
-rw-r--r--FS/FS/pay_batch/RBC.pm2
-rw-r--r--FS/FS/phone_device.pm64
-rw-r--r--FS/FS/prepay_credit.pm9
-rw-r--r--FS/FS/reason_type.pm4
-rw-r--r--FS/MANIFEST1
-rwxr-xr-xFS/bin/freeside-void-payments49
-rw-r--r--FS/t/export_device.t5
16 files changed, 37 insertions, 608 deletions
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/UI/Web.pm b/FS/FS/UI/Web.pm
index c9264a044..5e987429c 100644
--- a/FS/FS/UI/Web.pm
+++ b/FS/FS/UI/Web.pm
@@ -362,7 +362,6 @@ setting is supplied, the <B>cust-fields</B> configuration value.
=cut
-
sub cust_fields {
my $record = shift;
warn "FS::UI::Web::cust_fields called for $record ".
@@ -371,9 +370,8 @@ sub cust_fields {
#cust_header(@_) unless @cust_fields; #now need to cache to keep cust_fields
# #override incase we were passed as a sub
-
- my $seen_unlinked = 0;
+ my $seen_unlinked = 0;
map {
if ( $record->custnum ) {
warn " $record -> $_" if $DEBUG > 1;
@@ -385,38 +383,6 @@ sub cust_fields {
} @cust_fields;
}
-=item cust_fields_subs
-
-Returns an array of subroutine references for returning customer field values.
-This is similar to cust_fields, but returns each field's sub as a distinct
-element.
-
-=cut
-
-sub cust_fields_subs {
- my $unlinked_warn = 0;
- return map {
- my $f = $_;
- if( $unlinked_warn++ ) {
- sub {
- my $record = shift;
- if( $record->custnum ) {
- $record->$f(@_);
- }
- else {
- '(unlinked)'
- };
- }
- }
- else {
- sub {
- my $record = shift;
- $record->$f(@_) if $record->custnum;
- }
- }
- } @cust_fields;
-}
-
=item cust_colors
Returns an array of subroutine references (or empty strings) for returning
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/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_export/dashcs_e911.pm b/FS/FS/part_export/dashcs_e911.pm
deleted file mode 100644
index a0c3a6d6a..000000000
--- a/FS/FS/part_export/dashcs_e911.pm
+++ /dev/null
@@ -1,153 +0,0 @@
-package FS::part_export::dashcs_e911;
-
-use strict;
-use vars qw(@ISA %info $me $DEBUG);
-use Tie::IxHash;
-use FS::part_export;
-
-$DEBUG = 0;
-$me = '['.__PACKAGE__.']';
-
-@ISA = qw(FS::part_export);
-
-tie my %options, 'Tie::IxHash',
- 'username' => { label=>'Dash username', },
- '_password' => { label=>'Dash password', },
- 'staging' => { label=>'Staging (test mode)', type=>'checkbox', },
-;
-
-%info = (
- 'svc' => 'svc_phone',
- 'desc' => 'Provision e911 services via Dash Carrier Services',
- 'notes' => 'Provision e911 services via Dash Carrier Services',
- 'options' => \%options,
-);
-
-sub rebless { shift; }
-
-sub _export_insert {
- my($self, $svc_phone) = (shift, shift);
- return 'invalid phonenum' unless $svc_phone->phonenum;
-
- my $opts = { map{ $_ => $self->option($_) } keys %options };
- $opts->{wantreturn} = 1;
-
- my %location_hash = $svc_phone->location_hash;
- my $location = {
- 'address1' => $location_hash{address1},
- 'address2' => $location_hash{address2},
- 'community' => $location_hash{city},
- 'state' => $location_hash{state},
- 'postalcode' => $location_hash{zip},
- };
-
- my $error_or_ref =
- dash_command($opts, 'validateLocation', { 'location' => $location } );
- return $error_or_ref unless ref($error_or_ref);
-
- my $status = $error_or_ref->get_Location->get_status; # hate
- return $status->get_description unless $status->get_code eq 'GEOCODED';
-
- my $cust_pkg = $svc_phone->cust_svc->cust_pkg;
- my $cust_main = $cust_pkg->cust_main if $cust_pkg;
- my $caller_name = $cust_main ? $cust_main->name_short : 'unknown';
-
- my $arg = {
- 'uri' => {
- 'uri' => 'tel:'. $svc_phone->countrycode. $svc_phone->phonenum,
- 'callername' => $caller_name,
- },
- 'location' => $location,
- };
-
- my $error_or_ref = dash_command($opts, 'addLocation', $arg );
- return $error_or_ref unless ref($error_or_ref);
-
- my $id = $error_or_ref->get_Location->get_locationid;
- $self->_export_command('provisionLocation', { 'locationid' => $id });
-}
-
-sub _export_delete {
- my($self, $svc_phone) = (shift, shift);
- return '' unless $svc_phone->phonenum;
-
- my $arg = { 'uri' => 'tel:'. $svc_phone->countrycode. $svc_phone->phonenum };
- $self->_export_queue('removeURI', $arg);
-}
-
-sub _export_suspend {
- my($self) = shift;
- '';
-}
-
-sub _export_unsuspend {
- my($self) = shift;
- '';
-}
-
-sub _export_command {
- my $self = shift;
-
- my $opts = { map{ $_ => $self->option($_) } keys %options };
-
- dash_command($opts, @_);
-
-}
-
-sub _export_replace {
- my($self, $new, $old ) = (shift, shift, shift);
-
- # this could succeed in unprovision but fail to provision
- my $arg = { 'uri' => 'tel:'. $old->countrycode. $old->phonenum };
- $self->_export_command('removeURI', $arg) || $self->_export_insert($new);
-}
-
-#a good idea to queue anything that could fail or take any time
-sub _export_queue {
- my $self = shift;
-
- my $opts = { map{ $_ => $self->option($_) } keys %options };
-
- my $queue = new FS::queue {
- 'job' => "FS::part_export::dashcs_e911::dash_command",
- };
- $queue->insert( $opts, @_ );
-}
-
-sub dash_command {
- my ( $opt, $method, $arg ) = (shift, shift, shift);
-
- warn "$me: dash_command called with method $method\n" if $DEBUG;
-
- my @module = qw(
- Net::DashCS::Interfaces::EmergencyProvisioningService::EmergencyProvisioningPort
- SOAP::Lite
- );
-
- foreach my $module ( @module ) {
- eval "use $module;";
- die $@ if $@;
- }
-
- local *SOAP::Transport::HTTP::Client::get_basic_credentials = sub {
- return ($opt->{'username'}, $opt->{'_password'});
- };
-
- my $service = new Net::DashCS::Interfaces::EmergencyProvisioningService::EmergencyProvisioningPort(
- { deserializer_args => { strict => 0 } }
- );
-
- $service->set_proxy('https://staging-service.dashcs.com/dash-api/soap/emergencyprovisioning/v1')
- if $opt->{'staging'};
-
- my $result = $service->$method($arg);
-
- if (not $result) {
- warn "returning fault: ". $result->get_faultstring if $DEBUG;
- return ''.$result->get_faultstring;
- }
-
- warn "returning ok: $result\n" if $DEBUG;
- return $result if $opt->{wantreturn};
- '';
-}
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/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/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/MANIFEST b/FS/MANIFEST
index e895f0bbe..4755f1f64 100644
--- a/FS/MANIFEST
+++ b/FS/MANIFEST
@@ -99,7 +99,6 @@ FS/part_export/communigate_pro.pm
FS/part_export/communigate_pro_singledomain.pm
FS/part_export/cp.pm
FS/part_export/cyrus.pm
-FS/part_export/dashcs_e911.pm
FS/part_export/domain_shellcommands.pm
FS/part_export/forward_shellcommands.pm
FS/part_export/http.pm
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";
generated by cgit v1.2.1 (git 2.18.0) at 2025-06-15 08:32:22 +0000