[freeside-commits] freeside/fs_selfservice/FS-SelfService freeside-selfservice-soap-server, NONE, 1.1 iZoomOnlineProvisionService.pm, NONE, 1.1 MANIFEST, 1.4, 1.5 Makefile.PL, 1.6, 1.7 SelfService.pm, 1.49, 1.50 freeside-selfservice-clientd, 1.13, 1.14

Jeff Finucane,420,, jeff at wavetail.420.am
Wed May 27 00:50:42 PDT 2009


Update of /home/cvs/cvsroot/freeside/fs_selfservice/FS-SelfService
In directory wavetail.420.am:/tmp/cvs-serv12160/fs_selfservice/FS-SelfService

Modified Files:
	MANIFEST Makefile.PL SelfService.pm 
	freeside-selfservice-clientd 
Added Files:
	freeside-selfservice-soap-server 
	iZoomOnlineProvisionService.pm 
Log Message:
bulk provisioning via ftp and SOAP #5202

--- NEW FILE: freeside-selfservice-soap-server ---
#!/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;
}

Index: Makefile.PL
===================================================================
RCS file: /home/cvs/cvsroot/freeside/fs_selfservice/FS-SelfService/Makefile.PL,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- Makefile.PL	6 Aug 2007 08:46:05 -0000	1.6
+++ Makefile.PL	27 May 2009 07:50:40 -0000	1.7
@@ -5,6 +5,7 @@
     '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',

Index: MANIFEST
===================================================================
RCS file: /home/cvs/cvsroot/freeside/fs_selfservice/FS-SelfService/MANIFEST,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- MANIFEST	6 Aug 2007 08:51:47 -0000	1.4
+++ MANIFEST	27 May 2009 07:50:40 -0000	1.5
@@ -5,4 +5,5 @@
 SelfService/XMLRPC.pm
 test.pl
 freeside-selfservice-clientd
+freeside-selfservice-soap-server
 freeside-selfservice-xmlrpc-server

--- NEW FILE: iZoomOnlineProvisionService.pm ---
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;

Index: SelfService.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/fs_selfservice/FS-SelfService/SelfService.pm,v
retrieving revision 1.49
retrieving revision 1.50
diff -u -d -r1.49 -r1.50
--- SelfService.pm	25 May 2009 01:49:34 -0000	1.49
+++ SelfService.pm	27 May 2009 07:50:40 -0000	1.50
@@ -71,6 +71,8 @@
   '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',

Index: freeside-selfservice-clientd
===================================================================
RCS file: /home/cvs/cvsroot/freeside/fs_selfservice/FS-SelfService/freeside-selfservice-clientd,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- freeside-selfservice-clientd	16 Jul 2006 00:55:05 -0000	1.13
+++ freeside-selfservice-clientd	27 May 2009 07:50:40 -0000	1.14
@@ -13,6 +13,7 @@
 use IO::Handle qw(_IONBF);
 use IO::Select;
 use IO::File;
+use Text::CSV_XS;
 
 #STDOUT->setbuf('');
 
@@ -36,6 +37,7 @@
 $|=1;
 
 $SIG{__WARN__} = \&_logmsg;
+#$SIG{__DIE__} = sub { &_logmsg(@_); exit };
 
 #read data to be cached or something
 #warn "$me Reading init data\n" if $Debug;
@@ -75,6 +77,8 @@
 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);
@@ -124,7 +128,18 @@
              : '' )
         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});
@@ -158,29 +173,11 @@
         #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;
@@ -210,13 +207,17 @@
     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;
@@ -231,6 +232,7 @@
         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
@@ -240,7 +242,7 @@
 #    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 {
@@ -254,6 +256,31 @@
   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: $!";
@@ -270,3 +297,81 @@
 
   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;
+
+}



More information about the freeside-commits mailing list