summaryrefslogtreecommitdiff
path: root/bin
diff options
context:
space:
mode:
Diffstat (limited to 'bin')
-rw-r--r--bin/billco-upload20
-rwxr-xr-xbin/cdr-netsapiens.import207
-rwxr-xr-xbin/cdr-transnexus.import143
-rwxr-xr-xbin/cdr.sftp_and_import112
-rwxr-xr-xbin/confdiff27
-rwxr-xr-xbin/countdeclines22
-rw-r--r--bin/cust_main_special.pm608
-rwxr-xr-xbin/cust_pay_histogram115
-rwxr-xr-xbin/cvs2cl2
-rw-r--r--bin/drop_slony.slonik9
-rw-r--r--bin/freeside-migrate-events97
-rwxr-xr-xbin/fs-migrate-cust_tax_exempt2
-rwxr-xr-xbin/generate-table-module11
-rwxr-xr-xbin/h_cust_main-wipe_paycvv30
-rwxr-xr-xbin/make-pkg-fruit172
-rwxr-xr-xbin/mapsecrets2access_user2
-rwxr-xr-xbin/move-customers678
-rwxr-xr-xbin/ping58
-rwxr-xr-xbin/print-directory_assist12
-rwxr-xr-xbin/rebill132
-rw-r--r--bin/svc_acct-recalculate_usage110
-rwxr-xr-xbin/tax_rate_location.import48
22 files changed, 2453 insertions, 164 deletions
diff --git a/bin/billco-upload b/bin/billco-upload
deleted file mode 100644
index ce4a43d..0000000
--- a/bin/billco-upload
+++ /dev/null
@@ -1,20 +0,0 @@
-#!/bin/sh
-
-AGENTNUMS="1 2 3"
-
-date=`date +"%Y%m%d"`
-dir="/usr/local/etc/freeside/export.DBI:Pg:dbname=freeside/cust_bill"
-cd "$dir"
-
-for AGENTNUM in $AGENTNUMS; do
-
- for a in header detail; do
- mv agentnum$AGENTNUM-$a.csv agentnum$AGENTNUM-$date-$a.csv
- done
-
- zip agentnum$AGENTNUM-$date.zip agentnum$AGENTNUM-$date-header.csv agentnum$AGENTNUM-$date-detail.csv
-
- echo $dir/agentnum$AGENTNUM-$date.zip
-
-done
-
diff --git a/bin/cdr-netsapiens.import b/bin/cdr-netsapiens.import
new file mode 100755
index 0000000..8092255
--- /dev/null
+++ b/bin/cdr-netsapiens.import
@@ -0,0 +1,207 @@
+#!/usr/bin/perl
+#
+# */5 * * * /home/ivan/freeside/bin/cdr-netsapiens.import ivan exportnum
+
+use strict;
+use vars qw( $DEBUG );
+use REST::Client;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearchs);
+use FS::part_export;
+use FS::cdr;
+
+$DEBUG = 2;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my $exportnum = shift or die &usage;
+my $part_export = qsearchs('part_export', { 'exportnum' => $exportnum } )
+ or die "unknown exportnum $exportnum\n";
+
+#find max time_release
+#SELECT MAX(
+#2009-02-19 20:17:37
+my $time_release = '2009-01-01 00:00:00';
+
+#retreive CDRs >= this time
+#XXX (in pages, this tops out at 20) _start=>0, _limit=>20
+
+my $ns = $part_export->ns_command( 'GET', '/cdr/',
+ 'time_release' => '$time_release,',
+ '_sort' => '+time_release',
+ );
+
+#loop over them, double check duplicates, insert the rest
+
+my $content = $ns->responseContent;
+
+#<a href="/tac2/cdr/20090219201719000016%40SkyNet360.Com">20090219201719000016@SkyNet360.Com</a>
+# <form method="post" action="/tac2/cdr/20090219201719000016%40SkyNet360.Com">
+while ( $content =~
+ s/^.*?<form method="post" action="\/tac2\/cdr\/(\d+)\%40[^"]*">//is )
+{
+
+ my $accountcode = $1;
+ warn "$accountcode\n" if $DEBUG;
+
+ $content =~ s/(.*?)<\/form>//is;
+ my $cdr_content = $1;
+
+ while ( $cdr_content =~
+ s/.*?<input name="(\w+)" type="\w+" value="([^"]+)" \/>//is )
+ {
+ warn " $1 => $2\n" if $DEBUG > 1;
+
+ my $cdr = new FS::cdr {
+ #'src' =>
+ #'dst' =>
+# 'startdate' => 'time_start', #XXX needs parsing
+# 'enddate' => 'time_release', #XXX needs parsing
+ 'duration' => 'duration',
+ 'billsec' => 'time_talking',
+ #'disposition' =>
+ 'accountcode' => $accountcode,
+ #'charged_party'
+ };
+
+
+ }
+
+}
+
+sub usage {
+ "Usage: \n cdr-netsapiens.import user exportnum\n";
+}
+
+__END__
+
+ rly_prt_0 => 23946
+ orig_req_host => residential.skynet360.com
+ batch_dura => 0
+ orig_from_host => 63.251.149.5
+ batch_tim_beg => 2009-02-19 20:17:19
+ term_match => sip:7865457300@residential.skynet360.com
+ term_domain => residential.skynet360.com
+ term_sub => 7865457300
+ orig_req_user => 7865457300
+ orig_callid => 5D1164E6-44E011D6-8C84C368-EA5A0BC4@63.251.149.5
+ term_ip => 63.251.148.137:1453
+ term_to_uri => sip:7865457300@residential.skynet360.com
+ release_code => end
+ time_start => 2009-02-19 20:17:19.0
+ batch_hold => 0
+ orig_from_user => 9046384544
+ time_holding => 0
+ term_logi_uri => sip:7865457300@residential.skynet360.com
+ time_talking => 0
+ orig_from_uri => sip:9046384544@63.251.149.5
+ duration => 0
+ orig_logi_uri => sip:9046384544@63.251.149.5
+ rly_cnt_b => 0
+ time_insert => 2009-02-19 15:17:38.0
+ orig_to_user => 7865457300
+ rly_prt_a => 63.251.149.18:21972
+ cdr_index => 0
+ orig_to_host => 63.251.149.18
+ orig_match => sip:*@63.251.149.5
+ time_release => 2009-02-19 20:17:37
+ codec => G.711 u-law
+ orig_req_uri => sip:7865457300@residential.skynet360.com
+ orig_to_uri => sip:7865457300@63.251.149.18
+ rly_cnt_a => 13
+ orig_ip => 63.251.149.5:57326
+ release_text => Orig: Cancel
+ time_disp => 0
+ time_ringing => 2009-02-19 20:17:19
+ _method => put
+prt_0 => 23946
+ orig_req_host => residential.skynet360.com
+ batch_dura => 0
+ orig_from_host => 63.251.149.5
+ batch_tim_beg => 2009-02-19 20:17:19
+ term_match => sip:7865457300@residential.skynet360.com
+ term_domain => residential.skynet360.com
+ time_start => 2009-02-19 20:17:19.0
+ term_sub => 7865457300
+ orig_req_user => 7865457300
+ orig_callid => 5D1164E6-44E011D6-8C84C368-EA5A0BC4@63.251.149.5
+ term_ip => 63.251.148.137:1453
+ term_to_uri => sip:7865457300@residential.skynet360.com
+ release_code => end
+ time_start => 2009-02-19 20:17:19.0
+ batch_hold => 0
+ orig_from_user => 9046384544
+ time_holding => 0
+ term_logi_uri => sip:7865457300@residential.skynet360.com
+ time_talking => 0
+ orig_from_uri => sip:9046384544@63.251.149.5
+ duration => 0
+ orig_logi_uri => sip:9046384544@63.251.149.5
+ rly_cnt_b => 0
+ time_insert => 2009-02-19 15:17:38.0
+ orig_to_user => 7865457300
+ rly_prt_a => 63.251.149.18:21972
+ cdr_index => 0
+ orig_to_host => 63.251.149.18
+ orig_match => sip:*@63.251.149.5
+ time_release => 2009-02-19 20:17:37
+ codec => G.711 u-law
+ orig_req_uri => sip:7865457300@residential.skynet360.com
+ orig_to_uri => sip:7865457300@63.251.149.18
+ rly_cnt_a => 13
+ orig_ip => 63.251.149.5:57326
+ release_text => Orig: Cancel
+ time_disp => 0
+ time_ringing => 2009-02-19 20:17:19
+ _method => put
+
+list of freeside CDR fields, useful ones marked with *
+
+ acctid - primary key
+*[1] calldate - Call timestamp (SQL timestamp)
+ clid - Caller*ID with text
+* src - Caller*ID number / Source number
+* dst - Destination extension
+ dcontext - Destination context
+ channel - Channel used
+ dstchannel - Destination channel if appropriate
+ lastapp - Last application if appropriate
+ lastdata - Last application data
+* startdate - Start of call (UNIX-style integer timestamp)
+ answerdate - Answer time of call (UNIX-style integer timestamp)
+* enddate - End time of call (UNIX-style integer timestamp)
+* duration - Total time in system, in seconds
+* billsec - Total time call is up, in seconds
+*[2] disposition - What happened to the call: ANSWERED, NO ANSWER, BUSY
+ amaflags - What flags to use: BILL, IGNORE etc, specified on a per
+ channel basis like accountcode.
+*[3] accountcode - CDR account number to use: account
+ uniqueid - Unique channel identifier (Unitel/RSLCOM Event ID)
+ userfield - CDR user-defined field
+ cdr_type - CDR type - see FS::cdr_type (Usage = 1, S&E = 7, OC&C = 8)
+*[4] charged_party - Service number to be billed
+ upstream_currency - Wholesale currency from upstream
+*[5] upstream_price - Wholesale price from upstream
+ upstream_rateplanid - Upstream rate plan ID
+ rated_price - Rated (or re-rated) price
+ distance - km (need units field?)
+ islocal - Local - 1, Non Local = 0
+*[6] calltypenum - Type of call - see FS::cdr_calltype
+ description - Description (cdr_type 7&8 only) (used for
+ cust_bill_pkg.itemdesc)
+ quantity - Number of items (cdr_type 7&8 only)
+ carrierid - Upstream Carrier ID (see FS::cdr_carrier)
+ upstream_rateid - Upstream Rate ID
+ svcnum - Link to customer service (see FS::cust_svc)
+ freesidestatus - NULL, done (or something)
+
+[1] Auto-populated from startdate if not present
+[2] Package options available to ignore calls without a specific disposition
+[3] When using 'cdr-charged_party-accountcode' config
+[4] Auto-populated from src (normal calls) or dst (toll free calls) if not present
+[5] When using 'upstream_simple' rating method.
+[6] Set to usage class classnum when using pre-rated CDRs and usage class-based
+ taxation (local/intrastate/interstate/international)
+
+
diff --git a/bin/cdr-transnexus.import b/bin/cdr-transnexus.import
new file mode 100755
index 0000000..9686f7d
--- /dev/null
+++ b/bin/cdr-transnexus.import
@@ -0,0 +1,143 @@
+#!/usr/bin/perl
+
+use strict;
+use Getopt::Std;
+use Net::SFTP::Foreign;
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::cdr;
+
+###
+# parse command line
+###
+
+use vars qw( $opt_p $opt_d $opt_v );
+getopts('v');
+
+$opt_p = 'last';
+$opt_d = 'done';
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+# %%%FREESIDE_CACHE%%%
+my $cachedir = '/usr/local/etc/freeside/cache.'. datasrc. '/cdrs';
+mkdir $cachedir unless -d $cachedir;
+
+#my $format = shift or die &usage;
+my $format = 'transnexus';
+
+use vars qw( $servername );
+$servername = shift or die &usage;
+
+my $DIR = '/home/ossadmin/OSS/nexoss/CDR_ARCHIVE_BY_ACCOUNT';
+
+###
+# get the file list
+###
+
+warn "Retreiving directory listing\n" if $opt_v;
+
+my $ls_sftp = sftp();
+
+my $lsdir = $ls_sftp->ls($DIR);
+
+###
+# import each file in each dir
+###
+
+foreach my $dir ( @$lsdir ) {
+
+ my $dirname = $dir->{filename};
+ warn "Scanning dir $dirname\n" if $opt_v;
+
+ #my $ls = $ls_sftp->ls("$DIR/$dirname", wanted => qr/^$opt_p.*-CDRs$/i );
+ my $ls = $ls_sftp->ls("$DIR/$dirname", wanted => qr/^$opt_p.*Customer-CDRs$/i );
+
+ foreach my $file ( @$ls ) {
+
+ my $filename = $file->{filename};
+ warn "Downloading $filename\n" if $opt_v;
+
+ #get the file
+ my $get_sftp = sftp();
+ $get_sftp->get("$DIR/$dirname/$filename", "$cachedir/$filename")
+ or die "Can't get $filename: ". $get_sftp->error;
+
+ warn "Processing $filename\n" if $opt_v;
+
+ my $error = FS::cdr::batch_import( {
+ 'file' => "$cachedir/$filename",
+ 'format' => $format,
+ 'params' => { 'cdrbatch' => $filename, },
+ 'empty_ok' => 1,
+ } );
+ die $error if $error;
+
+ if ( $opt_d ) {
+ my $mv_sftp = sftp();
+ $mv_sftp->mkdir("$DIR/$dirname/$opt_d");
+ $mv_sftp->rename( "$DIR/$dirname/$filename",
+ "$DIR/$dirname/$opt_d/$filename" )
+ or die "can't move $filename to $opt_d: ". $mv_sftp->error;
+ }
+
+ unlink "$cachedir/$filename";
+
+ }
+
+}
+
+###
+# subs
+###
+
+sub usage {
+ "Usage: \n cdr-transnexus.import [ -v ] user [sftpuser@]servername\n";
+}
+
+use vars qw( $sftp );
+
+sub sftp {
+
+ #reuse connections
+ return $sftp if $sftp && $sftp->cwd;
+
+ my %sftp = ( host => $servername );
+
+ $sftp = Net::SFTP::Foreign->new(%sftp);
+ $sftp->error and die "SFTP connection failed: ". $sftp->error;
+
+ $sftp;
+}
+
+=head1 NAME
+
+cdr.sftp_and_import - Download CDR files from a remote server via SFTP
+
+=head1 SYNOPSIS
+
+ cdr-transnexus.import [ -v ] user [sftpuser@]servername
+
+=head1 DESCRIPTION
+
+Command line tool to download CDR files from a remote server via SFTP and then
+import them into the database.
+
+-v: verbose
+
+user: freeside username
+
+[sftpuser@]servername: remote server
+
+=head1 BUGS
+
+Hacked up copy of freeside-cdr-sftp_and_import
+
+=head1 SEE ALSO
+
+L<FS::cdr>
+
+=cut
+
+1;
+
diff --git a/bin/cdr.sftp_and_import b/bin/cdr.sftp_and_import
deleted file mode 100755
index 79e743f..0000000
--- a/bin/cdr.sftp_and_import
+++ /dev/null
@@ -1,112 +0,0 @@
-#!/usr/bin/perl
-#
-# Usage:
-# cdr.sftp_and_import [ -e extension ] [ -d donefolder ] [ -v ] user format [sftpuser@]servername
-#
-# -e: file extension, defaults to .csv
-# -d: if specified, moves files to the specified folder when done
-
-use strict;
-use Getopt::Std;
-use Net::SFTP::Foreign;
-use FS::UID qw(adminsuidsetup datasrc);
-use FS::cdr;
-
-###
-# parse command line
-###
-
-use vars qw( $opt_e $opt_d $opt_v );
-getopts('e:d:v');
-
-$opt_e ||= 'csv';
-#$opt_e = ".$opt_e" unless $opt_e =~ /^\./;
-$opt_e =~ s/^\.//;
-
-my $user = shift or die &usage;
-adminsuidsetup $user;
-
-# %%%FREESIDE_CACHE%%%
-my $cachedir = '/usr/local/etc/freeside/cache.'. datasrc. '/cdrs';
-mkdir $cachedir unless -d $cachedir;
-
-my $format = shift or die &usage;
-
-use vars qw( $servername );
-$servername = shift or die &usage;
-
-###
-# get the file list
-###
-
-warn "Retreiving directory listing\n" if $opt_v;
-
-my $ls_sftp = sftp();
-
-my $ls = $ls_sftp->ls('.', wanted => qr/\.*$opt_e$/i );
-
-###
-# import each file
-###
-
-foreach my $file ( @$ls ) {
-
- my $filename = $file->{filename};
- warn "Downloading $filename\n" if $opt_v;
-
- #get the file
- my $get_sftp = sftp();
- $get_sftp->get($filename, "$cachedir/$filename")
- or die "Can't get $filename: ". $get_sftp->error;
-
- warn "Processing $filename\n" if $opt_v;
-
- my $error = FS::cdr::batch_import( {
- 'file' => "$cachedir/$filename"
- 'format' => $format,
- 'params' => { 'cdrbatch' => $filename, },
- 'empty_ok' => 1,
- } );
- die $error if $error;
-
- close FILE;
-
- if ( $opt_d ) {
- my $mv_sftp = sftp();
- $mv_sftp->rename($filename, "$opt_d/$filename")
- or die "can't move $filename to $opt_d: ". $mv_sftp->error;
- }
-
- unlink "$cachedir/$filename";
-
-}
-
-1;
-
-###
-# sub
-###
-
-sub usage {
- "Usage: \n cdr.import user format servername\n";
-}
-
-use vars qw( $sftp );
-
-sub sftp {
-
- #reuse connections
- return $sftp if $sftp && $sftp->cwd;
-
- my %sftp = ( host => $servername );
-
- #XXX remove these
- $sftp{port} = 10022;
- #$sftp{more} = '-v';
-
- $sftp = Net::SFTP::Foreign->new(%sftp);
- $sftp->error and die "SFTP connection failed: ". $sftp->error;
-
- $sftp;
-}
-
diff --git a/bin/confdiff b/bin/confdiff
new file mode 100755
index 0000000..5b6af85
--- /dev/null
+++ b/bin/confdiff
@@ -0,0 +1,27 @@
+#!/usr/bin/perl
+
+use FS::UID qw(adminsuidsetup);
+use FS::Conf;
+
+adminsuidsetup('ivan');
+
+my $conf = new FS::Conf;
+
+my $file2 = pop @ARGV;
+my $file1 = pop @ARGV;
+
+open(FILE1, ">/tmp/$file1") or die "can't open /tmp/$file1: $!";
+print FILE1 $conf->config($file1);
+print FILE1 "\n";
+close FILE1 or die $!;
+
+open(FILE2, ">/tmp/$file2") or die "can't open /tmp/$file2: $!";
+print FILE2 $conf->config($file2);
+print FILE2 "\n";
+close FILE2 or die $!;
+
+my @opt = @ARGV;
+
+system('diff', @opt, "/tmp/$file1", "/tmp/$file2");
+
+#unlink("/tmp/$file1', "/tmp/$file2");
diff --git a/bin/countdeclines b/bin/countdeclines
new file mode 100755
index 0000000..bbc3925
--- /dev/null
+++ b/bin/countdeclines
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+
+use Date::Parse;
+
+my $e = 'PlugnPay error: 97: Declined for CVV failure';
+my @y = (2008,2009);
+
+my $p = 0;
+
+foreach my $y (@y) {
+ foreach my $m (1..12) {
+ my $d = "$m/1/$y";
+ my $t = str2time($d);
+
+ #print "$pd-$d: SELECT count(*) from cust_bill_event where statustext = '$e' and _date >= $p and _date < $t;\n"
+ print "SELECT count(*) from cust_bill_event where statustext = '$e' and _date >= $p and _date < $t;\n"
+ if $p;
+
+ $p = $t;
+ $pd = $d;
+ }
+}
diff --git a/bin/cust_main_special.pm b/bin/cust_main_special.pm
new file mode 100644
index 0000000..967b6be
--- /dev/null
+++ b/bin/cust_main_special.pm
@@ -0,0 +1,608 @@
+package cust_main_special;
+
+require 5.006;
+use strict;
+use vars qw( @ISA $DEBUG $me $conf );
+use Safe;
+use Carp;
+use Data::Dumper;
+use Date::Format;
+use FS::UID qw( dbh );
+use FS::Record qw( qsearchs qsearch );
+use FS::payby;
+use FS::cust_pkg;
+use FS::cust_bill;
+use FS::cust_bill_pkg;
+use FS::cust_bill_pkg_display;
+use FS::cust_bill_pkg_tax_location;
+use FS::cust_main_county;
+use FS::cust_location;
+use FS::tax_rate;
+use FS::cust_tax_location;
+use FS::part_pkg_taxrate;
+use FS::queue;
+use FS::part_pkg;
+
+@ISA = qw ( FS::cust_main );
+
+$DEBUG = 0;
+$me = '[emergency billing program]';
+
+$conf = new FS::Conf;
+
+=head1 METHODS
+
+=over 4
+
+=item bill OPTIONS
+
+Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
+conjunction with the collect method by calling B<bill_and_collect>.
+
+If there is an error, returns the error, otherwise returns false.
+
+Options are passed as name-value pairs. Currently available options are:
+
+=over 4
+
+=item resetup
+
+If set true, re-charges setup fees.
+
+=item time
+
+Bills the customer as if it were that time. Specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions. For example:
+
+ use Date::Parse;
+ ...
+ $cust_main->bill( 'time' => str2time('April 20th, 2001') );
+
+=item pkg_list
+
+An array ref of specific packages (objects) to attempt billing, instead trying all of them.
+
+ $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
+
+=item invoice_time
+
+Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices. Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
+
+=item backbill
+
+Used to specify the period starting date and preventing normal billing. Instead all outstanding cdrs/usage are processed as if from the unix timestamp in backbill and without changing the dates in the customer packages. Useful in those situations when cdrs were not imported before a billing run
+
+=back
+
+=cut
+
+sub bill {
+ my( $self, %options ) = @_;
+
+ bless $self, 'cust_main_special';
+ return '' if $self->payby eq 'COMP';
+ warn "$me backbill usage for customer ". $self->custnum. "\n"
+ if $DEBUG;
+
+ my $time = $options{'time'} || time;
+ my $invoice_time = $options{'invoice_time'} || $time;
+
+ #put below somehow?
+ 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;
+
+ $self->select_for_update; #mutex
+
+ my @cust_bill_pkg = ();
+
+ ###
+ # find the packages which are due for billing, find out how much they are
+ # & generate invoice database.
+ ###
+
+ my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 );
+ my %taxlisthash;
+ my @precommit_hooks = ();
+
+ my @cust_pkgs = qsearch('cust_pkg', { 'custnum' => $self->custnum } );
+ foreach my $cust_pkg (@cust_pkgs) {
+
+ #NO!! next if $cust_pkg->cancel;
+ next if $cust_pkg->getfield('cancel');
+
+ warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
+
+ #? to avoid use of uninitialized value errors... ?
+ $cust_pkg->setfield('bill', '')
+ unless defined($cust_pkg->bill);
+
+ #my $part_pkg = $cust_pkg->part_pkg;
+
+ my $real_pkgpart = $cust_pkg->pkgpart;
+ my %hash = $cust_pkg->hash;
+
+ foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) {
+
+ $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
+
+ my $error =
+ $self->_make_lines( 'part_pkg' => $part_pkg,
+ 'cust_pkg' => $cust_pkg,
+ 'precommit_hooks' => \@precommit_hooks,
+ 'line_items' => \@cust_bill_pkg,
+ 'setup' => \$total_setup,
+ 'recur' => \$total_recur,
+ 'tax_matrix' => \%taxlisthash,
+ 'time' => $time,
+ 'options' => \%options,
+ );
+ if ($error) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ } #foreach my $part_pkg
+
+ } #foreach my $cust_pkg
+
+ unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items
+ unless ( $options{backbill} ) {
+ #but do commit any package date cycling that happened
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ } else {
+ $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
+ }
+ return '';
+ }
+
+ my $postal_pkg = $self->charge_postal_fee();
+ if ( $postal_pkg && !ref( $postal_pkg ) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't charge postal invoice fee for customer ".
+ $self->custnum. ": $postal_pkg";
+ }
+ if ( !$options{backbill} && $postal_pkg &&
+ ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
+ !$conf->exists('postal_invoice-recurring_only')
+ )
+ )
+ {
+ foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
+ my $error =
+ $self->_make_lines( 'part_pkg' => $part_pkg,
+ 'cust_pkg' => $postal_pkg,
+ 'precommit_hooks' => \@precommit_hooks,
+ 'line_items' => \@cust_bill_pkg,
+ 'setup' => \$total_setup,
+ 'recur' => \$total_recur,
+ 'tax_matrix' => \%taxlisthash,
+ 'time' => $time,
+ 'options' => \%options,
+ );
+ if ($error) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ }
+
+ warn "having a look at the taxes we found...\n" if $DEBUG > 2;
+
+ # keys are tax names (as printed on invoices / itemdesc )
+ # values are listrefs of taxlisthash keys (internal identifiers)
+ my %taxname = ();
+
+ # keys are taxlisthash keys (internal identifiers)
+ # values are (cumulative) amounts
+ my %tax = ();
+
+ # keys are taxlisthash keys (internal identifiers)
+ # values are listrefs of cust_bill_pkg_tax_location hashrefs
+ my %tax_location = ();
+
+ foreach my $tax ( keys %taxlisthash ) {
+ my $tax_object = shift @{ $taxlisthash{$tax} };
+ warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
+ warn " ". join('/', @{ $taxlisthash{$tax} } ). "\n" if $DEBUG > 2;
+ my $hashref_or_error =
+ $tax_object->taxline( $taxlisthash{$tax},
+ 'custnum' => $self->custnum,
+ 'invoice_time' => $invoice_time
+ );
+ unless ( ref($hashref_or_error) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $hashref_or_error;
+ }
+ unshift @{ $taxlisthash{$tax} }, $tax_object;
+
+ my $name = $hashref_or_error->{'name'};
+ my $amount = $hashref_or_error->{'amount'};
+
+ #warn "adding $amount as $name\n";
+ $taxname{ $name } ||= [];
+ push @{ $taxname{ $name } }, $tax;
+
+ $tax{ $tax } += $amount;
+
+ $tax_location{ $tax } ||= [];
+ if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
+ push @{ $tax_location{ $tax } },
+ {
+ 'taxnum' => $tax_object->taxnum,
+ 'taxtype' => ref($tax_object),
+ 'pkgnum' => $tax_object->get('pkgnum'),
+ 'locationnum' => $tax_object->get('locationnum'),
+ 'amount' => sprintf('%.2f', $amount ),
+ };
+ }
+
+ }
+
+ #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
+ my %packagemap = map { $_->pkgnum => $_ } @cust_bill_pkg;
+ foreach my $tax ( keys %taxlisthash ) {
+ foreach ( @{ $taxlisthash{$tax} }[1 ... scalar(@{ $taxlisthash{$tax} })] ) {
+ next unless ref($_) eq 'FS::cust_bill_pkg';
+
+ push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
+ splice( @{ $_->_cust_tax_exempt_pkg } );
+ }
+ }
+
+ #consolidate and create tax line items
+ warn "consolidating and generating...\n" if $DEBUG > 2;
+ foreach my $taxname ( keys %taxname ) {
+ my $tax = 0;
+ my %seen = ();
+ my @cust_bill_pkg_tax_location = ();
+ warn "adding $taxname\n" if $DEBUG > 1;
+ foreach my $taxitem ( @{ $taxname{$taxname} } ) {
+ next if $seen{$taxitem}++;
+ warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
+ $tax += $tax{$taxitem};
+ push @cust_bill_pkg_tax_location,
+ map { new FS::cust_bill_pkg_tax_location $_ }
+ @{ $tax_location{ $taxitem } };
+ }
+ next unless $tax;
+
+ $tax = sprintf('%.2f', $tax );
+ $total_setup = sprintf('%.2f', $total_setup+$tax );
+
+ push @cust_bill_pkg, new FS::cust_bill_pkg {
+ 'pkgnum' => 0,
+ 'setup' => $tax,
+ 'recur' => 0,
+ 'sdate' => '',
+ 'edate' => '',
+ 'itemdesc' => $taxname,
+ 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
+ };
+
+ }
+
+ my $charged = sprintf('%.2f', $total_setup + $total_recur );
+
+ #create the new invoice
+ my $cust_bill = new FS::cust_bill ( {
+ 'custnum' => $self->custnum,
+ '_date' => ( $invoice_time ),
+ 'charged' => $charged,
+ } );
+ my $error = $cust_bill->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't create invoice for customer #". $self->custnum. ": $error";
+ }
+
+ foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
+ $cust_bill_pkg->invnum($cust_bill->invnum);
+ my $error = $cust_bill_pkg->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "can't create invoice line item: $error";
+ }
+ }
+
+
+ #foreach my $hook ( @precommit_hooks ) {
+ # eval {
+ # &{$hook}; #($self) ?
+ # };
+ # if ( $@ ) {
+ # $dbh->rollback if $oldAutoCommit;
+ # return "$@ running precommit hook $hook\n";
+ # }
+ #}
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ ''; #no error
+}
+
+
+sub _make_lines {
+ my ($self, %params) = @_;
+
+ warn " making lines\n" if $DEBUG > 1;
+ my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
+ my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
+ my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
+ my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
+ my $total_setup = $params{setup} or die "no setup accumulator specified";
+ my $total_recur = $params{recur} or die "no recur accumulator specified";
+ my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
+ my $time = $params{'time'} or die "no time specified";
+ my (%options) = %{$params{options}};
+
+ my $dbh = dbh;
+ my $real_pkgpart = $cust_pkg->pkgpart;
+ my %hash = $cust_pkg->hash;
+ my $old_cust_pkg = new FS::cust_pkg \%hash;
+ my $backbill = $options{backbill} || 0;
+
+ my @details = ();
+
+ my $lineitems = 0;
+
+ $cust_pkg->pkgpart($part_pkg->pkgpart);
+
+ ###
+ # bill setup
+ ###
+
+ my $setup = 0;
+ my $unitsetup = 0;
+ if ( ! $cust_pkg->setup &&
+ (
+ ( $conf->exists('disable_setup_suspended_pkgs') &&
+ ! $cust_pkg->getfield('susp')
+ ) || ! $conf->exists('disable_setup_suspended_pkgs')
+ )
+ || $options{'resetup'}
+ ) {
+
+ warn " bill setup\n" if $DEBUG > 1;
+ $lineitems++;
+
+ $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
+ return "$@ running calc_setup for $cust_pkg\n"
+ if $@;
+
+ $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
+
+ $cust_pkg->setfield('setup', $time)
+ unless $cust_pkg->setup;
+ #do need it, but it won't get written to the db
+ #|| $cust_pkg->pkgpart != $real_pkgpart;
+
+ }
+
+ ###
+ # bill recurring fee
+ ###
+
+ #XXX unit stuff here too
+ my $recur = 0;
+ my $unitrecur = 0;
+ my $sdate;
+ if ( ! $cust_pkg->getfield('susp') and
+ ( $part_pkg->getfield('freq') ne '0' &&
+ ( $cust_pkg->getfield('bill') || 0 ) <= $time
+ )
+ || ( $part_pkg->plan eq 'voip_cdr'
+ && $part_pkg->option('bill_every_call')
+ )
+ || $backbill
+ ) {
+
+ # XXX should this be a package event? probably. events are called
+ # at collection time at the moment, though...
+ $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
+ if $part_pkg->can('reset_usage');
+ #don't want to reset usage just cause we want a line item??
+ #&& $part_pkg->pkgpart == $real_pkgpart;
+
+ warn " bill recur\n" if $DEBUG > 1;
+ $lineitems++;
+
+ # XXX shared with $recur_prog
+ $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
+ $sdate = $cust_pkg->lastbill || $backbill if $backbill;
+
+ #over two params! lets at least switch to a hashref for the rest...
+ my $increment_next_bill = ( $part_pkg->freq ne '0'
+ && ( $cust_pkg->getfield('bill') || 0 ) <= $time
+ );
+ my %param = ( 'precommit_hooks' => $precommit_hooks,
+ 'increment_next_bill' => $increment_next_bill,
+ );
+
+ $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
+ return "$@ running calc_recur for $cust_pkg\n"
+ if ( $@ );
+
+
+ warn "details is now: \n" if $DEBUG > 2;
+ warn Dumper(\@details) if $DEBUG > 2;
+
+ if ( $increment_next_bill ) {
+
+ my $next_bill = $part_pkg->add_freq($sdate);
+ return "unparsable frequency: ". $part_pkg->freq
+ if $next_bill == -1;
+
+ #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
+ # only for figuring next bill date, nothing else, so, reset $sdate again
+ # here
+ $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
+ $sdate = $cust_pkg->lastbill || $backbill if $backbill;
+ #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
+ $cust_pkg->last_bill($sdate);
+
+ $cust_pkg->setfield('bill', $next_bill );
+
+ }
+
+ }
+
+ warn "\$setup is undefined" unless defined($setup);
+ warn "\$recur is undefined" unless defined($recur);
+ warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
+
+ ###
+ # If there's line items, create em cust_bill_pkg records
+ # If $cust_pkg has been modified, update it (if we're a real pkgpart)
+ ###
+
+ if ( $lineitems ) {
+
+ if ( !$backbill && $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
+ # hmm.. and if just the options are modified in some weird price plan?
+
+ warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
+ if $DEBUG >1;
+
+ my $error = $cust_pkg->replace( $old_cust_pkg,
+ 'options' => { $cust_pkg->options },
+ );
+ return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
+ if $error; #just in case
+ }
+
+ my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
+ if ( $DEBUG > 1 ) {
+ warn " tentatively adding customer package invoice detail: $_\n"
+ foreach @cust_pkg_detail;
+ }
+ push @details, @cust_pkg_detail;
+
+ $setup = sprintf( "%.2f", $setup );
+ $recur = sprintf( "%.2f", $recur );
+ my $cust_bill_pkg = new FS::cust_bill_pkg {
+ 'pkgnum' => $cust_pkg->pkgnum,
+ 'setup' => $setup,
+ 'unitsetup' => $unitsetup,
+ 'recur' => $recur,
+ 'unitrecur' => $unitrecur,
+ 'quantity' => $cust_pkg->quantity,
+ 'details' => \@details,
+ };
+
+ warn "created cust_bill_pkg which looks like:\n" if $DEBUG > 2;
+ warn Dumper($cust_bill_pkg) if $DEBUG > 2;
+ if ($backbill) {
+ my %usage_cust_bill_pkg = $cust_bill_pkg->disintegrate;
+ $recur = 0;
+ foreach my $key (keys %usage_cust_bill_pkg) {
+ next if ($key eq 'setup' || $key eq 'recur');
+ $recur += $usage_cust_bill_pkg{$key}->recur;
+ }
+ $setup = 0;
+ }
+
+ $setup = sprintf( "%.2f", $setup );
+ $recur = sprintf( "%.2f", $recur );
+ if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
+ return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
+ }
+ if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
+ return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
+ }
+
+
+ if ( $setup != 0 || $recur != 0 ) {
+
+ warn " charges (setup=$setup, recur=$recur); adding line items\n"
+ if $DEBUG > 1;
+
+ $cust_bill_pkg->setup($setup);
+ $cust_bill_pkg->recur($recur);
+
+ warn "cust_bill_pkg now looks like:\n" if $DEBUG > 2;
+ warn Dumper($cust_bill_pkg) if $DEBUG > 2;
+
+ if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
+ $cust_bill_pkg->sdate( $hash{last_bill} );
+ $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
+ } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
+ $cust_bill_pkg->sdate( $sdate );
+ $cust_bill_pkg->edate( $cust_pkg->bill );
+ }
+
+ $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
+ unless $part_pkg->pkgpart == $real_pkgpart;
+
+ $$total_setup += $setup;
+ $$total_recur += $recur;
+
+ ###
+ # handle taxes
+ ###
+
+ my $error =
+ $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time});
+ return $error if $error;
+
+ push @$cust_bill_pkgs, $cust_bill_pkg;
+
+ } #if $setup != 0 || $recur != 0
+
+ } #if $line_items
+
+ '';
+
+}
+
+
+sub _gather_taxes {
+ my $self = shift;
+ my $part_pkg = shift;
+ my $class = shift;
+
+ my @taxes = ();
+ my $geocode = $self->geocode('cch');
+
+ my @taxclassnums = map { $_->taxclassnum }
+ $part_pkg->part_pkg_taxoverride($class);
+
+ unless (@taxclassnums) {
+ @taxclassnums = map { $_->taxclassnum }
+ $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
+ }
+ warn "Found taxclassnum values of ". join(',', @taxclassnums)
+ if $DEBUG;
+
+ my $extra_sql =
+ "AND (".
+ join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
+
+ @taxes = grep { ($_->fee || 0 ) == 0 } #ignore unit based taxes
+ qsearch({ 'table' => 'tax_rate',
+ 'hashref' => { 'geocode' => $geocode, },
+ 'extra_sql' => $extra_sql,
+ })
+ if scalar(@taxclassnums);
+
+ warn "Found taxes ".
+ join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
+ if $DEBUG;
+
+ [ @taxes ];
+
+}
+
+
+=back
+
+
+=cut
+
+1;
+
diff --git a/bin/cust_pay_histogram b/bin/cust_pay_histogram
new file mode 100755
index 0000000..714b321
--- /dev/null
+++ b/bin/cust_pay_histogram
@@ -0,0 +1,115 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Getopt::Std;
+use Date::Parse;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw( qsearch );
+use FS::cust_pay;
+
+&untaint_argv; #what it sounds like (eww)
+use vars qw(%opt);
+getopts("p:a:b:e:", \%opt);
+
+my $user = shift or die &usage;
+my $dbh = adminsuidsetup $user;
+
+my @where = ();
+
+push @where, 'agentnum = '. $dbh->quote($opt{a}) if $opt{a};
+push @where, 'cust_pay.payby = '. $dbh->quote($opt{p}) if $opt{p};
+push @where, 'cust_pay._date > '. $dbh->quote(str2time($opt{b})) if $opt{b};
+push @where, 'cust_pay._date < '. $dbh->quote(str2time($opt{e})) if $opt{e};
+
+my $extra_sql = scalar(@where) ? 'WHERE '. join(' AND ', @where) : '';
+my $addl_from = 'LEFT JOIN cust_main USING( custnum )';
+
+my @payrow = qsearch( { table => 'cust_pay',
+ hashref => {},
+ select => 'count(*) AS quantity, paid',
+ addl_from => $addl_from,
+ extra_sql => $extra_sql,
+ order_by => 'GROUP BY paid',
+ }
+ );
+
+my $max = 0;
+my $sum = 0;
+foreach (@payrow) {
+ $sum += $_->quantity;
+ $max = $_->quantity if $_->quantity > $max;
+}
+my $scale = int($max/60) + 1;
+
+print "\n PAYMENTS RECEIVED";
+print " AFTER $opt{b}" if $opt{b};
+print " UNTIL $opt{e}" if $opt{e};
+print " VIA $opt{p}" if $opt{p};
+print " BY AGENT $opt{a}" if $opt{a};
+print "\n\n";
+print "Total number of payments: $sum\n\n";
+print "(each * represents $scale)\n\n" if $scale > 1;
+
+foreach my $payrow ( @payrow ) {
+ print sprintf("%10.2f", $payrow->paid),
+ ": ",
+ sprintf("%6d", $payrow->quantity),
+ "| ",
+ '*' x($payrow->quantity/$scale),
+ "\n";
+}
+
+print "\n";
+
+
+###
+# subroutines
+###
+
+sub untaint_argv {
+ foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
+ #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
+ # Date::Parse
+ $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
+ $ARGV[$_]=$1;
+ }
+}
+
+sub usage {
+ die "Usage:\n\n cust_pay_histogram [ -b 'begin_date' ] [ -e 'end_date' ] [ -p 'payby' ] [ -a agentnum ] user\n";
+}
+
+###
+# documentation
+###
+
+=head1 NAME
+
+cust_pay_histogram - Show a histogram of payments made for a date range.
+
+=head1 SYNOPSIS
+
+ freeside-daily [ -b 'begin_date' ] [ -e 'end_date'] [ -p 'payby' ] [ -a agentnum ] user
+
+=head1 DESCRIPTION
+
+Displays a histogram of cust_pay records in the database.
+
+ -b: Include only payments since 'begin_date'. Date is in any format Date::Parse is happy with, but be careful.
+
+ -e: Include only payments before 'end_date'. Date is in any format Date::Parse is happy with, but be careful.
+
+ -p: Only process payments with the specified payby (I<CARD>, I<DCRD>, I<CHEK>, I<DCHK>, I<BILL>, I<COMP>, I<LECB>)
+
+ -a: Only process payments of customers with the specified agentnum
+
+user: From the mapsecrets file - see config.html from the base documentation
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::cust_pay>
+
+=cut
+
diff --git a/bin/cvs2cl b/bin/cvs2cl
new file mode 100755
index 0000000..1c1bfb0
--- /dev/null
+++ b/bin/cvs2cl
@@ -0,0 +1,2 @@
+#!/bin/sh
+cvs2cl -F trunk
diff --git a/bin/drop_slony.slonik b/bin/drop_slony.slonik
new file mode 100644
index 0000000..04ffaca
--- /dev/null
+++ b/bin/drop_slony.slonik
@@ -0,0 +1,9 @@
+cluster name = freeside;
+
+node 1 admin conninfo = 'dbname=freeside host=XXX user=postgres';
+node 2 admin conninfo = 'dbname=freeside host=XXX user=postgres';
+
+drop set (id=1, origin=1);
+
+uninstall node ( id=1 );
+
diff --git a/bin/freeside-migrate-events b/bin/freeside-migrate-events
index 76643b8..3e8a6b2 100644
--- a/bin/freeside-migrate-events
+++ b/bin/freeside-migrate-events
@@ -1,14 +1,17 @@
#!/usr/bin/perl -w
use strict;
-
-use FS::UID qw(adminsuidsetup);
+#use Getopt::Std;
+use FS::UID qw( adminsuidsetup dbh );
use FS::Record qw( qsearch );
use FS::part_bill_event;
use FS::part_event;
use FS::cust_bill_event;
use FS::cust_event;
+#use vars qw( $opt_m );
+#getopts('m');
+
my $user = shift or die &usage;
adminsuidsetup($user);
@@ -16,20 +19,20 @@ my %plan2action = (
'fee' => 'fee',
'fee_percent' => 'NOTYET', #XXX need fee_percent action
'suspend' => 'suspend',
- 'suspend-if-balance' => 'NOTYET', #XXX "if balance" becomes a balance condition
+ 'suspend-if-balance' => 'suspend', #"if balance" becomes the balance cond
'suspend-if-pkgpart' => 'suspend_if_pkgpart',
'suspend-unless-pkgpart' => 'suspend_unless_pkgpart',
'cancel' => 'cancel',
'addpost' => 'addpost',
'comp' => 'NOTYET', #XXX or N/A or something
- 'credit' => 'NOTYET',
+ 'credit' => 'writeoff',
'realtime-card' => 'cust_bill_realtime_card',
'realtime-check' => 'cust_bill_realtime_check',
'realtime-lec' => 'cust_bill_realtime_lec',
'batch-card' => 'cust_bill_batch',
#?'retriable' =>
'send' => 'cust_bill_send',
- 'send_email' => 'NOTYET',
+ 'send_email' => 'cust_bill_email',
'send_alternate' => 'cust_bill_send_alternate',
'send_if_newest' => 'cust_bill_send_if_newest',
'send_agent' => 'cust_bill_send_agent',
@@ -64,7 +67,15 @@ foreach my $part_bill_event (
my %plandata = map { /^(\w+) (.*)$/; ($1, $2); }
split(/\n/, $part_bill_event->plandata);
- #XXX may need to fudge some plandata2option names!!!
+ #XXX may need to fudge some other plandata2option names
+
+ my $balanceover = 0;
+ my $honor_dundate = 0;
+
+ if ( $part_bill_event->plan eq 'suspend-if-balance' ) {
+ $balanceover = delete $plandata{'balanceover'};
+ $honor_dundate = ( (delete $plandata{'balance_honor_dundate'}) =~ /1/ );
+ }
my $part_event = new FS::part_event {
'event' => $part_bill_event->event,
@@ -86,12 +97,12 @@ foreach my $part_bill_event (
};
$error = $once->insert;
die $error if $error;
-
+
my $balance = new FS::part_event_condition {
'eventpart' => $part_event->eventpart,
'conditionname' => 'balance'
};
- $error = $balance->insert( 'balance' => 0 );
+ $error = $balance->insert( 'balance' => $balanceover );
die $error if $error;
my $cust_bill_owed = new FS::part_event_condition {
@@ -118,35 +129,59 @@ foreach my $part_bill_event (
die $error if $error;
}
+
+ if ( $honor_dundate ) {
+ my $dundate = new FS::part_event_condition {
+ 'eventpart' => $part_event->eventpart,
+ 'conditionname' => 'dundate'
+ };
+ $error = $dundate->insert();
+ die $error if $error;
+ }
#my $derror = $part_bill_event->delete;
#die "error removing part_bill_event: $derror\n" if $derror;
- foreach my $cust_bill_event (
- qsearch({
- 'table' => 'cust_bill_event',
- 'hashref' => { 'eventpart' => $part_bill_event->eventpart, },
- })
- ) {
-
- my $cust_event = new FS::cust_event {
- 'eventpart' => $part_event->eventpart,
- 'tablenum' => $cust_bill_event->invnum,
- '_date' => $cust_bill_event->_date,
- 'status' => $cust_bill_event->status,
- 'statustext' => $cust_bill_event->statustext,
- };
+# if ( $opt_m ) {
- my $cerror = $cust_event->insert;
- #die "error inserting cust_event: $cerror\n" if $cerror;
- warn "error inserting cust_event: $cerror\n" if $cerror;
-
- #my $dcerror = $cust_bill_event->delete;
- #die "error removing cust_bill_event: $dcerror\n" if $dcerror;
+ my $sth = dbh->prepare('
+ INSERT INTO cust_event ( eventpart, tablenum, _date, status, statustext )
+ SELECT ? , invnum , _date, status, statustext
+ FROM cust_bill_event WHERE eventpart = ?
+ ') or die dbh->errstr;
- print ".";
+ $sth->execute( $part_event->eventpart, $part_bill_event->eventpart )
+ or die $sth->errstr;
- }
+# } else {
+#
+# foreach my $cust_bill_event (
+# qsearch({
+# 'table' => 'cust_bill_event',
+# 'hashref' => { 'eventpart' => $part_bill_event->eventpart, },
+# })
+# ) {
+#
+# my $cust_event = new FS::cust_event {
+# 'eventpart' => $part_event->eventpart,
+# 'tablenum' => $cust_bill_event->invnum,
+# '_date' => $cust_bill_event->_date,
+# 'status' => $cust_bill_event->status,
+# 'statustext' => $cust_bill_event->statustext,
+# };
+#
+# my $cerror = $cust_event->insert;
+# #die "error inserting cust_event: $cerror\n" if $cerror;
+# warn "error inserting cust_event: $cerror\n" if $cerror;
+#
+# #my $dcerror = $cust_bill_event->delete;
+# #die "error removing cust_bill_event: $dcerror\n" if $dcerror;
+#
+# print ".";
+#
+# }
+#
+# }
print "\n";
@@ -181,6 +216,8 @@ Doesn't migrate reasons.
Doesn't delete the old events (which is not a big deal, since the new code
won't run them...)
+Can take lots of memory for large databases.
+
=head1 SEE ALSO
=cut
diff --git a/bin/fs-migrate-cust_tax_exempt b/bin/fs-migrate-cust_tax_exempt
index ede80b0..35c74ff 100755
--- a/bin/fs-migrate-cust_tax_exempt
+++ b/bin/fs-migrate-cust_tax_exempt
@@ -23,7 +23,7 @@ my $fuz = 7; #seconds
#site-specific rewrites
my %rewrite = (
#cust_tax_exempt.exemptnum => { 'field' => 'newvalue', ... },
- '23' => { month=>10, year=>2005, invnum=>1640 },
+# '23' => { month=>10, year=>2005, invnum=>1640 },
#etc.
);
diff --git a/bin/generate-table-module b/bin/generate-table-module
index 509feed..16a23e5 100755
--- a/bin/generate-table-module
+++ b/bin/generate-table-module
@@ -66,6 +66,17 @@ close SRC;
close DEST;
###
+# add to FS/FS/Mason.pm
+###
+
+# it needs to be:
+# 1. disablable (have an option to turn it off)
+# 2. documented in the schema change docs
+#
+#my $magic = '# Sammath Naur';
+#system("perl -pi -e 's/$magic/use FS::$table;\n $magic/' FS/FS/Mason.pm");
+
+###
# add FS/t/table.t
###
diff --git a/bin/h_cust_main-wipe_paycvv b/bin/h_cust_main-wipe_paycvv
new file mode 100755
index 0000000..d34c15f
--- /dev/null
+++ b/bin/h_cust_main-wipe_paycvv
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+
+use strict;
+use FS::UID qw(adminsuidsetup dbh);
+use FS::Record; #buh?
+
+my $user = shift or die 'usage';
+adminsuidsetup $user;
+
+while (1) {
+
+ my $sql = ' UPDATE h_cust_main SET paycvv = NULL
+ WHERE historynum IN ( SELECT historynum FROM h_cust_main
+ WHERE paycvv IS NOT NULL LIMIT 8192 )';
+# WHERE paycvv IS NOT NULL LIMIT 1 )';
+
+ my $sth = dbh->prepare($sql) or die dbh->errstr;
+
+ print '.'; $|=1;
+
+ my $rv = $sth->execute;
+
+ dbh->commit or die dbh->errstr;
+
+ last if $rv == 0;
+
+}
+
+print "\n";
+
diff --git a/bin/make-pkg-fruit b/bin/make-pkg-fruit
new file mode 100755
index 0000000..61d707f
--- /dev/null
+++ b/bin/make-pkg-fruit
@@ -0,0 +1,172 @@
+#!/usr/bin/perl -w
+
+use strict;
+use FS::UID qw( adminsuidsetup );
+use FS::Record qw( qsearch qsearchs );
+use FS::part_export;
+use FS::export_svc;
+use FS::pkg_svc;
+use FS::part_svc;
+use FS::part_pkg;
+use FS::cust_svc;
+use FS::svc_Common;
+use FS::svc_broadband;
+use FS::part_svc_router;
+
+my $exporttype = 'prizm';
+my $pkg_property = 'pkg';
+my $svc_property = 'performance_profile';
+
+my $user = shift or die &usage;
+
+$FS::svc_Common::noexport_hack = 1;
+$FS::cust_svc::ignore_quantity = 1;
+$FS::UID::AutoCommit = 0;
+
+my $DEBUG = 0;
+
+my $dbh = adminsuidsetup($user);
+
+my @exportnum = map { $_->exportnum }
+ qsearch( 'part_export', { 'exporttype' => $exporttype } );
+
+die "no $exporttype exports found\n" unless scalar(@exportnum);
+
+my %pkg_svc_map = ();
+
+my @old_svcpart = ();
+push @old_svcpart, map { $_->svcpart }
+ qsearch ( 'export_svc', { 'exportnum' => $_ } )
+ foreach @exportnum;
+
+die "no svcparts found\n" unless scalar(@old_svcpart);
+
+foreach (@old_svcpart) {
+ foreach my $pkg_svc ( qsearch( 'pkg_svc',
+ { 'svcpart' => $_,
+ 'quantity' => { 'op' => '>',
+ 'value' => '0',
+ },
+ }
+ )
+ )
+ {
+ warn "updating package ". $pkg_svc->pkgpart. "\n" if $DEBUG;
+ my $pkg_from = $pkg_svc->part_pkg->$pkg_property;
+ unless ( $pkg_svc_map{ $pkg_from }{ $pkg_svc->svcpart } ) {
+ my $old_part_svc = $pkg_svc->part_svc;
+ my $part_svc = new FS::part_svc( { $old_part_svc->hash } );
+ $part_svc->svcpart('');
+
+ my $svcdb = $part_svc->svcdb;
+ foreach ( $old_part_svc->all_part_svc_column ) {
+ my $formatter = FS::part_svc->svc_table_fields($svcdb)->{$_}->{format}
+ || sub { shift };
+
+ $part_svc->setfield( $svcdb.'__'.$_->columnname.'_flag', $_->columnflag);
+ $part_svc->setfield( $svcdb.'__'.$_->columnname,
+ &$formatter($_->columnvalue)
+ );
+ }
+
+ my $formatter =
+ FS::part_svc->svc_table_fields($svcdb)->{$svc_property}->{format}
+ || sub { shift };
+ $part_svc->setfield( $svcdb.'__'.$svc_property.'_flag', 'F');
+ $part_svc->setfield( $svcdb.'__'.$svc_property,
+ &$formatter($pkg_svc->part_pkg->$pkg_property)
+ );
+ my $error = $part_svc->insert( [],
+ { map { $_->exportnum => 1 }
+ $old_part_svc->part_export
+ },
+ );
+ die "error inserting service: $error\n" if $error;
+
+ # this part is specific to svc_broadband
+ foreach (qsearch( 'part_svc_router', { 'svcpart' => $pkg_svc->svcpart } ))
+ {
+ my $part_svc_router = new FS::part_svc_router( { $_->hash } );
+ $part_svc_router->svcrouternum( '' );
+ $part_svc_router->svcpart( $part_svc->svcpart );
+ my $error = $part_svc_router->insert;
+ die "error associating service with router: $error\n" if $error;
+ }
+
+ $pkg_svc_map{ $pkg_from }{ $pkg_svc->svcpart } = $part_svc->svcpart;
+
+ }
+
+ my $new_pkg_svc = new FS::pkg_svc( { $pkg_svc->hash } );
+ $new_pkg_svc->svcpart( $pkg_svc_map{ $pkg_from }{ $pkg_svc->svcpart } );
+ my $error = $pkg_svc->delete;
+ die "error removing old service from package: $error\n" if $error;
+ $error = $new_pkg_svc->insert;
+ die "error adding new service to package: $error\n" if $error;
+
+ }
+}
+warn "done with packages\n" if $DEBUG;
+
+foreach my $svcpart ( @old_svcpart ) {
+ foreach my $cust_svc ( qsearch( 'cust_svc', { 'svcpart' => $svcpart } ) ) {
+ my $svc_x = $cust_svc->svc_x;
+ my $cust_pkg = $cust_svc->cust_pkg;
+ die "can't handle unattached service ". $cust_svc->svcnum unless $cust_pkg;
+ my $pkg_from = $cust_pkg->part_pkg->$pkg_property;
+ $svc_x->setfield( $svc_property, $pkg_from );
+ $svc_x->setfield( 'svcpart', $pkg_svc_map{ $pkg_from }{ $svcpart } );
+ my $error = $svc_x->replace;
+ die "error replacing service ". $svc_x->svcnum. ": $error\n" if $error;
+
+ $cust_svc->svcpart( $pkg_svc_map{ $pkg_from }{ $svcpart } );
+ $error = $cust_svc->replace;
+ die "error replacing customer service ". $cust_svc->svcnum. ": $error\n"
+ if $error;
+ }
+
+ my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
+ die "can't find old part_svc!" unless $part_svc;
+
+ my $new_part_svc = new FS::part_svc( { $part_svc->hash } );
+ $new_part_svc->disabled('Y');
+ my $svcdb = $part_svc->svcdb;
+ foreach ( $part_svc->all_part_svc_column ) {
+ my $formatter = FS::part_svc->svc_table_fields($svcdb)->{$_}->{format}
+ || sub { shift };
+
+ $part_svc->setfield( $svcdb.'__'.$_->columnname.'_flag', $_->columnflag);
+ $part_svc->setfield( $svcdb.'__'.$_->columnname,
+ &$formatter($_->columnvalue)
+ );
+ }
+ my $error = $new_part_svc->replace($part_svc, '1.3-COMPAT');
+ die "error disabling service: $error\n" if $error;
+}
+
+$dbh->commit or die $dbh->errstr;
+$dbh->disconnect or die $dbh->errstr;
+
+
+sub usage {
+ die "Usage:\n\n make-pkg-fruit user\n";
+}
+
+=head1 NAME
+
+make-pkg-fruit - Tool to migrate package properties to services
+
+=head1 SYNOPSIS
+
+ make-pkg-fruit
+
+=head1 DESCRIPTION
+
+Multiplies out services with package properties and migrates package
+definitions and customer services to the new services. Read the source.
+
+=head1 SEE ALSO
+
+=cut
+
+1;
diff --git a/bin/mapsecrets2access_user b/bin/mapsecrets2access_user
index 945f130..d632360 100755
--- a/bin/mapsecrets2access_user
+++ b/bin/mapsecrets2access_user
@@ -24,7 +24,7 @@ unless ( $supergroup ) {
my $error = $supergroup->insert;
die $error if $error;
- foreach my $rightname ( FS::AccessRight->rights ) {
+ foreach my $rightname ( FS::AccessRight->default_superuser_rights ) {
my $access_right = new FS::access_right {
'righttype' => 'FS::access_group',
'rightobjnum' => $supergroup->groupnum,
diff --git a/bin/move-customers b/bin/move-customers
new file mode 100755
index 0000000..a7ea197
--- /dev/null
+++ b/bin/move-customers
@@ -0,0 +1,678 @@
+#!/usr/bin/perl -w
+
+#script to move customers from one installation to another
+# source is remote, destination is local
+# script is kinda-specific to a somewhat old source installation (1.7? older?)
+# target installation has to be 1.9 (after 9/2009)
+
+use strict;
+use vars qw( $sdbh );
+use DBI;
+use FS::UID qw( adminsuidsetup dbh );
+use FS::Schema qw( dbdef );
+use FS::Record qw( qsearchs );
+use FS::agent;
+use FS::cust_main;
+use FS::part_pkg;
+use FS::part_svc;
+use FS::cust_bill_ApplicationCommon;
+use FS::svc_Common;
+use FS::cust_event;
+use FS::svc_domain;
+use FS::cust_pkg;
+
+my $DANGEROUS = 0;
+my $DRY = 0;
+
+#ssh -p 2222 -L 1080:66.209.32.4:7219 -L 5454:localhost:5432 66.209.32.4
+
+#my $source_datasrc = 'DBI:Pg:host=66.209.32.4;dbname=freeside;sslmode=require';
+my $source_datasrc = 'DBI:Pg:host=localhost;port=5454;dbname=freeside';
+my $source_user = 'readonly';
+my $source_pw = '';
+
+#my @source_agents = ( 2, 7, 3, 4, 5, 1 );
+my @source_agents = ( 1, 2, 3, 4, 5, 7 );
+
+my $dest_agent_typenum = 12;
+
+my $dest_refnum = 60;
+
+my $dest_legacy_credit_reasontype = 5;
+
+my $dest_pkg_classnum = 6;
+
+my %domsvc_map = (
+ 1 => 20450,
+ 3653 => 20162,
+ 7634 => 20451,
+);
+
+#testing
+#my %eventparts = (
+# 'CARD' => [ 1, ],
+# 'CHEK' => [],
+# 'BILL' => [],
+# 'DCHK' => [],
+# 'DCRD' => [],
+# 'COMP' => [],
+#);
+#production
+my %eventparts = (
+ 'CARD' => [ 1, ],
+ 'CHEK' => [ 2, ],
+ 'BILL' => [ 5, ],
+ 'DCHK' => [ 12, ],
+ 'DCRD' => [ 15, ],
+ 'COMP' => [],
+);
+
+#--
+
+# target(local) setup
+
+my $user = shift
+ or die "Usage:\n (edit variables at top of script and then)\n".
+ " move-customers user\n";
+adminsuidsetup $user;
+
+$FS::cust_main::ignore_expired_card = 1;
+$FS::cust_main::ignore_expired_card = 1;
+$FS::part_pkg::skip_pkg_svc_hack = 1;
+$FS::part_pkg::skip_pkg_svc_hack = 1;
+$FS::cust_bill_ApplicationCommon::skip_apply_to_lineitems_hack = 1;
+$FS::cust_bill_ApplicationCommon::skip_apply_to_lineitems_hack = 1;
+$FS::svc_Common::noexport_hack = 1;
+$FS::svc_Common::noexport_hack = 1;
+$FS::svc_domain::whois_hack = 1;
+$FS::svc_domain::whois_hack = 1;
+$FS::cust_pkg::disable_agentcheck = 1;
+$FS::cust_pkg::disable_agentcheck = 1;
+
+my $void_paynum = 2147483646; #top of int range
+
+# --
+
+# source(remote) setup
+
+$sdbh = DBI->connect($source_datasrc, $source_user, $source_pw)
+ or die $DBI::errstr;
+
+$sdbh->{ChopBlanks} = 1;
+
+# --
+
+my %map = ();
+$map{'_DOMSVC'} = \%domsvc_map;
+
+import_table('pkg_class', 'nomap' => 1);
+import_table('svc_acct_pop', 'nomap' => 1);
+
+#XXX
+#import_table('reason_type', 'nomap' => 1);
+#foreach my $src_typenum ( keys %{ $map{'reason_type'} } ) {
+# import_table('reason', 'reason_type' => $src_typenum,
+# 'search' => 'reason_type',
+# 'map' => 'reason_type',
+# );
+#}
+
+my $agent_sth = $sdbh->prepare(
+ 'SELECT * FROM agent WHERE agentnum IN ( '. join(',', @source_agents ). ')'
+) or die $sdbh->errstr;
+
+$agent_sth->execute or die $agent_sth->errstr;
+
+
+while ( my $agentrow = $agent_sth->fetchrow_hashref ) {
+
+ my $src_agent = $agentrow->{'agent'};
+
+ warn "importing customers for $src_agent\n";
+
+ my $agent = qsearchs('agent', { 'agent' => $src_agent, 'disabled' => '' } );
+
+ if ( $agent ) {
+
+ warn " using existing agentnum ". $agent->agentnum. "\n";
+
+ if ( $DANGEROUS ) {
+ warn "DELETING ALL CUSTOMERS OF $src_agent locally \n";
+
+ foreach my $statement (
+ 'DELETE FROM cust_main WHERE agentnum = '. $agent->agentnum,
+ ( map { "DELETE FROM $_
+ WHERE 0 = ( SELECT COUNT(*) FROM cust_main
+ WHERE cust_main.custnum = $_.custnum )
+ "
+ }
+ qw(
+ cust_credit
+ cust_main_invoice
+ cust_main_note
+ cust_pay
+ cust_refund
+ )
+ )
+ #pkg_class, part_pkg_pop
+ #part_pkg, pkg_svc, part_svc, part_svc_column
+ #XXX more... does it matter?
+ ) {
+
+ #warn $statement;
+ my $sth = dbh->prepare($statement) or die dbh->errstr;
+ $sth->execute or die $sth->errstr;
+
+ }
+
+ dbh->commit or die dbh->errstr;
+
+ }
+
+ } else {
+
+ warn " creating new agent...\n";
+
+ $agent = new FS::agent { 'agent' => $src_agent,
+ 'typenum' => $dest_agent_typenum };
+ my $error = $agent->insert;
+ die $error if $error;
+
+ warn " agentnum ". $agent->agentnum. "\n";
+
+ }
+
+ $map{'agent'}->{ $agentrow->{'agentnum'} } = $agent->agentnum;
+
+}
+
+ #my $customer_sth = $sdbh->prepare(
+ # 'SELECT * FROM cust_main WHERE agentnum = '. $agentrow->{'agentnum'}
+ #) or die $sdbh->errstr;
+my $customer_sth = $sdbh->prepare(
+ 'SELECT * FROM cust_main WHERE agentnum IN ( '. join(',', @source_agents ). ')
+ ORDER BY custnum'
+) or die $sdbh->errstr;
+
+$customer_sth->execute or die $customer_sth->errstr;
+
+while ( my $customerrow = $customer_sth->fetchrow_hashref ) {
+
+ #use Data::Dumper;
+ # warn Dumper($customerrow);
+ my $src_custnum = $customerrow->{'custnum'};
+
+ warn " $src_custnum has referral_custnum ". $customerrow->{'referral_custnum'}
+ if $customerrow->{'referral_custnum'};
+
+ my $cust_main = new FS::cust_main {
+ %{ $customerrow },
+ 'custnum' => '',
+ 'referral_custnum' => '', #restore afterwords?
+ 'refnum' => $dest_refnum,
+ 'agentnum' => $map{'agent'}->{ $customerrow->{'agentnum'} },
+ 'agent_custid' => $src_custnum,
+ };
+
+ #$cust_main->ship_country('') if $cust_main->ship_country eq ' ';
+ #$cust_main->tax('') if $cust_main->tax =~ /^\s+$/;
+
+ my $error = $cust_main->insert;
+ if ( $error ) {
+ warn "*** WARNING: error importing customer src custnum $src_custnum: $error";
+ use Data::Dumper;
+ warn Dumper($cust_main) if $src_custnum == 6854;
+ next;
+ }
+
+ warn "inserting dest customer ". $cust_main->custnum. " for $src_custnum\n";
+
+ $map{'cust_main'}->{$src_custnum} = $cust_main->custnum;
+
+ #now import the relations, easy and hard:
+
+ import_table( 'cust_main_note', 'custnum' => $src_custnum );
+
+ import_table( 'cust_pay', 'custnum' => $src_custnum,
+ #ivan showing up as cust_pay otaker
+ # old db doesn't have cust_pay.otaker, pull it from history
+ 'preinsert_callback' => sub {
+ my($row, $cust_pay) = @_;
+
+ my $sth = $sdbh->prepare(
+ "SELECT history_user FROM h_cust_pay WHERE history_action = 'insert'
+ AND paynum = ". $row->{'paynum'}
+ ) or die $sdbh->errstr;
+ $sth->execute or die $sth->errstr;
+ my $otaker = $sth->fetchrow_arrayref->[0];
+
+ $cust_pay->otaker($otaker);
+ },
+ );
+
+ # crap, cust_credit.reason is text in old db
+#*** WARNING: error importing cust_credit src crednum 2200: failed to set reason for [ FS::cust_credit ]: at ./move-customers line 232.
+ import_table( 'cust_credit', 'custnum' => $src_custnum,
+ 'insert_opts' => [ 'reason_type' => $dest_legacy_credit_reasontype ],
+ 'preinsert_callback' => sub {
+ my($row, $object) = @_;
+ $object->set('reason', '(none)') if $object->get('reason') =~ /^\s*$/;
+ },
+ );
+
+ import_table( 'cust_refund', 'custnum' => $src_custnum,
+ 'post_callback' => sub {
+ #my( $src_refundnum, $dst_refundnum ) = @_;
+ my $src_refundnum = shift;
+
+ # cust_credit_refund (map refundnum and crednum...)
+ import_table( 'cust_credit_refund',
+ 'refundnum' => $src_refundnum,
+ 'search' => 'refundnum',
+ 'map' => 'cust_refund',
+ 'map2' => 'cust_credit',
+ 'map2key' => 'crednum',
+ );
+
+ # cust_pay_refund (map refundnum and paynum...)
+ import_table( 'cust_pay_refund',
+ 'refundnum' => $src_refundnum,
+ 'search' => 'refundnum',
+ 'map' => 'cust_refund',
+ 'map2' => 'cust_pay',
+ 'map2key' => 'paynum',
+ );
+
+ },
+ );
+
+ # dunno what's up with this (ship_country ' ', fixed)
+#*** WARNING: error importing customer src custnum 6854: Illegal (name) (error code illegal_name) ship_last: at ./move-customers line 129.
+
+ # cust_pay_void
+ import_table( 'cust_pay_void', 'custnum' => $src_custnum,
+ 'preinsert_callback' => sub {
+ my($row, $object) = @_;
+ $object->paynum( $void_paynum-- );
+ },
+ );
+
+ # (not in old db: cust_attachment, cust_statement, cust_location,
+ # cust_main_exemption, cust_pay_pending )
+ # (not used in old db: cust_pay_batch, cust_tax_exempt)
+ # (not useful to migrate: queue)
+
+ #werid direct cust_main relations:
+
+ # cust_pkg (part_pkg, part_svc, etc.)
+ import_table( 'cust_pkg', 'custnum' => $src_custnum,
+ 'preinsert_callback' => sub {
+ my($row, $object) = @_;
+ my $src_pkgpart = $row->{'pkgpart'} or die "wtf";
+ my $dest_pkgpart = $map{'part_pkg'}->{$src_pkgpart};
+ if ( $dest_pkgpart ) {
+ $object->pkgpart($dest_pkgpart);
+ return;
+ }
+
+ my $sth = $sdbh->prepare(
+ "SELECT * FROM part_pkg WHERE pkgpart = $src_pkgpart"
+ ) or die $sdbh->errstr;
+
+ $sth->execute or die $sth->errstr;
+
+ my $part_pkg_row = $sth->fetchrow_hashref
+ or die "cust_pkg.pkgpart missing in part_pkg?!";
+
+ my $hashref = {
+ %{ $part_pkg_row },
+ 'pkgpart' => '',
+ };
+ my $src_classnum = $part_pkg_row->{'classnum'};
+ $hashref->{'classnum'} = $map{'pkg_class'}->{ $src_classnum }
+ if $src_classnum;
+
+ my $part_pkg = new FS::part_pkg $hashref;
+
+ #$part_pkg->setuptax('') if $part_pkg->setuptax =~ /^\s+$/;
+ #$part_pkg->recurtax('') if $part_pkg->recurtax =~ /^\s+$/;
+
+ my $error = $part_pkg->insert( 'options' => {} );
+ die "*** FATAL: error importing part_pkg src pkgpart $src_pkgpart ".
+ ": $error"
+ if $error;
+
+ $map{ 'part_pkg' }->{ $part_pkg_row->{'pkgpart'} } = $part_pkg->pkgpart;
+
+ # part_pkg_option
+ import_table( 'part_pkg_option',
+ 'pkgpart' => $src_pkgpart,
+ 'search' => 'pkgpart',
+ 'map' => 'part_pkg',
+ );
+
+ my $osth = $sdbh->prepare(
+ "SELECT * FROM part_pkg_option WHERE pkgpart = $src_pkgpart"
+ ) or die $sdbh->errstr;
+
+ # pkg_svc, part_svc, part_svc_column
+ import_table( 'pkg_svc',
+ 'pkgpart' => $src_pkgpart,
+ 'search' => 'pkgpart',
+ 'map' => 'part_pkg',
+ 'preinsert_callback' => sub {
+
+ my($row, $object) = @_;
+ my $src_svcpart = $row->{'svcpart'} or die "wtf2";
+ my $dest_svcpart = $map{'part_svc'}->{$src_svcpart};
+ if ( $dest_svcpart ) {
+ $object->svcpart($dest_svcpart);
+ return;
+ }
+
+ my $sth = $sdbh->prepare(
+ "SELECT * FROM part_svc WHERE svcpart = $src_svcpart"
+ ) or die $sdbh->errstr;
+
+ $sth->execute or die $sth->errstr;
+
+ my $part_svc_row = $sth->fetchrow_hashref
+ or die "svcpart missing in part_svc?!";
+
+ my $hashref = {
+ %{ $part_svc_row },
+ 'svcpart' => '',
+ };
+
+ my $part_svc = new FS::part_svc $hashref;
+ $part_svc->disabled('') if $part_svc->disabled =~ /^\s+$/;
+ my $error = $part_svc->insert;
+ die "*** FATAL: error importing part_svc src svcpart $src_svcpart ".
+ ": $error"
+ if $error;
+
+ $map{ 'part_svc' }->{ $part_svc_row->{'svcpart'} } = $part_svc->svcpart;
+
+ # part_svc_column
+ import_table( 'part_svc_column',
+ 'svcpart' => $src_svcpart,
+ 'search' => 'svcpart',
+ 'map' => 'part_svc',
+ 'preinsert_callback' => sub {
+ my($row, $object) = @_;
+ if ( $object->columnname eq 'domsvc' ) {
+ $object->columnvalue( $map{'_DOMSVC'}->{ $object->columnvalue } );
+ }
+ },
+ );
+
+ #what we came here for in the first place
+ $object->svcpart( $part_svc->svcpart );
+
+ }
+ );
+
+ #what we came here for in the first place
+ $object->pkgpart( $part_pkg->pkgpart );
+
+ },
+
+ 'post_callback' => sub {
+ #my( $src_pkgnum, $dst_pkgnum ) = @_;
+ my $src_pkgnum = shift;
+
+ #XXX grr... action makes this very hard...
+ ## cust_pkg_reason (shit, and bring in/remap reasons)
+ #import_table( 'cust_pkg_reason',
+ # 'pkgnum' => $src_pkgnum,
+ # 'search' => 'pkgnum',
+ # 'map' => 'cust_pkg',
+ # 'map2' => 'reason',
+ # 'map2key' => 'reasonnum',
+ # );
+
+ #cust_svc
+ import_table( 'cust_svc',
+ 'pkgnum' => $src_pkgnum,
+ 'search' => 'pkgnum',
+ 'map' => 'cust_pkg',
+ 'map2' => 'part_svc',
+ 'map2key' => 'svcpart',
+ 'post_callback' => sub {
+ #my( $src_svcnum, $dst_svcnum ) = @_;
+ my $src_svcnum = shift;
+
+ #svc_domain
+ import_table( 'svc_domain',
+ 'svcnum' => $src_svcnum,
+ 'search' => 'svcnum',
+ 'map' => 'cust_svc',
+ 'noblank_primary' => 1,
+ );
+
+ #svc_acct
+ import_table( 'svc_acct',
+ 'svcnum' => $src_svcnum,
+ 'search' => 'svcnum',
+ 'map' => 'cust_svc',
+ 'noblank_primary' => 1,
+ 'map2' => 'svc_acct_pop',
+ 'map2key' => 'popnum',
+ #'map3' => 'svc_domain',
+ 'map3' => '_DOMSVC',
+ 'map3key' => 'domsvc',
+ );
+
+ #radius_usergroup
+ import_table( 'radius_usergroup',
+ 'svcnum' => $src_svcnum,
+ 'search' => 'svcnum',
+ 'map' => 'cust_svc',
+ );
+
+ #other svc_ tables not in old db
+
+ },
+ );
+
+ },
+
+
+
+
+ );
+ # end of cust_pkg (part_pkg, part_svc, etc.)
+
+ # cust_bill (invnum move)
+ import_table( 'cust_bill', 'custnum' => $src_custnum,
+ 'preinsert_callback' => sub {
+ my($row, $object) = @_;
+ $object->agent_invid( $row->{'invnum'} );
+ },
+ 'post_callback' => sub {
+ my( $src_invnum, $dst_invnum ) = @_;
+ #my $src_invnum = shift;
+
+ # cust_bill_pkg ( map invnum and pkgnum... )
+ import_table( 'cust_bill_pkg',
+ 'invnum' => $src_invnum,
+ 'search' => 'invnum',
+ 'map' => 'cust_bill',
+ 'map2' => 'cust_pkg',
+ 'map2key' => 'pkgnum',
+ 'post_callback' => sub {
+ my $src_billpkgnum = shift;
+
+ import_table( 'cust_bill_pkg_detail',
+ 'billpkgnum' => $src_billpkgnum,
+ 'search' => 'billpkgnum',
+ 'map' => 'cust_bill_pkg',
+ 'addl_from' => 'left join cust_bill_pkg using ( invnum, pkgnum )',
+ );
+
+ },
+ );
+
+ # cust_credit_bill (map invnum and crednum... )
+ import_table( 'cust_credit_bill',
+ 'invnum' => $src_invnum,
+ 'search' => 'invnum',
+ 'map' => 'cust_bill',
+ 'map2' => 'cust_credit',
+ 'map2key' => 'crednum',
+ 'post_callback' => sub {
+ my $src_creditbillnum = shift;
+ #map creditbillnum and billpkgnum
+ import_table( 'cust_credit_bill_pkg',
+ 'creditbillnum' => $src_creditbillnum,
+ 'search' => 'creditbillnum',
+ 'map' => 'cust_credit_bill',
+ 'map2' => 'cust_bill_pkg',
+ 'map2key' => 'billpkgnum',
+ );
+
+ },
+ );
+
+ # cust_bill_pay (map invnum and paynum...)
+ import_table( 'cust_bill_pay',
+ 'invnum' => $src_invnum,
+ 'search' => 'invnum',
+ 'map' => 'cust_bill',
+ 'map2' => 'cust_pay',
+ 'map2key' => 'paynum',
+ 'post_callback' => sub {
+ my $src_billpaynum = shift;
+ #map billpaynum and billpkgnum
+ import_table( 'cust_bill_pay_pkg',
+ 'billpaynum' => $src_billpaynum,
+ 'search' => 'billpaynum',
+ 'map' => 'cust_bill_pay',
+ 'map2' => 'cust_bill_pkg',
+ 'map2key' => 'billpkgnum',
+ );
+ },
+ );
+
+ #need to do something about events. mark initial stuff as done
+ foreach my $eventpart ( @{ $eventparts{$cust_main->payby} } ) {
+
+ my $cust_event = new FS::cust_event {
+ 'eventpart' => $eventpart,
+ 'tablenum' => $dst_invnum,
+ '_date' => time, # XXX something? probably not
+ 'status' => 'done',
+ };
+
+ my $error = $cust_event->insert;
+ die "*** FATAL: error inserting cust_event for eventpart $eventpart,".
+ " tablenum (invnum) $dst_invnum: $error"
+ if $error;
+
+ }
+
+ },
+ );
+
+ # ---
+
+ # (not in old db: cust_pkg_detail)
+ # (not used in old db: cust_bill_pay_batch, cust_pkg_option)
+
+ # ---
+
+ # (not in old db: cust_bill_pkg_display, cust_bill_pkg_tax_location,
+ # cust_bill_pkg_tax_rate_location, cust_tax_adjustment, cust_svc_option, )
+ # (not used in old db: cust_tax_exempt_pkg)
+
+ #do this last, so no notices go out
+ import_table( 'cust_main_invoice', 'custnum' => $src_custnum );
+
+ #dbh->commit or die dbh->errstr;
+ warn "customer ". $cust_main->custnum. " inserted\n";
+ #exit;
+
+}
+
+
+warn "import successful!\n";
+if ( $DRY ) {
+ warn "rolling back (dry run)\n";
+ dbh->rollback or die dbh->errstr;
+ warn "rolled back\n"
+} else {
+ warn "commiting\n";
+ dbh->commit or die dbh->errstr;
+ warn "committed\n";
+}
+
+sub import_table {
+ my( $table, %opt ) = @_;
+
+ eval "use FS::$table;";
+ die $@ if $@;
+
+ my $map = $opt{'map'} || 'cust_main';
+ my $search = $opt{'search'} || 'custnum';
+
+ $opt{'insert_opts'} ||= [];
+
+ my $primary_key = dbdef->table($table)->primary_key;
+
+ my $addl_from = defined($opt{'addl_from'}) ? $opt{'addl_from'} : '';
+
+ my $sth = $sdbh->prepare(
+ "SELECT * FROM $table $addl_from ".
+ ( $opt{'nomap'} ? '' : " WHERE $search = ". $opt{$search} )
+ ) or die $sdbh->errstr;
+
+ $sth->execute or die "(searching $table): ". $sth->errstr;
+
+ while ( my $row = $sth->fetchrow_hashref ) {
+ #my $src_custnum = $customerrow->{'custnum'};
+
+ my $hashref = { %$row };
+ $hashref->{$primary_key} = ''
+ unless $opt{'noblank_primary'};
+ $hashref->{ $search } = $map{$map}->{ $row->{$search} }
+ unless $opt{'nomap'};
+
+ if ( $opt{'map2'} ) {
+ my $key2 = $opt{'map2key'};
+ $hashref->{$key2} = $map{ $opt{'map2'} }->{ $row->{$key2} }
+ unless $opt{map2key} eq 'pkgnum' && ( $row->{$key2} eq '0'
+ || $row->{$key2} eq '-1'
+ )
+ or ! defined($row->{$key2})
+ or $row->{$key2} eq '';
+ #warn "map $opt{map2}.$opt{map2key}: ". $row->{$key2}. " to ". $map{ $opt{'map2'} }->{ $row->{$key2} };
+ }
+
+ if ( $opt{'map3'} ) {
+ my $key3 = $opt{'map3key'};
+ $hashref->{$key3} = $map{ $opt{'map3'} }->{ $row->{$key3} };
+ }
+
+ my $object = eval "new FS::$table \$hashref;";
+ die $@ if $@;
+
+ &{ $opt{preinsert_callback} }( $row, $object )
+ if $opt{preinsert_callback};
+
+ my $error = $object->insert( @{ $opt{'insert_opts'} } );
+ if ( $error ) {
+ warn "*** WARNING: error importing $table src $primary_key ". $row->{$primary_key}. ": $error";
+ next;
+ }
+
+ $map{ $table }->{ $row->{$primary_key} } = $object->get($primary_key);
+
+ &{ $opt{post_callback} }( $row->{$primary_key}, $object->get($primary_key) )
+ if $opt{post_callback};
+
+ }
+
+}
+
+1;
+
diff --git a/bin/ping b/bin/ping
new file mode 100755
index 0000000..605a204
--- /dev/null
+++ b/bin/ping
@@ -0,0 +1,58 @@
+#!/usr/bin/perl
+
+use Net::Ping;
+use Net::SSH qw( ssh_cmd );
+use Email::Send;
+
+my @other_hosts = ( 'freeside.biz', 'saturn5.com' );
+
+my( $machine, @emails ) = @ARGV;
+die "no notification email given" unless @emails;
+
+my $ping = new Net::Ping; # 'icmp'; #requires root
+
+my $pong = '';
+# can't tcp ping... $ping->ping($machine) and
+$pong = eval { ssh_cmd('freeside@'.$machine, 'echo pong') };
+#(command ignored if authorized_keys setup w/command=)
+
+if ( $@ || $pong !~ /pong/ ) { #houston, we may have a problem
+
+ #warn "can't reach $machine, checking @other_hosts\n";
+
+ #let's do a sanity check, can we see some other hosts?
+ exit unless grep $ping->ping($_), @other_hosts;
+
+ #uh-oh, this is bad.
+
+ #warn "checking to see if we've alerted on this recently\n";
+
+ #but we don't want to be too noisy, have we alerted on this in the last 24h?
+ my $file = "/tmp/alert-$machine";
+ exit if -e $file && -M $file < 1;
+
+ open(FILE, ">>$file");
+ print FILE "emailing\n";
+ close FILE;
+
+ #warn "emailing alerts\n";
+
+ foreach my $email ( @emails ) {
+
+ my $message = <<"__MESSAGE__";
+From: support\@freeside.biz
+To: $email
+Subject: ALERT - $machine
+
+ALERT: $machine appears to be down.
+
+__MESSAGE__
+
+ my $sender = Email::Send->new({mailer => 'SMTP'});
+ $sender->mailer_args([Host => 'mail.freeside.biz']);
+ $sender->send($message);
+
+ }
+
+}
+
diff --git a/bin/print-directory_assist b/bin/print-directory_assist
new file mode 100755
index 0000000..4c5e4a8
--- /dev/null
+++ b/bin/print-directory_assist
@@ -0,0 +1,12 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+my $acs = `cut -c1-3 ../etc/areacodes.txt`;
+
+my $plus = '';
+foreach my $npa ( split(/\n/, $acs ) ) {
+ warn $npa;
+ $plus .= $npa. '5551212,';
+}
+print "$plus\n";
diff --git a/bin/rebill b/bin/rebill
new file mode 100755
index 0000000..4f05238
--- /dev/null
+++ b/bin/rebill
@@ -0,0 +1,132 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Getopt::Std;
+use Date::Parse;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw( qsearch );
+use cust_main_special;
+
+&untaint_argv; #what it sounds like (eww)
+use vars qw(%opt);
+getopts("p:a:d:sy:n", \%opt);
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my (@custnums) = @ARGV;
+
+my $time = $opt{d} ? str2time($opt{d}) : $^T;
+$time += $opt{y} * 86400 if $opt{y};
+my $invoice_time = $opt{n} ? $^T : $time;
+
+my %args = (
+ 'time' => $time,
+ 'invoice_time' => $invoice_time,
+ 'actual_time' => $^T, #when freeside-bill was started
+ #(not, when using -m, freeside-queued)
+ 'resetup' => ( $opt{'s'} ? $opt{'s'} : 0 ),
+ 'backbill' => $time,
+);
+
+my $extra_sql = ( $opt{a} || $opt{p} ) ? ' AND ' : ' WHERE ';
+$extra_sql .= "( ". join( ' OR ', map{ "custnum = $_" } @custnums ). " )";
+$extra_sql = '' unless scalar @custnums;
+
+my @cust = qsearch( { table => 'cust_main',
+ hashref => { $opt{a} ? ( 'agentnum' => $opt{a} ) : (),
+ $opt{p} ? ( 'payby' => $opt{p} ) : (),
+ },
+ extra_sql => $extra_sql,
+ }
+ );
+
+foreach my $cust ( @cust ) {
+ my $balance = $cust->balance;
+ cust_main_special::bill($cust, %args);
+ if ($balance != $cust->balance){
+ $cust->apply_payments_and_credits;
+ my $error = $cust->collect(%args);
+ warn "Error collecting, custnum ". $cust->custnum. ": $error" if $error;
+ }
+}
+
+
+###
+# subroutines
+###
+
+sub untaint_argv {
+ foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
+ #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
+ # Date::Parse
+ $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
+ $ARGV[$_]=$1;
+ }
+}
+
+sub usage {
+ die "Usage:\n\n freeside-daily [ -d 'date' ] [ -y days ] [ -p 'payby' ] [ -a agentnum ] [ -s ] user [ custnum custnum ... ]\n";
+}
+
+###
+# documentation
+###
+
+=head1 NAME
+
+freeside-daily - Run daily billing and invoice collection events.
+
+=head1 SYNOPSIS
+
+ freeside-daily [ -d 'date' ] [ -y days ] [ -p 'payby' ] [ -a agentnum ] [ -s ] user [ custnum custnum ... ]
+
+=head1 DESCRIPTION
+
+Bills customers and runs invoice collection events. Should be run from
+crontab daily.
+
+Bills customers. Searches for customers who are due for billing and calls
+the bill and collect methods of a cust_main object. See L<FS::cust_main>.
+
+ -d: Pretend it's 'date'. Date is in any format Date::Parse is happy with,
+ but be careful.
+
+ -y: In addition to -d, which specifies an absolute date, the -y switch
+ specifies an offset, in days. For example, "-y 15" would increment the
+ "pretend date" 15 days from whatever was specified by the -d switch
+ (or now, if no -d switch was given).
+
+ -n: When used with "-d" and/or "-y", specifies that invoices should be dated
+ with today's date, irregardless of the pretend date used to pre-generate
+ the invoices.
+
+ -p: Only process customers with the specified payby (I<CARD>, I<DCRD>, I<CHEK>, I<DCHK>, I<BILL>, I<COMP>, I<LECB>)
+
+ -a: Only process customers with the specified agentnum
+
+ -s: re-charge setup fees
+
+ -v: enable debugging
+
+ -l: debugging level
+
+ -m: Experimental multi-process mode uses the job queue for multi-process and/or multi-machine billing.
+
+ -r: Multi-process mode dry run option
+
+ -k: skip notify_flat_delay and vacuum
+
+user: From the mapsecrets file - see config.html from the base documentation
+
+custnum: if one or more customer numbers are specified, only bills those
+customers. Otherwise, bills all customers.
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::cust_main>, config.html from the base documentation
+
+=cut
+
diff --git a/bin/svc_acct-recalculate_usage b/bin/svc_acct-recalculate_usage
new file mode 100644
index 0000000..1b3955b
--- /dev/null
+++ b/bin/svc_acct-recalculate_usage
@@ -0,0 +1,110 @@
+#!/usr/bin/perl -w
+
+use strict;
+use vars qw($opt_s $opt_u $opt_p $opt_k);
+use Getopt::Std;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch qsearchs);
+use FS::svc_acct;
+use FS::cust_svc;
+
+my %field2sub = (
+ 'seconds' => sub {
+ my($svc_acct, $cust_pkg) = @_;
+ $svc_acct->seconds_since_sqlradacct( $cust_pkg->last_bill, time );
+ },
+ 'upbytes' => sub {
+ my($svc_acct, $cust_pkg) = @_;
+ $svc_acct->attribute_since_sqlradacct(
+ $cust_pkg->last_bill, time, 'AcctInputOctets' );
+ },
+ 'downbytes' => sub {
+ my($svc_acct, $cust_pkg) = @_;
+ $svc_acct->attribute_since_sqlradacct(
+ $cust_pkg->last_bill, time, 'AcctOutputOctets' );
+ },
+ 'totalbytes' => sub {
+ my($svc_acct, $cust_pkg) = @_;
+ $svc_acct->attribute_since_sqlradacct(
+ $cust_pkg->last_bill, time, 'AcctInputOctets' )
+ +
+ $svc_acct->attribute_since_sqlradacct(
+ $cust_pkg->last_bill, time, 'AcctOutputOctets' )
+ ;
+ },
+);
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my $field = shift;
+die "can only reset seconds, upbytes, downbytes or totalbytes"
+ unless $field2sub{$field};
+
+my $value = shift;
+
+#false laziness w/freeside-reexport
+getopts('s:u:p:k:');
+
+my @svc_x = ();
+if ( $opt_s ) {
+ my $cust_svc = qsearchs('cust_svc', { svcnum=>$opt_s } )
+ or die "svcnum $opt_s not found\n";
+ push @svc_x, $cust_svc->svc_x;
+} elsif ( $opt_u ) {
+ my $svc_x = qsearchs('svc_acct', { username=>$opt_u } )
+ or die "username $opt_u not found\n";
+ push @svc_x, $svc_x;
+} elsif ( $opt_p ) {
+ push @svc_x, map { $_->svc_x } qsearch('cust_svc', { svcpart=>$opt_p } );
+ die "no services with svcpart $opt_p found\n" unless @svc_x;
+} elsif ( $opt_k ) {
+ push @svc_x,
+ map { $_->svc_x }
+ qsearch({
+ table => 'cust_svc',
+ addl_from => 'LEFT JOIN cust_pkg USING ( pkgnum )',
+ extra_sql => "WHERE pkgpart = $opt_k",
+ });
+ die "no services with pkgpart $opt_k found\n" unless @svc_x;
+}
+
+warn "setting $field to $value before usage\n";
+foreach my $svc_x ( @svc_x ) {
+ my $cust_pkg = $svc_x->cust_svc->cust_pkg;
+ my $cust_usage = $value - &{ $field2sub{$field} }( $svc_x, $cust_pkg );
+# warn "resetting ". $svc_x->svcnum.':'.$svc_x->username. " to $cust_usage\n";
+ warn "$field for ". $svc_x->svcnum.':'.$svc_x->username. " reached limit\n"
+ if $cust_usage <= 0;
+ $svc_x->$field($cust_usage);
+
+ my $error = $svc_x->replace;
+ die $error if $error;
+}
+
+sub usage {
+ die "Usage:\n\n svc_acct-recalculate_usage user [ -s svcnum | -u username | -p svcpart ]\n";
+}
+
+=head1 NAME
+
+svc-acct-recalculate_usage - Command line tool to recalculate usage for existing services
+
+=head1 SYNOPSIS
+
+ svc_acct-recalculate_usage user usagefield initialvalue [ -s svcnum | -u username | -p svcpart ]
+
+ #recalculate a 1gb totalbytes limit for pkgpart 2
+ svc_acct-recalculate_usage ivan totalbytes 1073741824 -k 2
+
+=head1 DESCRIPTION
+
+Re-calculates the specified usage field for the specified service(s) (selected
+by svcnum, username or svcpart).
+
+=head1 SEE ALSO
+
+L<FS::svc_acct>, L<freeside-reexport>, L<FS::part_export>
+
+=cut
+
diff --git a/bin/tax_rate_location.import b/bin/tax_rate_location.import
new file mode 100755
index 0000000..439d27c
--- /dev/null
+++ b/bin/tax_rate_location.import
@@ -0,0 +1,48 @@
+#!/usr/bin/perl -Tw
+
+use strict;
+use vars qw($opt_g $opt_f);
+use vars qw($DEBUG);
+use Getopt::Std;
+use FS::UID qw(adminsuidsetup);
+use FS::Conf;
+use FS::tax_rate_location;
+
+getopts('f:g:');
+
+my $user = shift or die &usage;
+my $dbh = adminsuidsetup $user;
+
+my ($format) = $opt_f =~ /^([-\w]+)$/;
+
+my @list = (
+ 'GEOCODE', $opt_g, \&FS::tax_rate_location::batch_import,
+);
+
+my $oldAutoCommit = $FS::UID::AutoCommit;
+local $FS::UID::AutoCommit = 0;
+
+my $error = '';
+
+while(@list) {
+ my ($name, $file, $method) = splice(@list, 0, 3);
+
+ my $fh;
+
+ $file =~ /^([\s\d\w.]+)$/ or die "Illegal filename: $file\n";
+ $file = $1;
+
+ open $fh, '<', $file or die "can't open $name file: $!\n";
+ $error ||= &{$method}( { filehandle => $fh, 'format' => $format, } );
+
+ die "error while processing $file: $error" if $error;
+ close $fh;
+}
+
+if ($error) {
+ $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
+}else{
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+}
+
+sub usage { die "Usage:\ntax_rates_location.import -f FORMAT -g GEOCODEFILE user\n\n"; }
generated by cgit v1.1 at 2024-06-25 01:11:07 +0000