Merge branch 'patch-20' of https://github.com/gjones2/Freeside
authorIvan Kohler <ivan@freeside.biz>
Sat, 19 Jan 2013 19:31:10 +0000 (11:31 -0800)
committerIvan Kohler <ivan@freeside.biz>
Sat, 19 Jan 2013 19:31:10 +0000 (11:31 -0800)
FS/FS/Conf.pm
FS/FS/part_export/huawei_hlr.pm [new file with mode: 0644]
FS/FS/pay_batch/nacha.pm [new file with mode: 0644]
bin/cust_main-bulk_change
httemplate/edit/part_tag.html

index 6fc952f..736fe14 100644 (file)
@@ -3651,13 +3651,6 @@ and customer address. Include units.',
   },
 
   {
-    'key'         => 'batch-manual_approval',
-    'section'     => 'billing',
-    'description' => 'Allow manual batch closure, which will approve all payments that do not yet have a status.  This is not advised, but is needed for payment processors that provide a report of rejected rather than approved payments.',
-    'type'        => 'checkbox',
-  },
-
-  {
     'key'         => 'batchconfig-eft_canada',
     'section'     => 'billing',
     'description' => 'Configuration for EFT Canada batching, four lines: 1. SFTP username, 2. SFTP password, 3. Transaction code, 4. Number of days to delay process date.',
@@ -3666,6 +3659,34 @@ and customer address. Include units.',
   },
 
   {
+    'key'         => 'batchconfig-nacha-destination',
+    'section'     => 'billing',
+    'description' => 'Configuration for NACHA batching, Destination (9 digit transit routing number).',
+    'type'        => 'text',
+  },
+
+  {
+    'key'         => 'batchconfig-nacha-destination_name',
+    'section'     => 'billing',
+    'description' => 'Configuration for NACHA batching, Destination (Bank Name, up to 23 characters).',
+    'type'        => 'text',
+  },
+
+  {
+    'key'         => 'batchconfig-nacha-origin',
+    'section'     => 'billing',
+    'description' => 'Configuration for NACHA batching, Origin (your 10-digit company number, IRS tax ID recommended).',
+    'type'        => 'text',
+  },
+
+  {
+    'key'         => 'batch-manual_approval',
+    'section'     => 'billing',
+    'description' => 'Allow manual batch closure, which will approve all payments that do not yet have a status.  This is not advised unless needed for specific payment processors that provide a report of rejected rather than approved payments.',
+    'type'        => 'checkbox',
+  },
+
+  {
     'key'         => 'batch-spoolagent',
     'section'     => 'billing',
     'description' => 'Store payment batches per-agent.',
diff --git a/FS/FS/part_export/huawei_hlr.pm b/FS/FS/part_export/huawei_hlr.pm
new file mode 100644 (file)
index 0000000..fb3b679
--- /dev/null
@@ -0,0 +1,228 @@
+package FS::part_export::huawei_hlr;
+
+use vars qw(@ISA %info $DEBUG $CACHE);
+use Tie::IxHash;
+use FS::Record qw(qsearch qsearchs dbh);
+use FS::part_export;
+use FS::svc_phone;
+use IO::Socket::INET;
+use Data::Dumper;
+
+use strict;
+
+$DEBUG = 0;
+@ISA = qw(FS::part_export);
+
+tie my %options, 'Tie::IxHash',
+  'opname'    => { label=>'Operator login' },
+  'pwd'       => { label=>'Operator password' },
+  'tplid'     => { label=>'Template number' },
+  'hlrsn'     => { label=>'HLR serial number' },
+  'debug'     => { label=>'Enable debugging', type=>'checkbox' },
+;
+
+%info = (
+  'svc'     => 'svc_phone',
+  'desc'    => 'Provision mobile phone service to Huawei HLR9820',
+  'options' => \%options,
+  'notes'   => <<'END'
+Connects to a Huawei Subscriber Management Unit via TCP and configures mobile
+phone services according to a template.  The <i>sim_imsi</i> field must be 
+set on the service, and the template must exist.
+END
+);
+
+sub _export_insert {
+  my( $self, $svc_phone ) = (shift, shift);
+  # svc_phone::check should ensure phonenum and sim_imsi are numeric
+  my @command = (
+    'ADD TPLSUB',
+    IMSI   => '"'.$svc_phone->sim_imsi.'"',
+    ISDN   => '"'.$svc_phone->phonenum.'"',
+    TPLID  => $self->option('tplid'),
+  );
+  unshift @command, 'HLRSN', $self->option('hlrsn')
+    if $self->option('hlrsn');
+  my $err_or_queue = $self->queue_command($svc_phone->svcnum, @command);
+  ref($err_or_queue) ? '' : $err_or_queue;
+}
+
+sub _export_replace  {
+  my( $self, $new, $old ) = @_;
+  my $depend_jobnum;
+  if ( $new->sim_imsi ne $old->sim_imsi ) {
+    my @command = (
+      'MOD IMSI',
+      ISDN    => '"'.$old->phonenum.'"',
+      IMSI    => '"'.$old->sim_imsi.'"',
+      NEWIMSI => '"'.$new->sim_imsi.'"',
+    );
+    my $err_or_queue = $self->queue_command($new->svcnum, @command);
+    return $err_or_queue unless ref $err_or_queue;
+    $depend_jobnum = $err_or_queue->jobnum;
+  }
+  if ( $new->phonenum ne $old->phonenum ) {
+    my @command = (
+      'MOD ISDN',
+      ISDN    => '"'.$old->phonenum.'"',
+      NEWISDN => '"'.$new->phonenum.'"',
+    );
+    my $err_or_queue = $self->queue_command($new->svcnum, @command);
+    return $err_or_queue unless ref $err_or_queue;
+    if ( $depend_jobnum ) {
+      my $error = $err_or_queue->depend_insert($depend_jobnum);
+      return $error if $error;
+    }
+  }
+  # no other svc_phone changes need to be exported
+  '';
+}
+
+sub _export_suspend {
+  my( $self, $svc_phone ) = (shift, shift);
+  $self->_export_lock($svc_phone, 'TRUE');
+}
+
+sub _export_unsuspend {
+  my( $self, $svc_phone ) = (shift, shift);
+  $self->_export_lock($svc_phone, 'FALSE');
+}
+
+sub _export_lock {
+  my ($self, $svc_phone, $lockstate) = @_;
+  # XXX I'm not sure this actually suspends.  Need to test it.
+  my @command = (
+    'MOD LCK',
+    IMSI    => '"'.$svc_phone->sim_imsi.'"',
+    ISDN    => '"'.$svc_phone->phonenum.'"',
+    IC      => $lockstate,
+    OC      => $lockstate,
+    GPRSLOCK=> $lockstate,
+  );
+  my $err_or_queue = $self->queue_command($svc_phone->svcnum, @command);
+  ref($err_or_queue) ? '' : $err_or_queue;
+}
+
+sub _export_delete {
+  my( $self, $svc_phone ) = (shift, shift);
+  my @command = (
+    'RMV SUB',
+    IMSI    => '"'.$svc_phone->sim_imsi.'"',
+    ISDN    => '"'.$svc_phone->phonenum.'"',
+  );
+  my $err_or_queue = $self->queue_command($svc_phone->svcnum, @command);
+  ref($err_or_queue) ? '' : $err_or_queue;
+}
+
+sub queue_command {
+  my ($self, $svcnum, @command) = @_;
+  my $queue = FS::queue->new({
+      svcnum  => $svcnum,
+      job     => 'FS::part_export::huawei_hlr::run_command',
+  });
+  $queue->insert($self->exportnum, @command) || $queue;
+}
+
+sub run_command {
+  my ($exportnum, @command) = @_;
+  my $self = FS::part_export->by_key($exportnum);
+  my $socket = $self->login;
+  my $result = $self->command($socket, @command);
+  $self->logout($socket);
+  $socket->close;
+  die $result->{error} if $result->{error};
+  '';
+}
+
+sub login {
+  my $self = shift;
+  local $DEBUG = $self->option('debug') || 0;
+  # Send a command to the SMU.
+  # The caller is responsible for quoting string parameters.
+  my %socket_param = (
+    PeerAddr  => $self->machine,
+    PeerPort  => 7777,
+    Proto     => 'tcp',
+    Timeout   => ($self->option('timeout') || 30),
+  );
+  warn "Connecting to ".$self->machine."...\n" if $DEBUG;
+  warn Dumper(\%socket_param) if $DEBUG;
+  my $socket = IO::Socket::INET->new(%socket_param)
+    or die "Failed to connect: $!\n";
+
+  warn 'Logging in as "'.$self->option('opname').".\"\n" if $DEBUG;
+  my @login_param = (
+    OPNAME => '"'.$self->option('opname').'"',
+    PWD    => '"'.$self->option('pwd').'"',
+  );
+  if ($self->option('HLRSN')) {
+    unshift @login_param, 'HLRSN', $self->option('HLRSN');
+  }
+  my $login_result = $self->command($socket, 'LGI', @login_param);
+  die $login_result->{error} if $login_result->{error};
+  return $socket;
+}
+
+sub logout {
+  warn "Logging out.\n" if $DEBUG;
+  my $self = shift;
+  my ($socket) = @_;
+  $self->command($socket, 'LGO');
+  $socket->close;
+}
+
+sub command {
+  my $self = shift;
+  my ($socket, $command, @param) = @_;
+  my $string = $command . ':';
+  while (@param) {
+    $string .= shift(@param) . '=' . shift(@param);
+    $string .= ',' if @param;
+  }
+  $string .= "\n";
+  my @result;
+  eval { # timeout
+    local $SIG{ALRM} = sub { die "timeout\n" };
+    alarm ($self->option('timeout') || 30);
+    warn "Sending to server:\n$string\n\n" if $DEBUG;
+    $socket->print($string);
+    warn "Received:\n";
+    my $line;
+    do {
+      $line = $socket->getline();
+      warn $line if $DEBUG;
+      chomp $line;
+      push @result, $line if length($line);
+    } until ( $line =~ /^---\s*END$/ or $socket->eof );
+    alarm 0;
+  };
+  my %return;
+  if ( $@ eq "timeout\n" ) {
+    return { error => 'request timed out' };
+  } elsif ( $@ ) {
+    return { error => $@ };
+  } else {
+    #+++    HLR9820        <date> <time>\n
+    # skip empty lines
+    my $header = shift(@result);
+    return { error => 'malformed response: '.$header }
+      unless $header =~ /^\+\+\+/;
+    $return{header} = $header;
+    #SMU    #<serial number>\n
+    $return{smu} = shift(@result);
+    #%%<command string>%%\n 
+    $return{echo} = shift(@result); # should match the input
+    #<message code>: <message description>\n
+    my $message = shift(@result);
+    if ($message =~ /^SUCCESS/) {
+      $return{success} = $message;
+    } else { #/^ERR/
+      $return{error} = $message;
+    }
+    $return{trailer} = pop(@result);
+    $return{details} = join("\n",@result,'');
+  }
+  \%return;
+}
+
+1;
diff --git a/FS/FS/pay_batch/nacha.pm b/FS/FS/pay_batch/nacha.pm
new file mode 100644 (file)
index 0000000..999cd9e
--- /dev/null
@@ -0,0 +1,188 @@
+package FS::pay_batch::nacha;
+
+use strict;
+use vars qw( %import_info %export_info $name $conf );
+use Date::Format;
+#use Time::Local 'timelocal';
+#use FS::Conf;
+
+$name = 'NACHA';
+
+%import_info = (
+  #XXX stub finish me
+  'filetype' => 'CSV',
+  'fields' => [
+  ],
+  'hook' => sub {
+    my $hash = shift;
+  },
+  'approved' => sub { 1 },
+  'declined' => sub { 0 },
+);
+
+%export_info = (
+
+  #optional
+  init => sub {
+    $conf = shift;
+  },
+
+  delimiter => '',
+
+
+  header => sub {
+    my( $pay_batch, $cust_pay_batch_arrayref ) = @_;
+
+    $conf->config('batchconfig-nacha-destination') =~ /^\s*(\d{9})\s*$/
+      or die 'illegal NACHA Destination';
+    my $dest = $1;
+
+    my $dest_name = $conf->config('batchconfig-nacha-destination_name');
+    $dest_name = substr( $dest_name. (' 'x23), 0, 23);
+
+    $conf->config('batchconfig-nacha-origin') =~ /^\s*(\d{10})\s*$/
+      or die 'illegal NACHA Origin';
+    my $origin = $1;
+
+    my $company = $conf->config('company_name', $pay_batch->agentnum);
+    $company = substr($company. (' 'x23), 0, 23);
+
+    my $now = time;
+
+    #haha don't want to break after a quarter million years of a batch a day
+    #or 54 years for 5000 agent-virtualized hosted companies batching daily
+    my $refcode = substr( (' 'x8). $pay_batch->batchnum, -8);
+
+    #or only 25,000 years or 5.4 for 5000 companies :)
+    #though they would probably want them numbered per company
+    my $batchnum = substr( ('0'x7). $pay_batch->batchnum, -7);
+
+    ##
+    # File Header Record
+    ##
+
+    '1'.                      #Record Type Code
+    '01'.                     #Priority Code
+    ' '. $dest.               #Immediate Destination / 9-digit transit routing #
+    $origin.                  #Immediate Origin / 10 digit company number
+    time2str('%y%m%d', $now). #File Creation Date
+    time2str('%H%M',   $now). #File Creation Time
+    'A'.                 #XXX file ID modifier, mult. files in transit? [A-Z0-9]
+    '094'.                    #94 character records
+    '10'.                     #Blocking Factor
+    '1'.                      #Format code
+    $dest_name.               #Immediate Destination Name / 23 char bank name
+    $company.                 #Immediate Origin Name / 23 char company name
+    $refcode.                 #Reference Code (internal/optional)
+
+    ###
+    # Batch Header Record
+    ###
+
+    '5'.                     #Record Type Code
+    '225'.                   #Service Class Code (220 credits only,
+                             #                    200 mixed debits & credits)
+    substr($company, 0, 16). #on cust. statements
+    (' 'x20 ).               #20 char "company internal use if desired"
+    $origin.                 #Company Identification (Immediate Origin)
+    'PPD'. #others?
+           #PPD "Prearranged Payments and Deposit entries" for consumer items
+           #CCD (Cash Concentration and Disbursement)
+           #CTX (Corporate Trade Exchange)
+           #TEL (Telephone initiated entires)
+           #WEB (Authorization received via the Internet)
+    'InterntSvc'. #XXX from conf 10 char txn desc, printed on cust. statements
+
+    #6 char "Descriptive date" printed on customer statements
+    #XXX now? or use a separate post date?
+    time2str('%y%m%d', $now).
+
+    #6 char date transactions are to be posted
+    #XXX now? or do we need a future banking day date like eft_canada trainwreck
+    time2str('%y%m%d', $now).
+
+    (' 'x3).                 #Settlement Date / Reserved
+    '1'.                     #Originator Status Code
+    substr($dest, 0, 8).     #Originating Financial Institution
+    $batchnum                #Batch Number ("number batches sequentially")
+
+  },
+
+  'row' => sub {
+    my( $cust_pay_batch, $pay_batch, $batchcount, $batchtotal ) = @_;
+
+    my ($account, $aba) = split('@', $cust_pay_batch->payinfo);
+
+    my $cust_main = $cust_pay_batch->cust_main;
+    my $cust_identifier = substr($cust_main->display_custnum. (' 'x15), 0, 15);
+
+    my $cust_name = substr($cust_main->name. (' 'x22), 0, 22);
+
+    #non-PPD transactions?  future
+
+    ###
+    # PPD Entry Detail Record
+    ###
+
+    '6'.                              #Record Type Code
+    '27'.                             #27 checking debit, 37 savings debit XXX
+    $aba.                             #Receiving DFI Identification, check digit
+    substr($account.(' 'x17), 0, 17). #DFI Account number (Left justify)
+    sprintf('%010d', $cust_pay_batch->amount * 100). #Amount
+    $cust_identifier.                 #Individual Identification Number, 15 char
+    $cust_name.                       #Individual name (22-char)
+    '  '.                             #2 char "company internal use if desired"
+    '0'.                              #Addenda Record Indicator
+    (' 'x15)                          #15 digit "bank will assign trace number"
+                                      # (00000?)
+  },
+
+  'footer' => sub {
+    my( $pay_batch, $batchcount, $batchtotal ) = @_;
+
+    $conf->config('batchconfig-nacha-destination') =~ /^\s*(\d{9})\s*$/
+      or die 'illegal NACHA Destination';
+    my $dest = $1;
+
+    $conf->config('batchconfig-nacha-origin') =~ /^\s*(\d{10})\s*$/
+      or die 'illegal NACHA Origin';
+    my $origin = $1;
+
+    my $batchnum = substr( ('0'x7). $pay_batch->batchnum, -7);
+
+    ###
+    # Batch Control Record
+    ###
+
+    '8'.                          #Record Type Code
+    '225'.                        #Service Class Code (220 credits only,
+                                  #                    200 mixed debits&credits)
+    sprintf('%06d', $batchcount). #Entry / Addenda Count
+    '1234567890'. #XXX "Entry Hash" Total of all positions 4-11 on each 6 record.  Only use the final 10 positions in the entry
+    sprintf('%012d', $batchtotal * 100). #Debit total
+    '000000000000'.               #Credit total
+    $origin.                      #Company Identification (Immediate Origin)
+    (' 'x19).                     #Message Authentication Code (19 char blank)
+    (' 'x6).                      #Federal Reserve Use (6 char blank)
+    substr($dest, 0, 8).          #Originating Financial Institution
+    $batchnum.                    #Batch Number ("number batches sequentially")
+
+    ###
+    # File Control Record
+    ###
+
+    '9'.                                 #Record Type Code
+    '000001'.                            #Batch Counter (# of batch header recs)
+    sprintf('%06d', $batchcount + 4).    #num of physical blocks on the file..?
+    sprintf('%08d', $batchcount).        #total # of entry detail and addenda
+    '1234567890'. #XXX "Entry Hash" Total of all positions 4-11 on each 6 record.  Only use the final 10 positions in the entry
+    sprintf('%012d', $batchtotal * 100). #Debit total
+    '000000000000'.                      #Credit total
+    ( ' 'x39 )                           #Reserved / blank
+
+  },
+
+);
+
+1;
+
index fdf53d9..02931ab 100755 (executable)
@@ -1,13 +1,14 @@
 #!/usr/bin/perl
 
 use strict;
-use vars qw( $opt_p );
+use vars qw( $opt_p $opt_t );
 use Getopt::Std;
 use FS::UID qw(adminsuidsetup);
 use FS::Record qw(qsearchs);
 use FS::cust_main;
+use FS::cust_tag;
 
-getopts('p:');
+getopts('p:t:');
 
 my $user = shift or &usage;
 adminsuidsetup $user;
@@ -31,17 +32,24 @@ while (<STDIN>) {
     next;
   }
 
+  my %cust_tag = ( custnum=>$custnum, tagnum=>$opt_t );
+  if ( $opt_t && ! qsearchs('cust_tag', \%cust_tag) ) {
+    my $cust_tag = new FS::cust_tag \%cust_tag;
+    my $error = $cust_tag->insert;
+    die "$error\n" if $error;
+  }
+
   if ( $opt_p ) {
     $cust_main->payby($opt_p);
-  }
 
-  my $error = $cust_main->replace;
-  die "$error\n" if $error;
+    my $error = $cust_main->replace;
+    die "$error\n" if $error;
+  }
 
 }
 
 sub usage {
-  die "usage: cust_main-bulk_change -p NEW_PAYBY employee_username <custnums.txt\n";
+  die "usage: cust_main-bulk_change [ -p NEW_PAYBY ] [ -t tagnum ] employee_username <custnums.txt\n";
 }
 
 =head1 NAME
@@ -50,13 +58,15 @@ cust_main-bulk_change
 
 =head1 SYNOPSIS
 
-  cust_main-bulk_change -p NEW_PAYBY username <custnums.txt
+  cust_main-bulk_change [ -p NEW_PAYBY ] [ -t tagnum ] username <custnums.txt
 
 =head1 DESCRIPTION
 
-Command-line tool to change the payby field for a group of customers.
+Command-line tool to make bulk changes to a group of customers.
+
+-p: new payby, for example, I<CARD> or I<DCRD>
 
--p: new payby, for example, I<CARD> or I<DCRD>.
+-t: tagnum to add if not present
 
 user: Employee username
 
index 5712560..2cf34c6 100644 (file)
@@ -8,7 +8,7 @@
                 { field=>'by_default',  type=>'checkbox', value=>'Y' },
                 $tagcolor,
               ],
-              'labels'        => { 'tagnum'   => 'Tag #',
+              'labels'        => { 'tagnum'   => 'Tag',
                                    'tagname'  => 'Tag',
                                    'tagdesc'  => 'Message',
                                    'tagcolor' => 'Highlight Color',