--- /dev/null
+package FS::ClientAPI::Bulk;
+
+use strict;
+
+use vars qw( $DEBUG $cache );
+use Date::Parse;
+use FS::Record qw( qsearchs );
+use FS::Conf;
+use FS::ClientAPI_SessionCache;
+use FS::cust_main;
+use FS::cust_pkg;
+use FS::cust_svc;
+use FS::svc_acct;
+use FS::svc_external;
+use FS::cust_recon;
+use Data::Dumper;
+
+$DEBUG = 1;
+
+sub _cache {
+ $cache ||= new FS::ClientAPI_SessionCache ( {
+ 'namespace' => 'FS::ClientAPI::Agent', #yes, share session_ids
+ } );
+}
+
+sub _izoom_ftp_row_fixup {
+ my $hash = shift;
+
+ my @addr_fields = qw( address1 address2 city state zip );
+ my @fields = ( qw( agent_custid username _password first last ),
+ @addr_fields,
+ map { "ship_$_" } @addr_fields );
+
+ $hash->{$_} =~ s/[&\/\*'"]/_/g foreach @fields;
+
+ #$hash->{action} = '' if $hash->{action} eq 'R'; #unsupported for ftp
+
+ $hash->{refnum} = 1; #ahem
+ $hash->{country} = 'US';
+ $hash->{ship_country} = 'US';
+ $hash->{payby} = 'LECB';
+ $hash->{payinfo} = $hash->{daytime};
+ $hash->{ship_fax} = '' if ( !$hash->{sms} || $hash->{sms} eq 'F' );
+
+ my $has_ship =
+ grep { $hash->{"ship_$_"} &&
+ (! $hash->{$_} || $hash->{"ship_$_"} ne $hash->{$_} )
+ }
+ ( @addr_fields, 'fax' );
+
+ if ( $has_ship ) {
+ foreach ( @addr_fields, qw( first last ) ) {
+ $hash->{"ship_$_"} = $hash->{$_} unless $hash->{"ship_$_"};
+ }
+ }
+
+ delete $hash->{sms};
+
+ '';
+
+};
+
+sub _izoom_ftp_result {
+ my ($hash, $error) = @_;
+ my $cust_main =
+ qsearchs( 'cust_main', { 'agent_custid' => $hash->{agent_custid},
+ 'agentnum' => $hash->{agentnum}
+ }
+ );
+
+ my $custnum = $cust_main ? $cust_main->custnum : '';
+ my @response = ( $hash->{action}, $hash->{agent_custid}, $custnum );
+
+ if ( $error ) {
+ push @response, ( 'ERROR', $error );
+ } else {
+ push @response, ( 'OK', 'OK' );
+ }
+
+ join( ',', @response );
+
+}
+
+sub _izoom_ftp_badaction {
+ "Invalid action: $_[0] record: @_ ";
+}
+
+sub _izoom_soap_row_fixup { _izoom_ftp_row_fixup(@_) };
+
+sub _izoom_soap_result {
+ my ($hash, $error) = @_;
+
+ if ( $hash->{action} eq 'R' ) {
+ if ( $error ) {
+ return "Please check errors:\n $error"; # odd extra space
+ } else {
+ return join(' ', "Everything ok.", $hash->{pkg}, $hash->{adjourn} );
+ }
+ }
+
+ my $pkg = $hash->{pkg} || $hash->{saved_pkg} || '';
+ if ( $error ) {
+ return join(' ', $hash->{agent_custid}, $error );
+ } else {
+ return join(' ', $hash->{agent_custid}, $pkg, $hash->{adjourn} );
+ }
+
+}
+
+sub _izoom_soap_badaction {
+ "Unknown action '$_[13]' ";
+}
+
+my %format = (
+ 'izoom-ftp' => {
+ 'fields' => [ qw ( action agent_custid username _password
+ daytime ship_fax sms first last
+ address1 address2 city state zip
+ pkg adjourn ship_address1 ship_address2
+ ship_city ship_state ship_zip ) ],
+ 'fixup' => sub { _izoom_ftp_row_fixup(@_) },
+ 'result' => sub { _izoom_ftp_result(@_) },
+ 'action' => sub { _izoom_ftp_badaction(@_) },
+ },
+ 'izoom-soap' => {
+ 'fields' => [ qw ( agent_custid username _password
+ daytime first last address1 address2
+ city state zip pkg action adjourn
+ ship_fax sms ship_address1 ship_address2
+ ship_city ship_state ship_zip ) ],
+ 'fixup' => sub { _izoom_soap_row_fixup(@_) },
+ 'result' => sub { _izoom_soap_result(@_) },
+ 'action' => sub { _izoom_soap_badaction(@_) },
+ },
+);
+
+sub processrow {
+ my $p = shift;
+
+ my $session = _cache->get($p->{'session_id'})
+ or return { 'error' => "Can't resume session" }; #better error message
+
+ my $conf = new FS::Conf;
+ my $format = $conf->config('selfservice-bulk_format', $session->{agentnum})
+ || 'izoom-soap';
+ my ( @row ) = @{ $p->{row} };
+
+ warn "processrow called with '". join("' '", @row). "'\n" if $DEBUG;
+
+ return { 'error' => "unknown format: $format" }
+ unless exists $format{$format};
+
+ return { 'error' => "Invalid record record length: ". scalar(@row).
+ "record: @row " #sic
+ }
+ unless scalar(@row) == scalar(@{$format{$format}{fields}});
+
+ my %hash = ( 'agentnum' => $session->{agentnum} );
+ my $error;
+
+ foreach my $field ( @{ $format{ $format }{ fields } } ) {
+ $hash{$field} = shift @row;
+ }
+
+ $error ||= &{ $format{ $format }{ fixup } }( \%hash );
+
+ # put in the fixup routine?
+ if ( 'R' eq $hash{action} ) {
+ warn "processing reconciliation\n" if $DEBUG;
+ $error ||= process_recon($hash{agentnum}, $hash{agent_custid});
+ } elsif ( 'P' eq $hash{action} ) {
+ # do nothing
+ } elsif( 'D' eq $hash{action} ) {
+ $hash{promo_pkg} = 'disk-1-'. $session->{agent};
+ } elsif ( 'S' eq $hash{action} ) {
+ $hash{promo_pkg} = 'disk-2-'. $session->{agent};
+ $hash{saved_pkg} = $hash{pkg};
+ $hash{pkg} = '';
+ } else {
+ $error ||= &{ $format{ $format }{ action } }( @row );
+ }
+
+ warn "processing provision\n" if ($DEBUG && !$error && $hash{action} ne 'R');
+ $error ||= provision( %hash ) unless $hash{action} eq 'R';
+
+ my $result = &{ $format{ $format }{ result } }( \%hash, $error );
+
+ warn "processrow returning '". join("' '", $result, $error). "'\n"
+ if $DEBUG;
+
+ return { 'error' => $error, 'message' => $result };
+
+}
+
+sub provision {
+ my %args = ( @_ );
+
+ delete $args{action};
+
+ my $cust_main =
+ qsearchs( 'cust_main',
+ { map { $_ => $args{$_} } qw ( agent_custid agentnum ) },
+ );
+
+ unless ( $cust_main ) {
+ $cust_main = new FS::cust_main { %args };
+ my $error = $cust_main->insert;
+ return $error if $error;
+ }
+
+ my @pkgs = grep { $_->part_pkg->freq } $cust_main->ncancelled_pkgs;
+ if ( scalar(@pkgs) > 1 ) {
+ return "Invalid account, should not be more then one active package ". #sic
+ "but found: ". scalar(@pkgs). " packages.";
+ }
+
+ my $part_pkg = qsearchs( 'part_pkg', { 'pkg' => $args{pkg} } )
+ or return "Unknown pkgpart: $args{pkg}"
+ if $args{pkg};
+
+
+ my $create_package = $args{pkg};
+ if ( scalar(@pkgs) && $create_package ) {
+ my $pkg = pop(@pkgs);
+
+ if ( $part_pkg->pkgpart != $pkg->pkgpart ) {
+ my @cust_bill_pkg = $pkg->cust_bill_pkg();
+ if ( 1 == scalar(@cust_bill_pkg) ) {
+ my $cbp= pop(@cust_bill_pkg);
+ my $cust_bill = $cbp->cust_bill;
+ $cust_bill->delete(); #really? wouldn't a credit be better?
+ }
+ $pkg->cancel();
+ } else {
+ $create_package = '';
+ $pkg->setfield('adjourn', str2time($args{adjourn}));
+ my $error = $pkg->replace();
+ return $error if $error;
+ }
+ }
+
+ if ( $create_package ) {
+ my $cust_pkg = new FS::cust_pkg ( {
+ 'pkgpart' => $part_pkg->pkgpart,
+ 'adjourn' => str2time( $args{adjourn} ),
+ } );
+
+ my $svcpart = $part_pkg->svcpart('svc_acct');
+
+ my $svc_acct = new FS::svc_acct ( {
+ 'svcpart' => $svcpart,
+ 'username' => $args{username},
+ '_password' => $args{_password},
+ } );
+
+ my $error = $cust_main->order_pkg( cust_pkg => $cust_pkg,
+ svcs => [ $svc_acct ],
+ );
+ return $error if $error;
+ }
+
+ if ( $args{promo_pkg} ) {
+ my $part_pkg =
+ qsearchs( 'part_pkg', { 'promo_code' => $args{promo_pkg} } )
+ or return "unknown pkgpart: $args{promo_pkg}";
+
+ my $svcpart = $part_pkg->svcpart('svc_external')
+ or return "unknown svcpart: svc_external";
+
+ my $cust_pkg = new FS::cust_pkg ( {
+ 'svcpart' => $svcpart,
+ 'pkgpart' => $part_pkg->pkgpart,
+ } );
+
+ my $svc_ext = new FS::svc_external ( { 'svcpart' => $svcpart } );
+
+ my $ticket_subject = 'Send setup disk to customer '. $cust_main->custnum;
+ my $error = $cust_main->order_pkg ( cust_pkg => $cust_pkg,
+ svcs => [ $svc_ext ],
+ noexport => 1,
+ ticket_subject => $ticket_subject,
+ ticket_queue => "disk-$args{agentnum}",
+ );
+ return $error if $error;
+ }
+
+ my $error = $cust_main->bill();
+ return $error if $error;
+}
+
+sub process_recon {
+ my ( $agentnum, $id ) = @_;
+ my @recs = split /;/, $id;
+ my $err = '';
+ foreach my $rec ( @recs ) {
+ my @record = split /,/, $rec;
+ my $result = process_recon_record(@record, $agentnum);
+ $err .= "$result\n" if $result;
+ }
+ return $err;
+}
+
+sub process_recon_record {
+ my ( $agent_custid, $username, $_password, $daytime, $first, $last, $address1, $address2, $city, $state, $zip, $pkg, $adjourn, $agentnum) = @_;
+
+ warn "process_recon_record called with '". join("','", @_). "'\n" if $DEBUG;
+
+ my ($cust_pkg, $package);
+
+ my $cust_main =
+ qsearchs( 'cust_main',
+ { 'agent_custid' => $agent_custid, 'agentnum' => $agentnum },
+ );
+
+ my $comments = '';
+ if ( $cust_main ) {
+ my @cust_pkg = grep { $_->part_pkg->freq } $cust_main->ncancelled_pkgs;
+ if ( scalar(@cust_pkg) == 1) {
+ $cust_pkg = pop(@cust_pkg);
+ $package = $cust_pkg->part_pkg->pkg;
+ $comments = "$agent_custid wrong package, expected: $pkg found: $package"
+ if ( $pkg ne $package );
+ } else {
+ $comments = "invalid account, should be one active package but found: ".
+ scalar(@cust_pkg). " packages.";
+ }
+ } else {
+ $comments =
+ "Customer not found agent_custid=$agent_custid, agentnum=$agentnum";
+ }
+
+ my $cust_recon = new FS::cust_recon( {
+ 'recondate' => time,
+ 'agentnum' => $agentnum,
+ 'first' => $first,
+ 'last' => $last,
+ 'address1' => $address1,
+ 'address2' => $address2,
+ 'city' => $city,
+ 'state' => $state,
+ 'zip' => $zip,
+ 'custnum' => $cust_main ? $cust_main->custnum : '', #really?
+ 'status' => $cust_main ? $cust_main->status : '',
+ 'pkg' => $package,
+ 'adjourn' => $cust_pkg ? $cust_pkg->adjourn : '',
+ 'agent_custid' => $agent_custid, # redundant?
+ 'agent_pkg' => $pkg,
+ 'agent_adjourn' => str2time($adjourn),
+ 'comments' => $comments,
+ } );
+
+ warn Dumper($cust_recon) if $DEBUG;
+ my $error = $cust_recon->insert;
+ return $error if $error;
+
+ warn "process_recon_record returning $comments\n" if $DEBUG;
+
+ $comments;
+
+}
+
+sub check_username {
+ my $p = shift;
+
+ my $session = _cache->get($p->{'session_id'})
+ or return { 'error' => "Can't resume session" }; #better error message
+
+ my $svc_domain = qsearchs( 'svc_domain', { 'domain' => $p->{domain} } )
+ or return { 'error' => 'Unknown domain '. $p->{domain} };
+
+ my $svc_acct = qsearchs( 'svc_acct', { 'username' => $p->{user},
+ 'domsvc' => $svc_domain->svcnum,
+ },
+ );
+
+ return { 'error' => $p->{user}. '@'. $p->{domain}. " alerady in use" } # sic
+ if $svc_acct;
+
+ return { 'error' => '',
+ 'message' => $p->{user}. '@'. $p->{domain}. " is free"
+ };
+}
+
+1;
'section' => 'username',
'description' => 'Usernames must contain at least one letter',
'type' => 'checkbox',
+ 'per_agent' => 1,
},
{
},
{
+ 'key' => 'selfservice-bulk_format',
+ 'section' => '',
+ 'description' => 'Parameter arrangement for selfservice bulk features',
+ 'type' => 'select',
+ 'select_enum' => [ '', 'izoom-soap', 'izoom-ftp' ],
+ 'per_agent' => 1,
+ },
+
+ {
+ 'key' => 'selfservice-bulk_ftp_dir',
+ 'section' => '',
+ 'description' => 'Enable bulk ftp provisioning in this folder',
+ 'type' => 'text',
+ 'per_agent' => 1,
+ },
+
+ {
'key' => 'signup-no_company',
'section' => '',
'description' => "Don't display a field for company name on signup.",
],
},
+ 'cust_recon' => { # what purpose does this serve?
+ 'columns' => [
+ 'reconid', 'serial', '', '', '', '',
+ 'recondate', @date_type, '', '',
+ 'custnum', 'int' , '', '', '', '',
+ 'agentnum', 'int', '', '', '', '',
+ 'last', 'varchar', '', $char_d, '', '',
+ 'first', 'varchar', '', $char_d, '', '',
+ 'address1', 'varchar', '', $char_d, '', '',
+ 'address2', 'varchar', 'NULL', $char_d, '', '',
+ 'city', 'varchar', '', $char_d, '', '',
+ 'state', 'varchar', 'NULL', $char_d, '', '',
+ 'zip', 'varchar', 'NULL', 10, '', '',
+ 'pkg', 'varchar', 'NULL', $char_d, '', '',
+ 'adjourn', @date_type, '', '',
+ 'status', 'varchar', 'NULL', 10, '', '',
+ 'agent_custid', 'varchar', '', $char_d, '', '',
+ 'agent_pkg', 'varchar', 'NULL', $char_d, '', '',
+ 'agent_adjourn', @date_type, '', '',
+ 'comments', 'text', 'NULL', '', '', '',
+ ],
+ 'primary_key' => 'reconid',
+ 'unique' => [],
+ 'index' => [],
+ },
+
#eventually use for billing & ship from cust_main too
#for now, just cust_pkg locations
'cust_location' => {
specific job completes). This can be used to defer provisioning until some
action completes (such as running the customer's credit card successfully).
+=item ticket_subject
+
+Optional subject for a ticket created and attached to this customer
+
+=item ticket_subject
+
+Optional queue name for ticket additions
+
=back
=cut
$svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
+ my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
+ qw( ticket_subject ticket_queue );
+
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
$cust_pkg->custnum( $self->custnum );
- my $error = $cust_pkg->insert;
+ my $error = $cust_pkg->insert( %insert_params );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "inserting cust_pkg (transaction rolled back): $error";
use Scalar::Util qw( blessed );
use List::Util qw(max);
use Tie::IxHash;
+use MIME::Entity;
use FS::UID qw( getotaker dbh );
use FS::Misc qw( send_email );
use FS::Record qw( qsearch qsearchs );
cust_pkg_option records will be created
+=item ticket_subject
+
+a ticket will be added to this customer with this subject
+
+=item ticket_queue
+
+an optional queue name for ticket additions
+
=back
=cut
my $conf = new FS::Conf;
+ if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
+ eval '
+ use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
+ use RT;
+ ';
+ die $@ if $@;
+
+ RT::LoadConfig();
+ RT::Init();
+ my $q = new RT::Queue($RT::SystemUser);
+ $q->Load($options{ticket_queue}) if $options{ticket_queue};
+ my $t = new RT::Ticket($RT::SystemUser);
+ my $mime = new MIME::Entity;
+ $mime->build( Type => 'text/plain', Data => $options{ticket_subject} );
+ $t->Create( $options{ticket_queue} ? (Queue => $q) : (),
+ Subject => $options{ticket_subject},
+ MIMEObj => $mime,
+ );
+ $t->AddLink( Type => 'MemberOf',
+ Target => 'freeside://freeside/cust_main/'. $self->custnum,
+ );
+ }
+
if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
my $queue = new FS::queue {
'job' => 'FS::cust_main::queueable_print',
--- /dev/null
+package FS::cust_recon;
+
+use strict;
+use base qw( FS::Record );
+use FS::Record qw( qsearch qsearchs );
+
+=head1 NAME
+
+FS::cust_recon - Object methods for cust_recon records
+
+=head1 SYNOPSIS
+
+ use FS::cust_recon;
+
+ $record = new FS::cust_recon \%hash;
+ $record = new FS::cust_recon { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::cust_recon object represents a customer reconcilation. FS::cust_recon
+inherits from FS::Record. The following fields are currently supported:
+
+=over 4
+
+=item reconid
+
+primary key
+
+=item recondate
+
+recondate
+
+=item custnum
+
+custnum
+
+=item agentnum
+
+agentnum
+
+=item last
+
+last
+
+=item first
+
+first
+
+=item address1
+
+address1
+
+=item address2
+
+address2
+
+=item city
+
+city
+
+=item state
+
+state
+
+=item zip
+
+zip
+
+=item pkg
+
+pkg
+
+=item adjourn
+
+adjourn
+
+=item status
+
+status
+
+=item agent_custid
+
+agent_custid
+
+=item agent_pkg
+
+agent_pkg
+
+=item agent_adjourn
+
+agent_adjourn
+
+=item comments
+
+comments
+
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new customer reconcilation. To add the reconcilation 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 { 'cust_recon'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+=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 reconcilation. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('reconid')
+ || $self->ut_numbern('recondate')
+ || $self->ut_number('custnum')
+ || $self->ut_number('agentnum')
+ || $self->ut_text('last')
+ || $self->ut_text('first')
+ || $self->ut_text('address1')
+ || $self->ut_textn('address2')
+ || $self->ut_text('city')
+ || $self->ut_textn('state')
+ || $self->ut_textn('zip')
+ || $self->ut_textn('pkg')
+ || $self->ut_numbern('adjourn')
+ || $self->ut_textn('status')
+ || $self->ut_text('agent_custid')
+ || $self->ut_textn('agent_pkg')
+ || $self->ut_numbern('agent_adjourn')
+ || $self->ut_textn('comments')
+ ;
+ return $error if $error;
+
+ $self->SUPER::check;
+}
+
+=back
+
+=head1 BUGS
+
+Possibly the existance of this module.
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
skip_lastapp
);
foreach my $opt (grep !exists($flags{option_cache}->{$_}), @opt ) {
- $flags{option_cache}->{$opt} = $self->option($opt);
+ $flags{option_cache}->{$opt} = $self->option($opt, 1);
}
my %opt = %{ $flags{option_cache} };
;
return $error if $error;
+ my $cust_pkg;
+ local $username_letter = $username_letter;
+ if ($self->svcnum) {
+ my $cust_svc = $self->cust_svc
+ or return "no cust_svc record found for svcnum ". $self->svcnum;
+ my $cust_pkg = $cust_svc->cust_pkg;
+ }
+ if ($self->pkgnum) {
+ $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $self->pkgnum } );#complain?
+ }
+ if ($cust_pkg) {
+ $username_letter =
+ $conf->exists('username-letter', $cust_pkg->cust_main->agentnum);
+ }
+
my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
if ( $username_uppercase ) {
$recref->{username} =~ /^([a-z0-9_\-\.\&\%\:]{$usernamemin,$ulen})$/i
t/tax_rate_location.t
FS/cust_bill_pkg_tax_rate_location.pm
t/cust_bill_pkg_tax_rate_location.t
+FS/cust_recon.pm
+t/cust_recon.t
use FS::UID qw(adminsuidsetup forksuidsetup);
use FS::ClientAPI;
use FS::ClientAPI_SessionCache;
+use FS::Record qw( qsearch qsearchs );
use FS::Conf;
use FS::cust_svc;
+use FS::agent;
$FREESIDE_LOG = "%%%FREESIDE_LOG%%%";
$FREESIDE_LOCK = "%%%FREESIDE_LOCK%%%";
if ( $keepalives && $keepalive_count++ > 10 ) {
$keepalive_count = 0;
lock_write;
+
nstore_fd( { _token => '_keepalive' }, $writer );
+ foreach my $agent ( qsearch( 'agent', { disabled => '' } ) ) {
+ my $config = qsearchs( 'conf', { name => 'selfservice-bulk_ftp_dir',
+ agentnum => $agent->agentnum,
+ } )
+ or next;
+
+ my $session =
+ FS::ClientAPI->dispatch( 'Agent/agent_login',
+ { username => $agent->username,
+ password => $agent->_password,
+ }
+ );
+
+ nstore_fd( { _token => '_ftp_scan',
+ dir => $config->value,
+ session_id => $session->{session_id},
+ },
+ $writer
+ );
+ }
unlock_write;
}
next;
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::cust_recon;
+$loaded=1;
+print "ok 1\n";
SelfService/XMLRPC.pm
test.pl
freeside-selfservice-clientd
+freeside-selfservice-soap-server
freeside-selfservice-xmlrpc-server
'NAME' => 'FS::SelfService',
'VERSION_FROM' => 'SelfService.pm', # finds $VERSION
'EXE_FILES' => [ 'freeside-selfservice-clientd',
+ 'freeside-selfservice-soap-server',
'freeside-selfservice-xmlrpc-server',
],
'INSTALLSCRIPT' => '/usr/local/sbin',
'call_time' => 'PrepaidPhone/call_time',
'call_time_nanpa' => 'PrepaidPhone/call_time_nanpa',
'phonenum_balance' => 'PrepaidPhone/phonenum_balance',
+ 'bulk_processrow' => 'Bulk/processrow',
+ 'check_username' => 'Bulk/check_username',
#sg
'decompify_pkgs' => 'SGNG/decompify_pkgs',
'previous_payment_info' => 'SGNG/previous_payment_info',
use IO::Handle qw(_IONBF);
use IO::Select;
use IO::File;
+use Text::CSV_XS;
#STDOUT->setbuf('');
$|=1;
$SIG{__WARN__} = \&_logmsg;
+#$SIG{__DIE__} = sub { &_logmsg(@_); exit };
#read data to be cached or something
#warn "$me Reading init data\n" if $Debug;
warn "entering main loop\n" if $Debug;
my %kids;
+my %ftp_scan_dir;
+my %ftp_scan_map;
my $s = new IO::Select;
$s->add(\*STDIN);
: '' )
if $Debug;
- if ( exists($kids{$token}) ) {
+ if ( $token eq '_ftp_scan' ) {
+ if ( $ftp_scan_dir{$packet->{dir}} ) {
+ warn "already processing ". $packet->{dir}. "\n" if $Debug;
+ } else {
+ $ftp_scan_dir{$packet->{dir}} = 1;
+ spawn \&ftp_scan, $packet;
+ }
+ $undisp = 1;
+ next;
+ }
+
+ if ( exists($kids{$token}) ) {
warn "sending return packet to $token via $kids{$token}\n"
if $Debug;
nstore_fd($packet, $kids{$token});
#handle some commands weirdly?
$packet->{_token}=$$;
- warn "[child-$$] locking write stream\n" if $Debug > 1;
- lock_write;
-
- warn "[child-$$] sending packet to remote server\n" if $Debug > 1;
- nstore_fd($packet, \*STDOUT) or die "FATAL: can't send response: $!";
-
- warn "[child-$$] flushing write stream\n" if $Debug > 1;
- STDOUT->flush or die "FATAL: can't flush: $!";
-
- warn "[child-$$] releasing write lock\n" if $Debug > 1;
- unlock_write;
+ my $rv = send_and_wait( $packet );
warn "[child-$$] closing write stream\n" if $Debug > 1;
close STDOUT or die "FATAL: can't close write stream: $!"; #??!
- warn "[child-$$] waiting for response from parent\n" if $Debug > 1;
- my $w = new IO::Select;
- $w->add(\*STDIN);
- until ( $w->can_read ) {
- warn "[child-$$] WARNING: interrupted select: $!\n";
- }
- my $rv = fd_retrieve(\*STDIN);
-
#close STDIN;
warn "[child-$$] sending response to local client" if $Debug > 1;
if ( $kid > 0 ) {
close $kids{$kid};
delete $kids{$kid};
+ if ( $ftp_scan_map{$kid} ) {
+ delete($ftp_scan_dir{$ftp_scan_map{$kid}});
+ delete($ftp_scan_map{$kid});
+ }
}
}
#warn "done reaping\n";
}
sub spawn {
- my $coderef = shift;
+ my ( $coderef, $packet ) = ( shift, shift );
unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
use Carp;
return;
} elsif ($pid) {
warn "begat $pid" if $Debug;
+ $ftp_scan_map{$pid} = $packet->{dir} if $coderef == \&ftp_scan;
$kids{$pid} = $kid;
#$kids{$pid}->autoflush;
return; # I'm the parent
# open(STDIN, "<&Client") || die "can't dup client to stdin";
# open(STDOUT, ">&Client") || die "can't dup client to stdout";
# open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
- exit &$coderef();
+ exit &$coderef($packet);
}
sub _logmsg {
close $log;
}
+sub send_and_wait {
+ my $packet = shift;
+
+ warn "[child-$$] locking write stream\n" if $Debug > 1;
+ lock_write;
+
+ warn "[child-$$] sending packet to remote server\n" if $Debug > 1;
+ nstore_fd($packet, \*STDOUT) or die "FATAL: can't send response: $!";
+
+ warn "[child-$$] flushing write stream\n" if $Debug > 1;
+ STDOUT->flush or die "FATAL: can't flush: $!";
+
+ warn "[child-$$] releasing write lock\n" if $Debug > 1;
+ unlock_write;
+
+ warn "[child-$$] waiting for response from parent\n" if $Debug > 1;
+ my $w = new IO::Select;
+ $w->add(\*STDIN);
+ until ( $w->can_read ) {
+ warn "[child-$$] WARNING: interrupted select: $!\n";
+ }
+
+ fd_retrieve(\*STDIN);
+}
+
sub lock_write {
#broken on freebsd?
#flock(STDOUT, LOCK_EX) or die "FATAL: can't lock write stream: $!";
flock(LOCKFILE, LOCK_UN) or die "FATAL: can't unlock $lock_file: $!";
}
+
+sub ftp_scan {
+ my $packet = shift;
+
+ warn "[child-$$] performing ftp scan" if $Debug > 1;
+
+ warn "[child-$$] packet received:\n".
+ join('', map { " $_=>$packet->{$_}\n" } keys %$packet )
+ if $Debug > 2;
+
+ $packet->{_token}=$$;
+
+ my $dir;
+ $packet->{dir} =~ /^(.*)$/ && ($dir = $1); # we trust ourselves
+ opendir(DIR, $dir) or die "failed to open directory $dir: $!\n";
+ my @files = grep(/\.csv$/, readdir(DIR));
+ closedir(DIR);
+
+ foreach my $file ( @files ) {
+ warn "Processing $file ...\n";
+ my $csv = Text::CSV_XS->new();
+ my $err = "";
+ my @records = ();
+ open(CSV, "<$dir/$file") or die "can't open input file for $file: $!\n";
+ open(RESULT, ">$dir/result/$file")
+ or die "can't open result file for $file: $!\n";
+
+ while (<CSV>) {
+ if ( $csv->parse($_) ) {
+ my @columns = $csv->fields();
+ push(@records, \@columns);
+ } else {
+ $err = $csv->error_input;
+ last;
+ }
+ }
+ close(CSV);
+ if ( $err ) {
+ rename("$dir/$file", "$dir/rejected/$file");
+ } else {
+ foreach my $record ( @records ) {
+
+ $packet->{row} = $record;
+ $packet->{_packet} = 'Bulk/processrow';
+ my $result = send_and_wait( $packet );
+
+ if ( $result->{error} ) {
+ my $name;
+ $record->[1] =~ /^(\w+)$/ && ( $name = $1 );
+
+ if ($name) {
+ my $filename = "$dir/rejected/$name";
+ open(REC, ">$filename") or die "can't open $filename: $!\n";
+ print REC join(',', @$record);
+ close REC or die $!;
+ open(ERR, ">$filename.err") or die "can't open $filename.err: $!\n";
+ print ERR $result->{error};
+ close ERR or die $!;
+ }else{
+ warn "bad agent_custid";
+ }
+
+ }
+ print RESULT $result->{message}, "\n";
+ }
+
+ rename("$dir/$file", "$dir/processed/$file");
+ warn "$file processed.\n" if $Debug;
+ }
+ close(RESULT);
+ }
+
+ close STDOUT or die "FATAL: can't close write stream: $!"; #??!
+
+ warn "[child-$$] child exiting" if $Debug > 1;
+ exit;
+
+}
--- /dev/null
+#!/usr/bin/perl -w
+#
+# freeside-selfservice-soap-server
+#
+
+use strict;
+use Fcntl qw(:flock);
+use POSIX;
+use Getopt::Std;
+use SOAP::Transport::HTTP;
+use FS::SelfService;
+
+use vars qw( $opt_p $opt_d $opt_s );
+use vars qw( $DEBUG );
+
+getopts("s:p:d");
+$DEBUG = $opt_d;
+my $tag = $opt_s ? $opt_s : '';
+$tag = ($opt_s ? ':' : '') . $opt_p ? ':'.$opt_p : '';
+
+my $log_file = "/usr/local/freeside/selfservice.soap$tag.log";
+
+my $pid = fork;
+defined($pid) or die "Can't fork to start: $!";
+print "Started daemon with pid $pid\n" if $pid;
+exit if $pid;
+
+POSIX::setsid();
+open STDIN, "/dev/null" or die "Can't get rid of STDIN";
+open STDOUT, ">/dev/null" or die "Can't get rid of STDOUT";
+open STDERR, ">&STDOUT" or die "Can't get rid of STDERR";
+
+$SIG{__WARN__} = \&_logmsg;
+$SIG{__DIE__} = sub { &_logmsg(@_); exit };
+
+my $daemon = SOAP::Transport::HTTP::Daemon
+ ->new($opt_s ? (LocalAddr => $opt_s) : (), LocalPort => $opt_p ? $opt_p : 8080)
+ ->dispatch_to('/usr/local/freeside/SOAP/') #, 'FS::SelfService'
+ ->objects_by_reference('iZoomOnlineProvisionService')
+ ->handle;
+
+warn "Handling request at ", $daemon->url, "\n";
+$daemon->handle;
+
+sub _logmsg {
+ chomp( my $msg = shift );
+ my $log = new IO::File ">>$log_file";
+ flock($log, LOCK_EX);
+ seek($log, 0, 2);
+ print $log "[". scalar(localtime). "] [$$] $msg\n";
+ flock($log, LOCK_UN);
+ close $log;
+}
--- /dev/null
+package iZoomOnlineProvisionService;
+
+use strict;
+
+#BEGIN { push @INC, '/usr/lib/perl/5.8.8/' };
+use FS::SelfService qw( bulk_processrow check_username agent_login );
+
+=begin WSDL
+
+_IN agent_username $string agent username
+_IN agent_password $string agent password
+_IN agent_custid $string customer id in agent system
+_IN username $string customer service username
+_IN password $string customer service password
+_IN daytime $string phone number
+_IN first $string first name
+_IN last $string last name
+_IN address1 $string address line 1
+_IN address2 $string address line 2
+_IN city $string city
+_IN state $string state
+_IN zip $string zip
+_IN pkg $string package name
+_IN action $string one of (R|P|D|S)(reconcile, provision, provision with disk, send disk)
+_IN adjourn $string day to terminate service
+_IN mobile $string mobile phone
+_IN sms $string (T|F) acceptable to send SMS messages to mobile?
+_IN ship_addr1 $string shipping address line 1
+_IN ship_addr2 $string shipping address line 2
+_IN ship_city $string shipping address city
+_IN ship_state $string shipping address state
+_IN ship_zip $string shipping address zip
+_RETURN @string array [status, message]. status is one of OK, ERR
+
+=cut
+
+my $DEBUG = 0;
+
+sub Provision {
+ my $class = shift;
+
+ my $session = agent_login( map { $_ => shift @_ } qw( username password ) );
+ return [ 'ERR', $session->{error} ] if $session->{error};
+
+ my $result =
+ bulk_processrow( session_id => $session->{session_id}, row => [ @_ ] );
+
+ return $result->{error} ? [ 'ERR', $result->{error} ]
+ : [ 'OK', $result->{message} ];
+}
+
+=begin WSDL
+
+_IN agent_username $string agent username
+_IN agent_password $string agent password
+_IN username $string customer service username
+_IN domain $string user domain name
+_RETURN @string [OK|ERR]
+
+=cut
+sub CheckUserName {
+ my $class = shift;
+
+ my $session = agent_login( map { $_ => shift @_ } qw( username password ) );
+ return [ 'ERR', $session->{error} ] if $session->{error};
+
+ my $result = check_username( session_id => $session->{session_id},
+ map { $_ => shift @_ } qw( user domain )
+ );
+
+ return $result->{error} ? [ 'ERR', $result->{error} ]
+ : [ 'OK', $result->{message} ];
+}
+
+1;