summaryrefslogtreecommitdiff
path: root/bin
diff options
context:
space:
mode:
Diffstat (limited to 'bin')
-rwxr-xr-xbin/add-history-records.pl139
-rwxr-xr-xbin/all-postal-no-email22
-rwxr-xr-xbin/apache.export94
-rw-r--r--bin/artera.import75
-rw-r--r--bin/backup-dvd45
-rwxr-xr-xbin/bill188
-rwxr-xr-xbin/bill-as-nextmonth5
-rwxr-xr-xbin/bill-as-nextmonth-BILL5
-rwxr-xr-xbin/bill-as-nextyear5
-rwxr-xr-xbin/bill-as-nextyear-BILL5
-rwxr-xr-xbin/bill-for-nextmonth5
-rwxr-xr-xbin/bill-for-nextyear5
-rwxr-xr-xbin/bill-nextmonth5
-rwxr-xr-xbin/bill-nextyear5
-rw-r--r--bin/billco-upload20
-rwxr-xr-xbin/bind.export195
-rwxr-xr-xbin/bind.import235
-rw-r--r--bin/breakdown-bill-applications25
-rwxr-xr-xbin/bsdshell.export114
-rwxr-xr-xbin/cch_tax_tool59
-rwxr-xr-xbin/cdr.http_and_import108
-rw-r--r--bin/cdr.import28
-rwxr-xr-xbin/cdr.sftp_and_import112
-rwxr-xr-xbin/cdr_calltype.import41
-rwxr-xr-xbin/cdr_upstream_rate.import142
-rw-r--r--bin/create-fetchmailrc47
-rwxr-xr-xbin/customer-faker124
-rwxr-xr-xbin/dbdef-create85
-rwxr-xr-xbin/expand-country29
-rw-r--r--bin/explain-ar-total.sql976
-rw-r--r--bin/find-overapplied27
-rwxr-xr-xbin/fix-sequences69
-rw-r--r--bin/follow-tax-rename52
-rwxr-xr-xbin/freeside-create-initial-data31
-rwxr-xr-xbin/freeside-init60
-rw-r--r--bin/freeside-migrate-events229
-rwxr-xr-xbin/freeside-session-kill103
-rwxr-xr-xbin/freeside-upgrade-unicode72
-rw-r--r--bin/freeside.import146
-rwxr-xr-xbin/fs-migrate-cust_tax_exempt323
-rwxr-xr-xbin/fs-migrate-part_svc41
-rwxr-xr-xbin/fs-migrate-payref31
-rwxr-xr-xbin/fs-migrate-svc_acct_sm227
-rwxr-xr-xbin/fs-radius-add-check68
-rwxr-xr-xbin/fs-radius-add-reply69
-rwxr-xr-xbin/fs-setup542
-rwxr-xr-xbin/generate-prepay35
-rwxr-xr-xbin/generate-raddb53
-rwxr-xr-xbin/generate-table-module92
-rwxr-xr-xbin/generate-tests21
-rwxr-xr-xbin/import-county-tax-rates30
-rwxr-xr-xbin/import-optigold.pl1077
-rwxr-xr-xbin/import-tax-rates56
-rwxr-xr-xbin/ispman.ldap.import114
-rwxr-xr-xbin/japan.pl32
-rwxr-xr-xbin/mapsecrets2access_user87
-rwxr-xr-xbin/masonize80
-rwxr-xr-xbin/passwd.import121
-rwxr-xr-xbin/payment-faker54
-rw-r--r--bin/pg-readonly24
-rwxr-xr-xbin/pg-version13
-rwxr-xr-xbin/pod2x154
-rwxr-xr-xbin/postfix.export122
-rwxr-xr-xbin/postfix_courierimap.import137
-rwxr-xr-xbin/print-schema7
-rwxr-xr-xbin/rate-us.import109
-rw-r--r--bin/rate.delete3
-rwxr-xr-xbin/rate.import95
-rwxr-xr-xbin/reset-cust_credit-otaker88
-rwxr-xr-xbin/rollback38
-rwxr-xr-xbin/rotate-cdrs38
-rwxr-xr-xbin/rt-drop-tables29
-rw-r--r--bin/rt-update-links36
-rw-r--r--bin/sendmail.import178
-rw-r--r--bin/sequences.reset32
-rwxr-xr-xbin/shadow.reimport125
-rwxr-xr-xbin/slony-setup109
-rwxr-xr-xbin/sqlradius-norealm.reimport113
-rw-r--r--bin/sqlradius.import152
-rwxr-xr-xbin/sqlradius.reimport160
-rwxr-xr-xbin/strip-eps20
-rwxr-xr-xbin/svc_acct.export351
-rwxr-xr-xbin/svc_acct.import118
-rwxr-xr-xbin/svc_acct_pop.import59
-rwxr-xr-xbin/svc_acct_sm.export221
-rwxr-xr-xbin/svc_acct_sm.import252
-rwxr-xr-xbin/svc_broadband.renumber84
-rwxr-xr-xbin/svc_domain.erase15
-rwxr-xr-xbin/sysvshell.export112
-rw-r--r--bin/test_scrub48
-rwxr-xr-xbin/tron-scan24
91 files changed, 8242 insertions, 1709 deletions
diff --git a/bin/add-history-records.pl b/bin/add-history-records.pl
new file mode 100755
index 000000000..fbf9d09d9
--- /dev/null
+++ b/bin/add-history-records.pl
@@ -0,0 +1,139 @@
+#!/usr/bin/perl
+
+die "This is broken. Don't use it!\n";
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearchs qsearch);
+
+use Data::Dumper;
+
+my @tables = qw(svc_acct svc_broadband svc_domain svc_external svc_forward svc_www cust_svc domain_record);
+#my @tables = qw(svc_www);
+
+my $user = shift or die &usage;
+my $dbh = adminsuidsetup($user);
+
+my $dbdef = FS::Record::dbdef;
+
+foreach my $table (@tables) {
+
+ my $h_table = 'h_' . $table;
+ my $cnt = 0;
+ my $t_cnt = 0;
+
+ eval "use FS::${table}";
+ die $@ if $@;
+ eval "use FS::${h_table}";
+ die $@ if $@;
+
+ print "Adding history records for ${table}...\n";
+
+ my $dbdef_table = $dbdef->table($table);
+ my $pkey = $dbdef_table->primary_key;
+
+ foreach my $rec (qsearch($table, {})) {
+
+ #my $h_rec = qsearchs(
+ # $h_table,
+ # { $pkey => $rec->getfield($pkey) },
+ # eval "FS::${h_table}->sql_h_searchs(time)",
+ #);
+
+ my $h_rec = qsearchs(
+ $h_table,
+ { $pkey => $rec->getfield($pkey) },
+ "DISTINCT ON ( $pkey ) *",
+ "AND history_action = 'insert' ORDER BY $pkey ASC, history_date DESC",
+ '',
+ 'AS maintable',
+ );
+
+ unless ($h_rec) {
+ my $h_insert_rec = $rec->_h_statement('insert', 1);
+ #print $h_insert_rec . "\n";
+ $dbh->do($h_insert_rec);
+ die $dbh->errstr if $dbh->err;
+ $dbh->commit or die $dbh->errstr;
+ $cnt++;
+ }
+
+
+ $t_cnt++;
+
+ }
+
+ print "History records inserted into $h_table: $cnt\n";
+ print " Total records in $table: $t_cnt\n";
+
+ print "\n";
+
+}
+
+foreach my $table (@tables) {
+
+ my $h_table = 'h_' . $table;
+ my $cnt = 0;
+
+ eval "use FS::${table}";
+ die $@ if $@;
+ eval "use FS::${h_table}";
+ die $@ if $@;
+
+ print "Adding insert records for unmatched delete records on ${table}...\n";
+
+ my $dbdef_table = $dbdef->table($table);
+ my $pkey = $dbdef_table->primary_key;
+
+ #SELECT * FROM h_svc_www
+ #DISTINCT ON ( $pkey ) ?
+ my $where = "
+ WHERE ${pkey} in (
+ SELECT ${h_table}1.${pkey}
+ FROM ${h_table} as ${h_table}1
+ WHERE (
+ SELECT count(${h_table}2.${pkey})
+ FROM ${h_table} as ${h_table}2
+ WHERE ${h_table}2.${pkey} = ${h_table}1.${pkey}
+ AND ${h_table}2.history_action = 'delete'
+ ) > 0
+ AND (
+ SELECT count(${h_table}3.${pkey})
+ FROM ${h_table} as ${h_table}3
+ WHERE ${h_table}3.${pkey} = ${h_table}1.${pkey}
+ AND ( ${h_table}3.history_action = 'insert'
+ OR ${h_table}3.history_action = 'replace_new' )
+ ) = 0
+ GROUP BY ${h_table}1.${pkey})";
+
+
+ my @h_recs = qsearch(
+ $h_table, { },
+ "DISTINCT ON ( $pkey ) *",
+ $where,
+ '',
+ ''
+ );
+
+ foreach my $h_rec (@h_recs) {
+ #print "Adding insert record for deleted record with pkey='" . $h_rec->getfield($pkey) . "'...\n";
+ my $class = 'FS::' . $table;
+ my $rec = $class->new({ $h_rec->hash });
+ my $h_insert_rec = $rec->_h_statement('insert', 1);
+ #print $h_insert_rec . "\n";
+ $dbh->do($h_insert_rec);
+ die $dbh->errstr if $dbh->err;
+ $dbh->commit or die $dbh->errstr;
+ $cnt++;
+ }
+
+ print "History records inserted into $h_table: $cnt\n";
+
+}
+
+
+
+sub usage {
+ die "Usage:\n add-history-records.pl user\n";
+}
+
diff --git a/bin/all-postal-no-email b/bin/all-postal-no-email
new file mode 100755
index 000000000..ef5dff66b
--- /dev/null
+++ b/bin/all-postal-no-email
@@ -0,0 +1,22 @@
+#!/usr/bin/perl -w
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch);
+use FS::cust_main;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+foreach my $cust_main ( qsearch( 'cust_main', {} ) ) {
+
+ print $cust_main->custnum. "\n";
+
+ $cust_main->invoicing_list( [ 'POST' ] );
+
+}
+
+sub usage {
+ die "Usage:\n\n all-postal-no-email user\n";
+}
+
diff --git a/bin/apache.export b/bin/apache.export
new file mode 100755
index 000000000..82eb6d6b0
--- /dev/null
+++ b/bin/apache.export
@@ -0,0 +1,94 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Getopt::Std;
+#use File::Path;
+use File::Rsync;
+use Net::SSH qw(ssh);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch qsearchs);
+use FS::part_export;
+use FS::cust_svc;
+use FS::svc_www;
+
+use vars qw(%opt);
+getopts("d", \%opt);
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+#needs the export number in there somewhere too...?
+my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/apache";
+mkdir $spooldir, 0700 unless -d $spooldir;
+
+my @exports = qsearch('part_export', { 'exporttype' => 'apache' } );
+
+my $rsync = File::Rsync->new({
+ rsh => 'ssh',
+# dry_run => 1,
+});
+
+foreach my $export ( @exports ) {
+
+ my $machine = $export->machine;
+ my $exportnum = $export->exportnum;
+ my $file = "$spooldir/$machine.exportnum$exportnum.conf";
+
+ warn "exporting apache configuration for $machine to $file\n"
+ if $opt{d};
+
+ open(HTTPD_CONF,">$file") or die "can't open $file: $!";
+
+ my $template = $export->option('template');
+
+ my @svc_www = $export->svc_x;
+
+ foreach my $svc_www ( @svc_www ) {
+ use vars qw($zone $username $dir $email $config);
+ $zone = $svc_www->domain_record->zone;
+ $config = $svc_www->config;
+ if ( $svc_www->svc_acct ) {
+ $username = $svc_www->svc_acct->username;
+ $dir = $svc_www->svc_acct->dir;
+ $email = $svc_www->svc_acct->email;
+ } else {
+ $username = '';
+ $dir = '';
+ $email = '';
+ }
+
+ warn " adding configuration section for $zone\n"
+ if $opt{d};
+
+ print HTTPD_CONF eval(qq("$template")). "\n\n";
+ }
+
+ my $user = $export->option('user');
+ my $httpd_conf = $export->option('httpd_conf');
+
+ warn "syncing $file to $httpd_conf on $machine\n"
+ if $opt{d};
+
+ $rsync->exec( {
+ src => $file,
+ dest => "$user\@$machine:$httpd_conf",
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+ # warn $rsync->out;
+
+ my $restart = $export->option('restart') || 'apachectl graceful';
+
+ warn "running restart command $restart on $machine\n"
+ if $opt{d};
+
+ ssh("root\@$machine", $restart);
+
+}
+
+close HTTPD_CONF;
+
+# -----
+
+sub usage {
+ die "Usage:\n apache.export [ -d ] user\n";
+}
+
diff --git a/bin/artera.import b/bin/artera.import
new file mode 100644
index 000000000..716dddad0
--- /dev/null
+++ b/bin/artera.import
@@ -0,0 +1,75 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Text::CSV_XS;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearchs);
+use FS::svc_external;
+use FS::svc_domain;
+use FS::svc_acct;
+
+$FS::svc_Common::noexport_hack = 1;
+
+my $svcpart = 30;
+
+my $user = shift
+ or die 'Usage:\n\n artera.import user <artera_active_orders.csv';
+adminsuidsetup $user;
+
+##
+
+my $csv = new Text::CSV_XS;
+
+my $header = scalar(<>);
+
+my( $num, $linked ) = ( 0, 0 );
+
+while (<>) {
+ my $status = $csv->parse($_)
+ or die $csv->error_input;
+ my($serial, $keycode, $name, $ordernum, $email) = $csv->fields();
+ #warn join(" - ", $serial, $keycode, $name, $ordernum, $email ). "\n";
+
+ $email =~ /^([^@]+)\@([^@]+)$/
+ or die $email;
+ my($username, $domain) = ( $1, $2 );
+ my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } );
+ my $cust_svc = '';
+ if ( $svc_domain ) {
+ my $svc_acct = qsearchs('svc_acct', {
+ 'username' => $username,
+ 'domsvc' => $svc_domain->svcnum,
+ } );
+ $cust_svc = $svc_acct->cust_svc
+ if $svc_acct;
+ #} else {
+ # warn "can't find domain $domain\n";
+ }
+
+ my $exist = qsearchs('svc_external', { 'id' => $serial } );
+ next if $exist;
+
+ my $svc_external = new FS::svc_external {
+ 'svcpart' => $svcpart,
+ 'pkgnum' => ( $cust_svc ? $cust_svc->pkgnum : '' ),
+ 'id' => $serial,
+ 'title' => $keycode,
+ };
+ #my $error = $svc_external->check;
+ my $error = $svc_external->insert;
+ if ( $cust_svc && $error =~ /^Already/ ) {
+ warn $error;
+ $svc_external->pkgnum('');
+ $error = $svc_external->insert;
+ }
+ warn $error if $error;
+
+ $num++;
+ $linked++ if $cust_svc;
+ #print "$num imported, $linked linked\n";
+
+}
+
+print "$num imported, $linked linked\n";
+
diff --git a/bin/backup-dvd b/bin/backup-dvd
new file mode 100644
index 000000000..d0314b469
--- /dev/null
+++ b/bin/backup-dvd
@@ -0,0 +1,45 @@
+#!/bin/bash
+
+database="freeside"
+DEVICE="/dev/hda"
+
+su freeside -c "pg_dump $database" >/var/backups/$database.sql
+
+DATE=$(date +%Y-%m-%d)
+
+#NOTE: These two paths must end in a / in
+#order to correctly build up the other paths
+#BACKUP_DIR="/backup/directory/"
+BACKUP_DIR="/backup/"
+ #TEMP_BACKUP_FILES_DIR="/backup/temp/"
+
+BACKUP_FILE=$BACKUP_DIR"backup-"$DATE".tar.bz2"
+ #DATABASE_FILE=$TEMP_BACKUP_FILES_DIR"foo-"$DATE".sql"
+
+ #These directories shouldn't end in a / although
+ #I don't think it will cause any problems if
+ #they do. There should be a space at the end though
+ #to ensure the database file gets concatenated correctly.
+ #SOURCE="/a/location /other/locations " $DATABASE_FILE
+
+#echo Removing old backup directories
+rm -rf $BACKUP_DIR
+ #rm -rf $TEMP_BACKUP_FILES_DIR
+
+#echo Creating new backup directories
+mkdir $BACKUP_DIR
+ #mkdir $TEMP_BACKUP_FILES_DIR
+
+ #echo Creating database backup
+ #pg_dump -U username -f $DATABASE_FILE databaseName
+
+#echo Backing up $SOURCE to file $BACKUP_FILE
+#tar -cvpl -f $BACKUP_FILE --anchored --exclude /backup /
+tar -cjpl -f $BACKUP_FILE --anchored --exclude /backup /
+
+ ##This is not necessary and possibly harmful for DVD+RW media
+ #echo Quick blanking media
+ #dvd+rw-format -blank /dev/hdc
+
+#echo Burning backup
+growisofs -dvd-compat -Z $DEVICE -quiet -r -J $BACKUP_FILE
diff --git a/bin/bill b/bin/bill
deleted file mode 100755
index 5c5be703d..000000000
--- a/bin/bill
+++ /dev/null
@@ -1,188 +0,0 @@
-#!/usr/local/bin/perl -Tw
-#
-# bill: Bill customer(s)
-#
-# Usage: bill [ -c [ i ] ] [ -d 'date' ] [ -b ]
-#
-# Bills all customers.
-#
-# Adds record to /dbin/cust_bill and /dbin/cust_pay (if payment made -
-# CARD & COMP), prints invoice / charges card etc.
-#
-# -c: Turn on collecting (you probably want this).
-#
-# -i: real-time billing (as opposed to batch billing). only relevant
-# for credit cards.
-#
-# -d: Pretent it's 'date'. Date is in any format Date::Parse is happy with,
-# but be careful.
-#
-# ## n/a ## -b: send batch when done billing
-#
-# ivan@voicenet.com sep/oct 96
-#
-# separated billing and collections, cleaned up code.
-# ivan@voicenet.com 96-nov-11
-#
-# added -d option
-# ivan@voicenet.com 96-nov-13
-#
-# added -v option and started to implement it, added 'd:' to getopts call
-# (oops!)
-# ivan@voicenet.com 97-jan-2
-#
-# added more debug messages, moved some searches to fssearch.pl library (for
-# speed)
-# rewrote "all customer" finder to know about bill dates, for speed.
-# ivan@voicenet.com 97-jan-8
-#
-# thought about it a while, and removed passing of the -d option to collect...?
-# ivan@voicenet.com 97-jan-14
-#
-# make all -v stuff STDERR
-# ivan@voicenet.com 97-feb-4
-#
-# added pkgnum as argument to program from /db/part_pkg, with kludge for the
-# "/bin/echo XX" 's already there.
-# ivan@voicenet.com 97-feb-23
-#
-# - general cleanup
-# - customers who are suspended can still be billed for the setup fee
-# - cust_pkg record is re-read after the package setup fee program is run.
-# this way,
-# that program can modify the record (for example, to start accounts off
-# suspended)
-# (best to think four or five times before modifying anything else!)
-# ivan@voicenet.com 97-feb-26
-#
-# don't bill recurring fee if its not time! (was removed)
-# ivan@voicenet.com 97-mar-6
-#
-# added -b option, send batch when done billing.
-# ivan@voicenet.com 97-apr-4
-#
-#insecure dependency on line 179ish below needs to be fixed before bill is
-#used setuid
-# ivan@voicenet.com 97-jun-2
-#
-# removed running of setup program (depriciated)
-# ivan@voicenet.com 97-jul-21
-#
-# rewrote for new API, removed option to specify custnums (use FS::Bill
-# instead), removed -v option (?)
-# ivan@voicenet.com 97-jul-22 - 23 - 25 -28
-# (need to add back in email stuff, look in /home/ivan/old/dbin/collect)
-#
-# s/suidsetup/adminsuidsetup/, s/FS::Search/FS::Record/, added some batch
-# exporting stuff (which still needs to be generalized) and removed &idiot
-# ivan@sisd.com 98-may-27
-
-# setup
-
-use strict;
-use Fcntl qw(:flock);
-use Date::Parse;
-use Getopt::Std;
-use FS::UID qw(adminsuidsetup swapuid);
-use FS::Record qw(qsearch qsearchs);
-use FS::Bill;
-
-my($batchfile)="/var/spool/freeside/batch";
-my($batchlock)="/var/spool/freeside/batch.lock";
-
-adminsuidsetup;
-
-&untaint_argv; #what it sounds like (eww)
-use vars qw($opt_b $opt_c $opt_i $opt_d);
-getopts("bcid:"); #switches
-
-#we're at now now (and later).
-my($time)= $main::opt_d ? str2time($main::opt_d) : $^T;
-
-# find packages w/ bill < time && cancel != '', and create corresponding
-# customer objects
-
-my($cust_main,%saw);
-foreach $cust_main (
- map {
- if ( ( $_->getfield('bill') || 0 ) <= $time &&
- !$saw{ $_->getfield('custnum') }++ ) {
- qsearchs('cust_main',{'custnum'=> $_->getfield('custnum') } );
- } else {
- ();
- }
- } qsearch('cust_pkg',{'cancel'=>''})
-) {
-
- # and bill them
-
- print "Billing customer #" . $cust_main->getfield('custnum') . "\n";
-
- bless($cust_main,"FS::Bill");
-
- my($error);
-
- $error=$cust_main->bill('time'=>$time);
- warn "Error billing, customer #" . $cust_main->getfield('custnum') .
- ":" . $error if $error;
-
- if ($main::opt_c) {
- $error=$cust_main->collect('invoice_time'=>$time,
- 'batch_card' => $main::opt_i ? 'no' : 'yes',
- );
- warn "Error collecting customer #" . $cust_main->getfield('custnum') .
- ":" . $error if $error;
-
- #sleep 1;
-
- }
-
-}
-
-#if ($main::opt_b) {
-#
-# die "Batch still waiting for reply? ($batchlock exists)\n" if -e $batchlock;
-# open(BATCHLOCK,"+>>$batchlock") or die "Can't open $batchlock: $!";
-# select(BATCHLOCK); $|=1; select(STDOUT);
-# unless ( flock(BATCHLOCK,,LOCK_EX|LOCK_NB) ) {
-# seek(BATCHLOCK,0,0);
-# my($pid)=<BATCHLOCK>;
-# chop($pid);
-# die "Is a batch running? (pid $pid)\n";
-# }
-# seek(BATCHLOCK,0,0);
-# print BATCHLOCK $$,"\n";
-#
-# ( open(BATCH,">$batchfile")
-# and flock(BATCH,LOCK_EX|LOCK_NB)
-# ) or die "Can't open $batchfile: $!";
-#
-# my($cust_pay_batch);
-# foreach $cust_pay_batch (qsearch('cust_pay_batch',{})) {
-# print BATCH join(':',
-# $_->getfield('cardnum'),
-# $_->getfield('exp'),
-# $_->getfield('amount'),
-# $_->getfield('payname')
-# || $_->getfield('first'). ' '. $_->getfield('last'),
-# "Description",
-# $_->getfield('zip'),
-# ),"\n";
-# }
-#
-# flock(BATCH,LOCK_UN);
-# close BATCH;
-#
-# flock(BATCHLOCK,LOCK_UN);
-# close BATCHLOCK;
-#}
-
-# subroutines
-
-sub untaint_argv {
- foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
- $ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
- $ARGV[$_]=$1;
- }
-}
-
diff --git a/bin/bill-as-nextmonth b/bin/bill-as-nextmonth
new file mode 100755
index 000000000..813e84193
--- /dev/null
+++ b/bin/bill-as-nextmonth
@@ -0,0 +1,5 @@
+#!/bin/sh
+
+month=`date +%m`
+nextmonth=`expr $month + 1`
+/usr/local/bin/freeside-daily -d $nextmonth/1/`date +%Y` fs_daily
diff --git a/bin/bill-as-nextmonth-BILL b/bin/bill-as-nextmonth-BILL
new file mode 100755
index 000000000..91e943110
--- /dev/null
+++ b/bin/bill-as-nextmonth-BILL
@@ -0,0 +1,5 @@
+#!/bin/sh
+
+month=`date +%m`
+nextmonth=`expr $month + 1`
+/usr/local/bin/freeside-daily -d $nextmonth/1/`date +%Y` -p BILL fs_daily
diff --git a/bin/bill-as-nextyear b/bin/bill-as-nextyear
new file mode 100755
index 000000000..63c4ad2be
--- /dev/null
+++ b/bin/bill-as-nextyear
@@ -0,0 +1,5 @@
+#!/bin/sh
+
+year=`date +%Y`
+nextyear=`expr $year + 1`
+/usr/local/bin/freeside-daily -d 1/1/$nextyear fs_daily
diff --git a/bin/bill-as-nextyear-BILL b/bin/bill-as-nextyear-BILL
new file mode 100755
index 000000000..0d77dd0d6
--- /dev/null
+++ b/bin/bill-as-nextyear-BILL
@@ -0,0 +1,5 @@
+#!/bin/sh
+
+year=`date +%Y`
+nextyear=`expr $year + 1`
+/usr/local/bin/freeside-daily -d 1/1/$nextyear -p BILL fs_daily
diff --git a/bin/bill-for-nextmonth b/bin/bill-for-nextmonth
new file mode 100755
index 000000000..e1a33764e
--- /dev/null
+++ b/bin/bill-for-nextmonth
@@ -0,0 +1,5 @@
+#!/bin/sh
+
+month=`date +%m`
+nextmonth=`expr $month + 1`
+/usr/local/bin/freeside-daily -d $nextmonth/1/`date +%Y` -n fs_daily
diff --git a/bin/bill-for-nextyear b/bin/bill-for-nextyear
new file mode 100755
index 000000000..1430a5898
--- /dev/null
+++ b/bin/bill-for-nextyear
@@ -0,0 +1,5 @@
+#!/bin/sh
+
+year=`date +%Y`
+nextyear=`expr $year + 1`
+/usr/local/bin/freeside-daily -d 1/1/$nextyear -n fs_daily
diff --git a/bin/bill-nextmonth b/bin/bill-nextmonth
new file mode 100755
index 000000000..813e84193
--- /dev/null
+++ b/bin/bill-nextmonth
@@ -0,0 +1,5 @@
+#!/bin/sh
+
+month=`date +%m`
+nextmonth=`expr $month + 1`
+/usr/local/bin/freeside-daily -d $nextmonth/1/`date +%Y` fs_daily
diff --git a/bin/bill-nextyear b/bin/bill-nextyear
new file mode 100755
index 000000000..63c4ad2be
--- /dev/null
+++ b/bin/bill-nextyear
@@ -0,0 +1,5 @@
+#!/bin/sh
+
+year=`date +%Y`
+nextyear=`expr $year + 1`
+/usr/local/bin/freeside-daily -d 1/1/$nextyear fs_daily
diff --git a/bin/billco-upload b/bin/billco-upload
new file mode 100644
index 000000000..ce4a43d5f
--- /dev/null
+++ b/bin/billco-upload
@@ -0,0 +1,20 @@
+#!/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/bind.export b/bin/bind.export
new file mode 100755
index 000000000..286e43a2d
--- /dev/null
+++ b/bin/bind.export
@@ -0,0 +1,195 @@
+#!/usr/bin/perl -w
+
+use strict;
+use File::Path;
+use File::Rsync;
+use Net::SSH qw(ssh);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch qsearchs);
+use FS::part_export;
+use FS::cust_pkg;
+use FS::cust_svc;
+use FS::svc_domain;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/bind";
+mkdir $spooldir, 0700 unless -d $spooldir;
+
+my @exports = qsearch('part_export', { 'exporttype' => 'bind' } );
+my @sexports = qsearch('part_export', { 'exporttype' => 'bind_slave' } );
+
+my $rsync = File::Rsync->new({
+ rsh => 'ssh',
+# dry_run => 1,
+});
+
+foreach my $export ( @exports ) {
+
+ my $machine = $export->machine;
+ my $prefix = "$spooldir/$machine";
+
+ my $bind_rel = $export->option('bind_release');
+ my $ndc_cmd = $export->option('reload')
+ || ( ($bind_rel eq 'BIND9') ? 'rndc' : 'ndc' );
+ my $minttl = $export->option('bind9_minttl');
+
+ #prevent old domain files from piling up
+ #rmtree "$prefix" or die "can't rmtree $prefix.db: $!";
+
+ mkdir $prefix, 0700 unless -d $prefix;
+
+ open(NAMED_CONF,">$prefix/named.conf")
+ or die "can't open $prefix/named.conf: $!";
+
+ if ( -e "$prefix/named.conf.HEADER" ) {
+ open(CONF_HEADER,"<$prefix/named.conf.HEADER")
+ or die "can't open $prefix/named.conf.HEADER: $!";
+ while (<CONF_HEADER>) { print NAMED_CONF $_; }
+ close CONF_HEADER;
+ }
+
+ my $zonepath = $export->option('zonepath');
+ $zonepath =~ s/\/$//;
+
+ my @svc_domain = $export->svc_x;
+
+ foreach my $svc_domain ( @svc_domain ) {
+ my $domain = $svc_domain->domain;
+ my @masters = qsearch('domain_record', {
+ 'svcnum' => $svc_domain->svcnum,
+ 'rectype' => '_mstr',
+ } );
+ if ( @masters ) {
+ my $masters = join('; ', map { $_->recdata } @masters );
+
+ print NAMED_CONF <<END;
+zone "$domain" {
+ type slave;
+ file "db.$domain";
+ masters { $masters; };
+};
+
+END
+
+ } else {
+
+ print NAMED_CONF <<END;
+zone "$domain" {
+ type master;
+ file "$zonepath/db.$domain";
+};
+
+END
+
+ open (DB_MASTER,">$prefix/db.$domain")
+ or die "can't open $prefix/db.$domain: $!";
+
+ if ($bind_rel eq 'BIND9') {
+ print DB_MASTER "\$TTL $minttl\n\$ORIGIN $domain.\n";
+ }
+
+ my @domain_records =
+ qsearch('domain_record', { 'svcnum' => $svc_domain->svcnum } );
+ foreach my $domain_record (
+ sort { $b->rectype cmp $a->rectype } @domain_records
+ ) {
+ #if ( $domain_record->rectype eq 'SOA' ) {
+ # print DB_MASTER join("\t", $domain_record-> reczone
+ #} else {
+ print DB_MASTER join("\t",
+ map { $domain_record->getfield($_) }
+ qw( reczone recaf rectype recdata )
+ ), "\n";
+ #}
+ }
+
+ close DB_MASTER;
+
+ }
+
+ }
+
+ $rsync->exec( {
+ src => "$prefix/",
+ recursive => 1,
+ dest => "root\@$machine:$zonepath/",
+ exclude => [qw( *.import named.conf.HEADER named.conf )],
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+ # warn $rsync->out;
+
+ $rsync->exec( {
+ src => "$prefix/named.conf",
+ dest => "root\@$machine:". $export->option('named_conf'),
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+# warn $rsync->out;
+
+ ssh("root\@$machine", "$ndc_cmd reload");
+
+}
+
+close NAMED_CONF;
+
+foreach my $sexport ( @sexports ) { #false laziness with above
+
+ my $machine = $sexport->machine;
+ my $prefix = "$spooldir/$machine";
+
+ my $bind_rel = $sexport->option('bind_release');
+ my $ndc_cmd = ($bind_rel eq 'BIND9') ? 'rndc' : 'ndc';
+
+ #prevent old domain files from piling up
+ #rmtree "$prefix" or die "can't rmtree $prefix.db: $!";
+
+ mkdir $prefix, 0700 unless -d $prefix;
+
+ open(NAMED_CONF,">$prefix/named.conf")
+ or die "can't open $prefix/named.conf: $!";
+
+ if ( -e "$prefix/named.conf.HEADER" ) {
+ open(CONF_HEADER,"<$prefix/named.conf.HEADER")
+ or die "can't open $prefix/named.conf.HEADER: $!";
+ while (<CONF_HEADER>) { print NAMED_CONF $_; }
+ close CONF_HEADER;
+ }
+
+ my $masters = $sexport->option('master');
+
+ #false laziness with freeside-sqlradius-reset
+ my @svc_domain =
+ map { qsearchs('svc_domain', { 'svcnum' => $_->svcnum } ) }
+ map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ $sexport->export_svc;
+
+ foreach my $svc_domain ( @svc_domain ) {
+ my $domain = $svc_domain->domain;
+ print NAMED_CONF <<END;
+zone "$domain" {
+ type slave;
+ file "db.$domain";
+ masters { $masters; };
+};
+
+END
+
+ }
+
+ $rsync->exec( {
+ src => "$prefix/named.conf",
+ dest => "root\@$machine:". $sexport->option('named_conf'),
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+# warn $rsync->out;
+
+ ssh("root\@$machine", "$ndc_cmd reload");
+
+}
+close NAMED_CONF;
+
+# -----
+
+sub usage {
+ die "Usage:\n bind.export user\n";
+}
+
diff --git a/bin/bind.import b/bin/bind.import
new file mode 100755
index 000000000..45db2e210
--- /dev/null
+++ b/bin/bind.import
@@ -0,0 +1,235 @@
+#!/usr/bin/perl -w
+#
+# REQUIRED:
+# -p: part number for domains
+#
+# -n: named.conf file (or an include file with zones you want to import),
+# for example root@ns.isp.com:/var/named/named.conf
+#
+# OPTIONAL:
+# -d: dry-run, debug: don't insert any records, just dump debugging output
+# -e: use existing domains records in Freeside
+# -s: import slave zones as master. useful if you need to recreate your
+# primary nameserver from a secondary
+# -c dir: override patch for downloading zone files (for example, when
+# downloading zone files from chrooted bind)
+#
+# need to manually put header in
+# /usr/local/etc/freeside/export.<datasrc./bind/<machine>/named.conf.HEADER
+# (or, nowadays, better just to include the file freeside exports)
+
+use strict;
+
+use vars qw($domain_svcpart);
+
+use Getopt::Std;
+use Data::Dumper;
+#use BIND::Conf_Parser;
+#use DNS::ZoneParse 0.81;
+
+use Net::SCP qw(scp iscp);
+
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch); #qsearchs);
+#use FS::svc_acct_sm;
+use FS::svc_domain;
+use FS::domain_record;
+#use FS::svc_acct;
+#use FS::part_svc;
+
+use vars qw($opt_p $opt_n $opt_s $opt_c $opt_d $opt_e);
+getopts("p:n:sc:de");
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+$FS::svc_Common::noexport_hack = 1;
+$FS::domain_record::noserial_hack = 1;
+
+use vars qw($spooldir);
+$spooldir = "/usr/local/etc/freeside/export.". datasrc. "/bind";
+mkdir $spooldir unless -d $spooldir;
+
+$domain_svcpart = $opt_p;
+
+my $named_conf = $opt_n;
+
+use vars qw($named_machine $prefix);
+$named_machine = (split(/:/, $named_conf))[0];
+my $pnamed_machine = $named_machine;
+$pnamed_machine =~ s/^[\w\-]+\@//;
+$prefix = "$spooldir/$pnamed_machine";
+mkdir $prefix unless -d $prefix;
+
+#iscp("$named_conf","$prefix/named.conf.import");
+scp("$named_conf","$prefix/named.conf.import");
+
+##
+
+$FS::svc_domain::whois_hack=1;
+
+my $p = Parser->new;
+$p->parse_file("$prefix/named.conf.import");
+
+print "\nBIND import completed.\n";
+
+##
+
+sub usage {
+ die "Usage:\n\n bind.import -p partnum -n \"user\@machine:/path/to/named.conf\" [ -s ] [ -c chroot_dir ] [ -d ] [ -e ] user\n";
+}
+
+########
+BEGIN {
+
+ package Parser;
+ use BIND::Conf_Parser;
+ use vars qw(@ISA $named_dir);
+ @ISA = qw(BIND::Conf_Parser);
+
+ $named_dir = 'COULD_NOT_FIND_NAMED_DIRECTORY_TRY_SETTING_-C_OPTION';
+ sub handle_option {
+ my($self, $option, $argument) = @_;
+ return unless $option eq "directory";
+ $named_dir = $argument;
+ #warn "found named dir: $named_dir\n";
+ }
+
+ sub handle_zone {
+ my($self, $name, $class, $type, $options) = @_;
+ return unless $class eq 'in';
+ return if grep { $name eq $_ } (qw(
+ . localhost 127.in-addr.arpa 0.in-addr.arpa 255.in-addr.arpa
+ 0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa
+ 0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.int
+ ));
+
+ use FS::Record qw(qsearchs);
+ use FS::svc_domain;
+
+ my $domain =
+ qsearchs('svc_domain', { 'domain' => $name } )
+ || new FS::svc_domain( {
+ svcpart => $main::domain_svcpart,
+ domain => $name,
+ action => 'N',
+ } );
+ unless ( $domain->svcnum ) {
+ my $error = $domain->insert;
+ die $error if $error;
+ }
+
+ if ( $type eq 'slave' && !$main::opt_s ) {
+
+ if ( $main::opt_d ) {
+
+ use Data::Dumper;
+ print "$name: ". Dumper($options);
+
+ } else {
+
+ foreach my $master ( @{ $options->{masters} } ) {
+ my $domain_record = new FS::domain_record( {
+ 'svcnum' => $domain->svcnum,
+ 'reczone' => '@',
+ 'recaf' => 'IN',
+ 'rectype' => '_mstr',
+ 'recdata' => $master,
+ } );
+ my $error = $domain_record->insert;
+ die $error if $error;
+ }
+
+ }
+
+ } elsif ( $type eq 'master' || ( $type eq 'slave' && $main::opt_s ) ) {
+
+ my $file = $options->{file};
+
+ use File::Basename;
+ my $basefile = basename($file);
+ my $sourcefile = $file;
+ if ( $main::opt_c ) {
+ $sourcefile = "$main::opt_c/$sourcefile" if $main::opt_c;
+ } else {
+ $sourcefile = "$named_dir/$sourcefile" unless $file =~ /^\//;
+ }
+
+ use Net::SCP qw(iscp scp);
+ #iscp("$main::named_machine:$sourcefile",
+ # "$main::prefix/$basefile.import");
+ scp("$main::named_machine:$sourcefile",
+ "$main::prefix/$basefile.import");
+
+ use DNS::ZoneParse 0.84;
+ my $zone = DNS::ZoneParse->new("$main::prefix/$basefile.import");
+
+ my $dump = $zone->dump;
+
+ if ( $main::opt_d ) {
+
+ use Data::Dumper;
+ print "$name: ". Dumper($dump);
+
+ } else {
+
+ foreach my $rectype ( keys %$dump ) {
+ if ( $rectype =~ /^SOA$/i ) {
+ my $rec = $dump->{$rectype};
+ $rec->{email} =~ s/\@/\./;
+ my $domain_record = new FS::domain_record( {
+ 'svcnum' => $domain->svcnum,
+ 'reczone' => $rec->{origin},
+ 'recaf' => 'IN',
+ 'rectype' => $rectype,
+ 'recdata' =>
+ $rec->{primary}. ' '. $rec->{email}. ' ( '.
+ join(' ', map $rec->{$_},
+ qw( serial refresh retry expire minimumTTL ) ).
+ ' )',
+ } );
+ my $error = $domain_record->insert;
+ die $error if $error;
+ } else {
+ #die $dump->{$rectype};
+
+ my $datasub;
+ if ( $rectype =~ /^MX$/i ) {
+ $datasub = sub { $_[0]->{priority}. ' '. $_[0]->{host}; };
+ } elsif ( $rectype =~ /^TXT$/i ) {
+ $datasub = sub { $_[0]->{text}; };
+ } else {
+ $datasub = sub { $_[0]->{host}; };
+ }
+
+ foreach my $rec ( @{ $dump->{$rectype} } ) {
+ my $domain_record = new FS::domain_record( {
+ 'svcnum' => $domain->svcnum,
+ 'reczone' => $rec->{name},
+ 'recaf' => $rec->{class} || 'IN',
+ 'rectype' => $rectype,
+ 'recdata' => &{$datasub}($rec),
+ } );
+ my $error = $domain_record->insert;
+ if ( $error ) {
+ warn "$error inserting ".
+ $rec->{name}. ' . '. $domain->domain. "\n";
+ warn Dumper($rec);
+ #system('cat',"$main::prefix/$basefile.import");
+ die;
+ }
+ }
+ }
+ }
+
+ }
+
+ #} else {
+ # die "unrecognized type $type\n";
+ }
+
+ }
+
+}
+#########
+
diff --git a/bin/breakdown-bill-applications b/bin/breakdown-bill-applications
new file mode 100644
index 000000000..44c3e36b0
--- /dev/null
+++ b/bin/breakdown-bill-applications
@@ -0,0 +1,25 @@
+#!/usr/bin/perl -w
+
+use strict;
+use FS::UID qw(adminsuidsetup dbh);
+use FS::Record qw( qsearch );
+use FS::cust_bill_pay;
+use FS::cust_credit_bill;
+
+$FS::CurrentUser::upgrade_hack = 1;
+adminsuidsetup(shift) or die "Usage: breakdown-bill-applications username\n";
+
+#quick and dirty conversion script if you have enough memory to throw at it
+
+my @tables = qw( cust_bill_pay cust_credit_bill );
+
+my @apps = ();
+foreach my $table {
+ push @apps, qsearch($table,
+
+
+) {
+
+}
+
+foreach my $cust_bill_
diff --git a/bin/bsdshell.export b/bin/bsdshell.export
new file mode 100755
index 000000000..6e0d1037e
--- /dev/null
+++ b/bin/bsdshell.export
@@ -0,0 +1,114 @@
+#!/usr/bin/perl -w
+
+# bsdshell export
+
+use strict;
+use File::Rsync;
+use Net::SSH qw(ssh);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch qsearchs);
+use FS::part_export;
+use FS::cust_svc;
+use FS::svc_acct;
+
+my @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my $spooldir = "/usr/local/etc/freeside/export.". datasrc;
+#my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/shell";
+
+my @bsd_exports = qsearch('part_export', { 'exporttype' => 'bsdshell' } );
+
+my $rsync = File::Rsync->new({
+ rsh => 'ssh',
+# dry_run => 1,
+});
+
+foreach my $export ( @bsd_exports ) {
+ my $machine = $export->machine;
+ my $prefix = "$spooldir/$machine";
+ mkdir $prefix, 0700 unless -d $prefix;
+
+ #LOCKING!!!
+
+ ( open(MASTER,">$prefix/master.passwd")
+ #!!! and flock(MASTER,LOCK_EX|LOCK_NB)
+ ) or die "Can't open $prefix/master.passwd: $!";
+ ( open(PASSWD,">$prefix/passwd")
+ #!!! and flock(PASSWD,LOCK_EX|LOCK_NB)
+ ) or die "Can't open $prefix/passwd: $!";
+
+ chmod 0644, "$prefix/passwd";
+ chmod 0600, "$prefix/master.passwd";
+
+ my @svc_acct = $export->svc_x;
+
+ next unless @svc_acct;
+
+ foreach my $svc_acct ( sort { $a->uid <=> $b->uid } @svc_acct ) {
+
+ my $password = $svc_acct->_password;
+ my $cpassword;
+ #if ( ( length($password) <= 8 )
+ if ( ( length($password) <= 12 )
+ && ( $password ne '*' )
+ && ( $password ne '!!' )
+ && ( $password ne '' )
+ ) {
+ $cpassword=crypt($password,
+ $saltset[int(rand(64))].$saltset[int(rand(64))]
+ );
+ # MD5 !!!!
+ } else {
+ $cpassword=$password;
+ }
+
+ ###
+ # FORMAT OF THE PASSWD FILE HERE
+ print PASSWD join(":",
+ $svc_acct->username,
+ 'x', # "##". $username,
+ $svc_acct->uid,
+ $svc_acct->gid,
+ $svc_acct->finger,
+ $svc_acct->dir,
+ $svc_acct->shell,
+ ), "\n";
+
+ ###
+ # FORMAT OF FreeBSD MASTER PASSWD FILE HERE
+ print MASTER join(":",
+ $svc_acct->username, # User name
+ $cpassword, # Encrypted password
+ $svc_acct->uid, # User ID
+ $svc_acct->gid, # Group ID
+ "", # Login Class
+ "0", # Password Change Time
+ "0", # Password Expiration Time
+ $svc_acct->finger, # Users name
+ $svc_acct->dir, # Users home directory
+ $svc_acct->shell, # shell
+ ), "\n" ;
+
+ }
+
+ #!!! flock(MASTER,LOCK_UN);
+ #!!! flock(PASSWD,LOCK_UN);
+ close MASTER;
+ close PASSWD;
+
+ $rsync->exec( {
+ src => "$prefix/passwd",
+ dest => "root\@$machine:/etc/passwd"
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+
+ $rsync->exec( {
+ src => "$prefix/master.passwd",
+ dest => "root\@$machine:/etc/master.passwd.new"
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+ ssh("root\@$machine", "pwd_mkdb /etc/master.passwd.new");
+
+ # UNLOCK!!
+}
diff --git a/bin/cch_tax_tool b/bin/cch_tax_tool
new file mode 100755
index 000000000..6261363d6
--- /dev/null
+++ b/bin/cch_tax_tool
@@ -0,0 +1,59 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+# this tool manipulates fixed length cch tax files by comparing the
+# update files in the $update_dir to the initial install files
+# in the $init_dir
+#
+# it produces .DOIT files in $update_dir which are suitable for
+# syncing a database initialzed with the files in $init_dir to
+# the state represented by the files in $update_dir
+#
+# how one acquires update files from cch that overlap with initial
+# full install remains a mystery
+
+my $init_dir = "cchinit/";
+my $update_dir = "cchupdate/";
+
+foreach my $file (qw (CODE DETAIL PLUS4 GEOCODE TXMATRIX ZIP)) {
+ my $tfile = $update_dir. $file. "T";
+ $tfile = $update_dir. "TXMATRIT" if $tfile =~ /TXMATRIXT$/;
+ open FILE, "$tfile.TXT" or die "Can't open $tfile.TXT\n";
+ open INSERT, ">$tfile.INS" or die "Can't open $tfile.INS\n";
+ open DELETE, ">$tfile.DEL" or die "Can't open $tfile.DEL\n";
+ while(<FILE>){
+ chomp;
+ print INSERT "$_\n" if s/I$//;
+ print DELETE "$_\n" if s/D$//;
+ }
+ close FILE;
+ close INSERT;
+ close DELETE;
+ system "sort $tfile.INS > $tfile.INSSORT";
+ system "sort $tfile.DEL > $tfile.DELSORT";
+ system "sort $init_dir$file.txt > $tfile.ORGINSSORT";
+ system "comm -12 $tfile.INSSORT $tfile.ORGINSSORT > $tfile.PREINS";
+ system "comm -23 $tfile.INSSORT $tfile.ORGINSSORT > $tfile.2BEINS";
+ system "comm -23 $tfile.DELSORT $tfile.ORGINSSORT > $tfile.PREDEL";
+ system "comm -12 $tfile.DELSORT $tfile.ORGINSSORT > $tfile.2BEDEL";
+}
+
+foreach my $file (qw (CODET DETAILT PLUS4T GEOCODET TXMATRIT ZIPT)) {
+ my $tfile = $update_dir. $file;
+ $tfile = "TXMATRIT" if $tfile eq "TXMATRIXT";
+ open INSERT, "$tfile.2BEINS" or die "Can't open $tfile.2BEINS\n";
+ open DELETE, "$tfile.2BEDEL" or die "Can't open $tfile.2BEDEL\n";
+ open FILE, ">$tfile.DOIT" or die "Can't open $tfile.DOIT\n";
+ while(<INSERT>){
+ chomp;
+ print FILE $_, "I\n";
+ }
+ while(<DELETE>){
+ chomp;
+ print FILE $_, "D\n";
+ }
+ close FILE;
+ close INSERT;
+ close DELETE;
+}
diff --git a/bin/cdr.http_and_import b/bin/cdr.http_and_import
new file mode 100755
index 000000000..5637fa526
--- /dev/null
+++ b/bin/cdr.http_and_import
@@ -0,0 +1,108 @@
+#!/usr/bin/perl
+#
+# Usage:
+# cdr.http_and_import [ -p prefix ] [ -e extension ] [ -v ] user format URL
+#
+# -e: file extension, defaults to .csv
+# -d: if specified, moves files to the specified folder when done
+
+use strict;
+use Getopt::Std;
+use WWW::IndexParser;
+#use LWP::UserAgent;
+use FS::UID qw(adminsuidsetup datasrc dbh);
+use FS::cdr;
+
+###
+# parse command line
+###
+
+use vars qw( $opt_p $opt_e $opt_v );
+getopts('p:e: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( $URL );
+$URL = shift or die &usage;
+
+###
+# get the file list
+###
+
+warn "Retreiving directory listing\n" if $opt_v;
+
+my @files = WWW::IndexParser->new(url => $URL);
+
+###
+# import each file
+###
+
+foreach my $file ( @files ) {
+
+ my $filename = $file->{filename};
+
+ if ( $opt_p ) { next unless $filename =~ /^$opt_p/ };
+ if ( $opt_e ) { next unless $filename =~ /\.$opt_e$/i };
+
+ #check and see if we've gotten this file already!!!
+ #just going to cheat with filenames in the cache for now
+ if ( -e "$cachedir/$filename" ) {
+ warn "Already have unprocessed $cachedir/$filename; skipping\n"; # if $opt_v;
+ next;
+ }
+ if ( -e "$cachedir/$filename.DONE" ) {
+ warn "Already processed $cachedir/$filename; skipping\n" if $opt_v;
+ next;
+ }
+
+ warn "Downloading $filename\n" if $opt_v;
+
+ #get the file
+
+ my $ua = LWP::UserAgent->new;
+ my $response = $ua->get("$URL/$filename");
+
+ unless ( $response->is_success ) {
+ die "Error retreiving $URL/$filename: ". $response->status_line;
+ }
+
+ open(FILE, ">$cachedir/$filename")
+ or die "can't open $cachedir/$filename: $!";
+ print FILE $response->content;
+ close FILE or die "can't close $cachedir/$filename: $!";
+
+ 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;
+
+ rename("$cachedir/$filename", "$cachedir/$filename.DONE");
+
+}
+
+###
+# sub
+###
+
+sub usage {
+ "Usage: \n cdr.http_and_import [ -p prefix ] [ -e extension ] [ -v ] user format URL\n";
+}
+
diff --git a/bin/cdr.import b/bin/cdr.import
new file mode 100644
index 000000000..a17417b85
--- /dev/null
+++ b/bin/cdr.import
@@ -0,0 +1,28 @@
+#!/usr/bin/perl
+#
+# Usage:
+# cdr.import user format filename
+#
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::cdr;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my $format = shift or die &usage;
+
+my $file = shift;
+
+my $error = FS::cdr::batch_import( {
+ 'file' => $file,
+ 'format' => $format,
+ 'params' => { 'cdrbatch' => $file },
+} );
+die $error if $error;
+
+sub usage {
+ "Usage: \n cdr.import user format filename\n";
+}
+
diff --git a/bin/cdr.sftp_and_import b/bin/cdr.sftp_and_import
new file mode 100755
index 000000000..79e743f39
--- /dev/null
+++ b/bin/cdr.sftp_and_import
@@ -0,0 +1,112 @@
+#!/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/cdr_calltype.import b/bin/cdr_calltype.import
new file mode 100755
index 000000000..a998284f6
--- /dev/null
+++ b/bin/cdr_calltype.import
@@ -0,0 +1,41 @@
+#!/usr/bin/perl -w
+#
+# bin/cdr_calltype.import ivan ~ivan/convergent/newspecs/fixed_inbound/calltypes.csv
+
+use strict;
+use FS::UID qw(dbh adminsuidsetup);
+use FS::cdr_calltype;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+while (<>) {
+
+ chomp;
+ my $line = $_;
+
+ #$line =~ /^(\d+),"([^"]+)"$/ or do {
+ $line =~ /^(\d+),"([^"]+)"/ or do {
+ warn "unparsable line: $line\n";
+ next;
+ };
+
+ my $cdr_calltype = new FS::cdr_calltype {
+ 'calltypenum' => $1,
+ 'calltypename' => $2,
+ };
+
+ #my $error = $cdr_calltype->check;
+ my $error = $cdr_calltype->insert;
+ if ( $error ) {
+ warn "********** $error FOR LINE: $line\n";
+ dbh->commit;
+ #my $wait = scalar(<STDIN>);
+ }
+
+}
+
+sub usage {
+ "Usage:\n\ncdr_calltype.import username filename ...\n";
+}
+
diff --git a/bin/cdr_upstream_rate.import b/bin/cdr_upstream_rate.import
new file mode 100755
index 000000000..fda3883b5
--- /dev/null
+++ b/bin/cdr_upstream_rate.import
@@ -0,0 +1,142 @@
+#!/usr/bin/perl -w
+#
+# Usage: bin/cdr_upstream_rate.import username ratenum filename
+#
+# records will be imported into cdr_upstream_rate, rate_detail and rate_region
+#
+# Example: bin/cdr_upstream_rate.import ivan 1 ~ivan/convergent/sample_rate_table.csv
+#
+# username: a freeside login (from /usr/local/etc/freeside/mapsecrets)
+# ratenum: rate plan (FS::rate) created with the web UI
+# filename: CSV file
+#
+# the following fields are currently used:
+# - Class Code => cdr_upstream_rate.rateid
+# - Description => rate_region.regionname
+# (rate_detail->dest_region)
+# - 1_rate => ( * 60 / 1_rate_seconds ) => rate_detail.min_charge
+# - 1_rate_seconds => (used above)
+# - 1_second_increment => rate_detail.sec_granularity
+#
+# the following fields are not (yet) used:
+# - Flagfall => what's this for?
+#
+# - 1_cap_time => freeside doesn't have voip time caps yet...
+# - 1_cap_cost => freeside doesn't have voip cost caps yet...
+# - 1_repeat => not sure what this is for, sample data is all 0
+#
+# - 2_rate => \
+# - 2_rate_seconds => |
+# - 2_second_increment => | not sure what the second set of rate data
+# - 2_cap_time => | is supposed to be for...
+# - 2_cap_cost => |
+# - 2_repeat => /
+#
+# - Carrier => probably not needed?
+# - Start Date => not necessary?
+
+use strict;
+use vars qw( $DEBUG );
+use Text::CSV_XS;
+use FS::UID qw(dbh adminsuidsetup);
+use FS::Record qw(qsearchs);
+use FS::rate;
+use FS::cdr_upstream_rate;
+use FS::rate_detail;
+use FS::rate_region;
+
+$DEBUG = 1;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my $ratenum = shift or die &usage;
+
+my $rate = qsearchs( 'rate', { 'ratenum' => $ratenum } );
+die "rate plan $ratenum not found in rate table\n"
+ unless $rate;
+
+my $csv = new Text::CSV_XS;
+my $hline = scalar(<>);
+chomp($hline);
+$csv->parse($hline) or die "can't parse header: $hline\n";
+my @header = $csv->fields();
+
+$FS::UID::AutoCommit = 0;
+
+while (<>) {
+
+ chomp;
+ my $line = $_;
+
+# #$line =~ /^(\d+),"([^"]+)"$/ or do {
+# #}
+# $line =~ /^(\d+),"([^"]+)"/ or do {
+# warn "unparsable line: $line\n";
+# next;
+# };
+
+ $csv->parse($line) or die "can't parse line: $line\n";
+ my @line = $csv->fields();
+
+ my %hash = map { $_ => shift(@line) } @header;
+
+ warn join('', map { "$_ => $hash{$_}\n" } keys %hash )
+ if $DEBUG > 1;
+
+ my $rate_region = new FS::rate_region {
+ 'regionname' => $hash{'Description'}
+ };
+
+ my $error = $rate_region->insert;
+ if ( $error ) {
+ dbh->rollback;
+ die "error inserting into rate_region: $error\n";
+ }
+ my $dest_regionnum = $rate_region->regionnum;
+ warn "rate_region $dest_regionnum inserted\n"
+ if $DEBUG;
+
+ my $rate_detail = new FS::rate_detail {
+ 'ratenum' => $ratenum,
+ 'dest_regionnum' => $dest_regionnum,
+ 'min_included' => 0,
+ #'min_charge', => sprintf('%.5f', 60 * $hash{'1_rate'} / $hash{'1_rate_seconds'} ),
+ 'min_charge', => sprintf('%.5f', $hash{'1_rate'} /
+ ( $hash{'1_rate_seconds'} / 60 )
+ ),
+ 'sec_granularity' => $hash{'1_second_increment'},
+ };
+ $error = $rate_detail->insert;
+ if ( $error ) {
+ dbh->rollback;
+ die "error inserting into rate_detail: $error\n";
+ }
+ my $ratedetailnum = $rate_detail->ratedetailnum;
+ warn "rate_detail $ratedetailnum inserted\n"
+ if $DEBUG;
+
+ my $cdr_upstream_rate = new FS::cdr_upstream_rate {
+ 'upstream_rateid' => $hash{'Class Code'},
+ 'ratedetailnum' => $rate_detail->ratedetailnum,
+ };
+ $error = $cdr_upstream_rate->insert;
+ if ( $error ) {
+ dbh->rollback;
+ die "error inserting into cdr_upstream_rate: $error\n";
+ }
+ warn "cdr_upstream_rate ". $cdr_upstream_rate->upstreamratenum. " inserted\n"
+ if $DEBUG;
+
+ dbh->commit or die "can't commit: ". dbh->errstr;
+
+ warn "\n" if $DEBUG;
+
+}
+
+dbh->commit or die "can't commit: ". dbh->errstr;
+
+sub usage {
+ "Usage:\n\ncdr_upstream_rate.import username ratenum filename\n";
+}
+
diff --git a/bin/create-fetchmailrc b/bin/create-fetchmailrc
new file mode 100644
index 000000000..11bde0ce3
--- /dev/null
+++ b/bin/create-fetchmailrc
@@ -0,0 +1,47 @@
+#!/usr/bin/perl -w
+# this quick hack helps you generate/maintain .fetchmailrc files from
+# FS::acct_snarf data. it is run from a shellcommands export as:
+# create-fetchmailrc $username $dir $snarf_machine1 $snarf_username1 $snarf__password1 $snarf_machine2 $snarf_username2 $snarf__password2 ...
+
+use strict;
+use POSIX qw( setuid setgid );
+
+my $header = <<END;
+# Configuration created by create-fetchmailrc
+set postmaster "postmaster"
+set bouncemail
+set no spambounce
+set properties ""
+set daemon 240
+END
+
+my $username = shift @ARGV or die "no username specified\n";
+my $homedir = shift @ARGV or die "no homedir specified\n";
+my $filename = "$homedir/.fetchmailrc";
+
+my $gid = scalar(getgrnam($username)) or die "can't find $username's gid\n";
+my $uid = scalar(getpwnam($username)) or die "can't find $username's uid\n";
+
+exit unless $ARGV[0];
+
+open(FETCHMAILRC, ">$filename") or die "can't open $filename: $!\n";
+chown $uid, $gid, $filename or die "can't chown $uid.$gid $filename: $!\n";
+chmod 0600, $filename or die "can't chmod 600 $filename: $!\n";
+print FETCHMAILRC $header;
+
+while ($ARGV[0]) {
+ my( $s_machine, $s_username, $s_password ) = splice( @ARGV, 0, 3 );
+ print FETCHMAILRC <<END;
+poll $s_machine
+ user '$s_username' there with password '$s_password' is '$username' here
+END
+}
+
+close FETCHMAILRC;
+
+setgid($gid) or die "can't setgid $gid\n";
+setuid($uid) or die "can't setuid $uid\n";
+$ENV{HOME} = $homedir;
+
+system(qq(fetchmail -a -K --antispam "550,451" -d 180 -f $filename));
+
diff --git a/bin/customer-faker b/bin/customer-faker
new file mode 100755
index 000000000..236a41247
--- /dev/null
+++ b/bin/customer-faker
@@ -0,0 +1,124 @@
+#!/usr/bin/perl
+
+use strict;
+use Getopt::Std;
+use Data::Faker;
+use Business::CreditCard;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch);
+use FS::cust_main;
+use FS::cust_pkg;
+use FS::svc_acct;
+
+my $refnum = 1;
+
+#my @pkgs = ( 4, 5, 6 );
+my $svcpart = 2;
+
+use vars qw( $opt_p $opt_a $opt_k );
+getopts('p:a:k:');
+
+my $agentnum = $opt_a || 1;
+
+my @pkgs = $opt_k ? split(/,\s*/, $opt_k) : ( 2, 3, 4 );
+
+my $user = shift or die &usage;
+my $num = shift or die &usage;
+adminsuidsetup($user);
+
+my $onum = $num;
+my $start = time;
+
+my @states = qw( AL AK AS AZ AR CA CO CT DE DC FL GA GU HI ID IL IN IA KS KY LA ME MD MA MI MN MS MO MT NE NV NH NJ NM NY NC ND MP OH OK OR PA PR RI SC SD TN TX UT VT VI VA WA WV WI WY );
+#FM MH
+
+until ( $num-- <= 0 ) {
+
+ my $faker = new Data::Faker;
+
+ my $cust_main = new FS::cust_main {
+ 'agentnum' => $agentnum,
+ 'refnum' => $refnum,
+ 'first' => $faker->first_name,
+ 'last' => $faker->last_name,
+ 'company' => ( $num % 2 ? $faker->company. ', '. $faker->company_suffix : '' ), #half with companies..
+ 'address1' => $faker->street_address,
+ 'city' => 'Tofutown', #missing, so everyone is from tofutown# $faker->city,
+ #'state' => $faker->us_state_abbr,
+ 'state' => $states[ int(rand($#states)) ],
+ 'zip' => $faker->us_zip_code,
+ 'country' => 'US',
+ 'daytime' => $faker->phone_number,
+ 'night' => $faker->phone_number,
+ #forget it, these can have extensions# 'fax' => ( $num % 2 ? $faker->phone_number : '' ), #ditto
+ #bah, forget shipping addresses
+ 'payby' => 'BILL',
+ 'payip' => $faker->ip_address,
+ };
+
+ if ( $opt_p eq 'CARD' || ( !$opt_p && rand() > .33 ) ) {
+ $cust_main->payby('CARD');
+ my $cardnum = '4123'. sprintf('%011u', int(rand(100000000000)) );
+ $cust_main->payinfo( $cardnum. generate_last_digit($cardnum) );
+ $cust_main->paydate( '2009-05-01' );
+ } elsif ( $opt_p eq 'CHEK' || ( !$opt_p && rand() > .66 ) ) {
+ $cust_main->payby('CHEK');
+ my $payinfo = sprintf('%7u@%09u', int(rand(10000000)), int(rand(1000000000)) );
+ $cust_main->payinfo($payinfo);
+ $cust_main->payname( 'First International Bank of Testing' );
+ }
+
+ # could insert invoicing_list and other stuff too.. hell, could insert
+ # packages, services, more
+ # but i just wanted 10k customers to test the pager and this was good enough
+ # not anymore, here's some services and packages
+
+ my $now = time;
+ my $year = 31556736; #60*60*24*365.24
+ my $setup = $now - int(rand($year));
+
+ my $cust_pkg = new FS::cust_pkg {
+ 'pkgpart' => $pkgs[ int(rand(scalar(@pkgs))) ],
+
+ #some dates in here would be nice
+ 'setup' => $setup,
+ #'last_bill'
+ #'bill'
+ #'susp'
+ #'expire'
+ #'cancel'
+ };
+
+ my $svc_acct = new FS::svc_acct {
+ 'svcpart' => $svcpart,
+ 'username' => $faker->username,
+ };
+
+ while ( qsearch( 'svc_acct', { 'username' => $svc_acct->username } ) ) {
+ my $username = $svc_acct->username;
+ $username++;
+ $svc_acct->username($username);
+ }
+
+ use Tie::RefHash;
+ tie my %hash, 'Tie::RefHash',
+ $cust_pkg => [ $svc_acct ],
+ ;
+
+ my $error = $cust_main->insert( \%hash );
+ die $error if $error;
+
+}
+
+my $end = time;
+
+my $sec = $end-$start;
+$sec=1 if $sec==0;
+my $persec = $onum / $sec;
+print "$onum customers inserted in $sec seconds ($persec customers/sec)\n";
+
+#---
+
+sub usage {
+ die "Usage:\n\n customer-faker [ -p payby ] [ -a agentnum ] [ -k pkgpart,pkgpart,pkgpart... ] user num_fakes\n";
+}
diff --git a/bin/dbdef-create b/bin/dbdef-create
deleted file mode 100755
index eb62c77e3..000000000
--- a/bin/dbdef-create
+++ /dev/null
@@ -1,85 +0,0 @@
-#!/usr/bin/perl -Tw
-#
-# create dbdef file for existing mySQL database (needs SHOW|DESCRIBE command
-# not in Pg) based on fs-setup
-#
-# ivan@sisd.com 98-jun-2
-
-use strict;
-use DBI;
-use FS::dbdef;
-use FS::UID qw(adminsuidsetup datasrc);
-
-#needs to match FS::Record
-my($dbdef_file) = "/var/spool/freeside/dbdef.". datasrc;
-
-my($dbh)=adminsuidsetup;
-
-my($tables_sth)=$dbh->prepare("SHOW TABLES");
-my($tables_rv)=$tables_sth->execute;
-
-my(@tables);
-foreach ( @{$tables_sth->fetchall_arrayref} ) {
- my($table)=${$_}[0];
- #print "TABLE\t$table\n";
-
- my($index_sth)=$dbh->prepare("SHOW INDEX FROM $table");
- my($primary_key)='';
- my(%index,%unique);
- for ( 1 .. $index_sth->execute ) {
- my($row)=$index_sth->fetchrow_hashref;
- if ( ${$row}{'Key_name'} eq "PRIMARY" ) {
- $primary_key=${$row}{'Column_name'};
- next;
- }
- if ( ${$row}{'Non_unique'} ) { #index
- push @{$index{${$row}{'Key_name'}}}, ${$row}{'Column_name'};
- } else { #unique
- push @{$unique{${$row}{'Key_name'}}}, ${$row}{'Column_name'};
- }
- }
-
- my(@index)=values %index;
- my(@unique)=values %unique;
- #print "\tPRIMARY KEY $primary_key\n";
- foreach (@index) {
- #print "\tINDEX\t", join(', ', @{$_}), "\n";
- }
- foreach (@unique) {
- #print "\tUNIQUE\t", join(', ', @{$_}), "\n";
- }
-
- my($columns_sth)=$dbh->prepare("SHOW COLUMNS FROM $table");
- my(@columns);
- for ( 1 .. $columns_sth->execute ) {
- my($row)=$columns_sth->fetchrow_hashref;
- #print "\t", ${$row}{'Field'}, "\n";
- ${$row}{'Type'} =~ /^(\w+)\(?([\d\,]+)?\)?( unsigned)?$/
- or die "Illegal type ${$row}{'Type'}\n";
- my($type,$length)=($1,$2);
- my($null)=${$row}{'Null'};
- $null =~ s/YES/NULL/;
- push @columns, new FS::dbdef_column (
- ${$row}{'Field'},
- $type,
- $null,
- $length,
- );
- }
-
- #print "\n";
- push @tables, new FS::dbdef_table (
- $table,
- $primary_key,
- new FS::dbdef_unique (\@unique),
- new FS::dbdef_index (\@index),
- @columns,
- );
-
-}
-
-my($dbdef) = new FS::dbdef ( @tables );
-
-#important
-$dbdef->save($dbdef_file);
-
diff --git a/bin/expand-country b/bin/expand-country
new file mode 100755
index 000000000..c6f2a1f09
--- /dev/null
+++ b/bin/expand-country
@@ -0,0 +1,29 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Locale::SubCountry;
+use FS::UID qw(adminsuidsetup);
+use FS::Setup;
+use FS::Record qw(qsearch);
+use FS::cust_main_county;
+
+my $user = shift or die &usage;
+my $country = shift or die &usage;
+
+adminsuidsetup($user);
+
+my @country = qsearch('cust_main_county', { 'country' => $country } );
+die "unknown country $country" unless (@country);
+#die "$country already expanded" if scalar(@country) > 1;
+
+foreach my $cust_main_county ( @country ) {
+ my $error = $cust_main_county->delete;
+ die $error if $error;
+}
+
+FS::Setup::_add_country($country);
+
+sub usage {
+ die "Usage:\n\n expand-country user countrycode\n";
+}
+
diff --git a/bin/explain-ar-total.sql b/bin/explain-ar-total.sql
new file mode 100644
index 000000000..f1544303b
--- /dev/null
+++ b/bin/explain-ar-total.sql
@@ -0,0 +1,976 @@
+EXPLAIN SELECT ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill LEFT JOIN cust_main USING ( custnum ) WHERE cust_bill._date > ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum )
+ > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund LEFT JOIN cust_main USING ( custnum ) WHERE cust_refund._date > ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum )
+ > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit LEFT JOIN cust_main USING ( custnum ) WHERE cust_credit._date > ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum )
+ > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay LEFT JOIN cust_main USING ( custnum ) WHERE cust_pay._date > ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum )
+ > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) )
+ AS balance_0_30, ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill LEFT JOIN cust_main USING ( custnum ) WHERE cust_bill._date <= ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND cust_bill._date > ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum )
+ > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund LEFT JOIN cust_main USING ( custnum ) WHERE cust_refund._date <= ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND cust_refund._date > ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum )
+ > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit LEFT JOIN cust_main USING ( custnum ) WHERE cust_credit._date <= ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND cust_credit._date > ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum )
+ > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay LEFT JOIN cust_main USING ( custnum ) WHERE cust_pay._date <= ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND cust_pay._date > ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum )
+ > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) )
+ AS balance_30_60, ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill LEFT JOIN cust_main USING ( custnum ) WHERE cust_bill._date <= ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND cust_bill._date > ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum )
+ > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund LEFT JOIN cust_main USING ( custnum ) WHERE cust_refund._date <= ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND cust_refund._date > ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum )
+ > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit LEFT JOIN cust_main USING ( custnum ) WHERE cust_credit._date <= ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND cust_credit._date > ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum )
+ > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay LEFT JOIN cust_main USING ( custnum ) WHERE cust_pay._date <= ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND cust_pay._date > ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum )
+ > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) )
+ AS balance_60_90, ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill LEFT JOIN cust_main USING ( custnum ) WHERE cust_bill._date <= ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum )
+ > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund LEFT JOIN cust_main USING ( custnum ) WHERE cust_refund._date <= ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum )
+ > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit LEFT JOIN cust_main USING ( custnum ) WHERE cust_credit._date <= ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum )
+ > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay LEFT JOIN cust_main USING ( custnum ) WHERE cust_pay._date <= ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum )
+ > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) )
+ AS balance_90_0, ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill LEFT JOIN cust_main USING ( custnum ) WHERE ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum )
+ > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund LEFT JOIN cust_main USING ( custnum ) WHERE ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum )
+ > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit LEFT JOIN cust_main USING ( custnum ) WHERE ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum )
+ > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay LEFT JOIN cust_main USING ( custnum ) WHERE ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay
+ WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill
+ WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum )
+ + ( SELECT COALESCE(SUM(refund
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_refund.refundnum = cust_credit_refund.refundnum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_refund.refundnum = cust_pay_refund.refundnum )
+ ,0
+ )
+ ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum )
+ - ( SELECT COALESCE(SUM(amount
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_refund
+ WHERE cust_credit.crednum = cust_credit_refund.crednum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_credit_bill
+ WHERE cust_credit.crednum = cust_credit_bill.crednum )
+ ,0
+ )
+ ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum )
+ - ( SELECT COALESCE(SUM(paid
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_bill_pay
+ WHERE cust_pay.paynum = cust_bill_pay.paynum )
+ ,0
+ )
+ - COALESCE(
+ ( SELECT SUM(amount) FROM cust_pay_refund
+ WHERE cust_pay.paynum = cust_pay_refund.paynum )
+ ,0
+ )
+ ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum )
+ > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) )
+ AS balance_0_0
diff --git a/bin/find-overapplied b/bin/find-overapplied
new file mode 100644
index 000000000..7973cef5b
--- /dev/null
+++ b/bin/find-overapplied
@@ -0,0 +1,27 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Data::Dumper;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch);
+use FS::cust_credit;
+use FS::cust_pay;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my @credits = grep { $_->credited < 0 } qsearch('cust_credit', {});
+my @payments = grep { $_->unapplied < 0 } qsearch('cust_pay', {});
+
+if ( @credits ) {
+ print scalar(@credits). " overapplied credits:\n". Dumper(@credits). "\n";
+}
+
+if ( @payments ) {
+ print scalar(@payments). " overapplied payments:\n". Dumper(@payments). "\n";
+}
+
+sub usage {
+ die "Usage:\n\n find-overapplied user\n";
+}
+
diff --git a/bin/fix-sequences b/bin/fix-sequences
new file mode 100755
index 000000000..dc4abd751
--- /dev/null
+++ b/bin/fix-sequences
@@ -0,0 +1,69 @@
+#!/usr/bin/perl -Tw
+
+# run dbdef-create first!
+
+use strict;
+use DBI;
+use DBIx::DBSchema 0.26;
+use DBIx::DBSchema::Table;
+use DBIx::DBSchema::Column;
+use DBIx::DBSchema::ColGroup::Unique;
+use DBIx::DBSchema::ColGroup::Index;
+use FS::UID qw(adminsuidsetup driver_name);
+use FS::Record qw(dbdef);
+
+my $user = shift or die &usage;
+my $dbh = adminsuidsetup $user;
+
+my $schema = dbdef();
+
+#false laziness w/fs-setup
+my @tables = scalar(@ARGV)
+ ? @ARGV
+ : grep { ! /^h_/ } $schema->tables;
+foreach my $table ( @tables ) {
+ my $tableobj = $schema->table($table)
+ or die "unknown table $table (did you run dbdef-create?)\n";
+
+ my $primary_key = $tableobj->primary_key;
+ next unless $primary_key;
+
+ my $col = $tableobj->column($primary_key);
+
+
+ next unless uc($col->type) eq 'SERIAL'
+ || ( driver_name eq 'Pg'
+ && defined($col->default)
+ && $col->default =~ /^nextval\(/i
+ )
+ || ( driver_name eq 'mysql'
+ && defined($col->local)
+ && $col->local =~ /AUTO_INCREMENT/i
+ );
+
+ my $seq = "${table}_${primary_key}_seq";
+ if ( driver_name eq 'Pg'
+ && defined($col->default)
+ && $col->default =~ /^nextval\('"(public\.)?(\w+_seq)"'::text\)$/
+ ) {
+ $seq = $2;
+ }
+
+ warn "fixing sequence for $table\n";
+
+
+ my $sql = "SELECT setval( '$seq',
+ ( SELECT max($primary_key) FROM $table ) );";
+
+ #warn $col->default. " $seq\n$sql\n";
+ $dbh->do( $sql ) or die $dbh->errstr;
+
+}
+
+$dbh->commit or die $dbh->errstr;
+$dbh->disconnect or die $dbh->errstr;
+
+sub usage {
+ die "Usage:\n fix-sequences user [ table table ... ] \n";
+}
+
diff --git a/bin/follow-tax-rename b/bin/follow-tax-rename
new file mode 100644
index 000000000..b7536e815
--- /dev/null
+++ b/bin/follow-tax-rename
@@ -0,0 +1,52 @@
+#!/usr/bin/perl
+
+use FS::UID qw( adminsuidsetup );
+use FS::Record qw( qsearch qsearchs );
+use FS::cust_bill_pkg;
+
+$FS::Record::nowarn_classload = 1;
+$FS::Record::nowarn_classload = 1;
+
+adminsuidsetup shift;
+
+my $begin = 1231876106;
+
+my @old = qsearch('h_cust_main_county', {
+ 'history_action' => 'replace_old',
+ 'history_date' => { op=>'>=', value=>$begin, },
+} );
+
+foreach my $old (@old) {
+
+ my $new = qsearchs('h_cust_main_county', {
+ 'history_action' => 'replace_new',
+ 'history_date' => $old->history_date,
+ });
+
+ unless ( $new ) {
+ warn "huh? no corresponding new record found?";
+ next;
+ }
+
+ my $old_taxname = $old->taxname;
+ my $new_taxname = $new->taxname;
+
+ my @cust_bill_pkg = qsearch('cust_bill_pkg', {
+ 'pkgnum' => 0,
+ 'itemdesc' => $old->taxname,
+ });
+
+ next unless @cust_bill_pkg;
+
+ warn 'fixing '. scalar(@cust_bill_pkg).
+ " dangling line items for rename $old_taxname -> $new_taxname\n";
+
+ foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
+
+ $cust_bill_pkg->itemdesc( $new->taxname );
+ my $error = $cust_bill_pkg->replace;
+ die $error if $error;
+
+ }
+
+}
diff --git a/bin/freeside-create-initial-data b/bin/freeside-create-initial-data
new file mode 100755
index 000000000..410208978
--- /dev/null
+++ b/bin/freeside-create-initial-data
@@ -0,0 +1,31 @@
+#!/usr/bin/perl -Tw
+
+#to allow initial insert
+use FS::part_pkg;
+$FS::part_pkg::setup_hack = 1;
+$FS::part_pkg::setup_hack = 1;
+
+use strict;
+use vars qw($opt_d $opt_v);
+use Getopt::Std;
+use FS::UID qw(adminsuidsetup);
+use FS::Setup qw(create_initial_data);
+
+getopts("d:");
+
+my $dbh = adminsuidsetup shift;
+create_initial_data('domain' => $opt_d);
+
+warn "Freeside initial data inserted - commiting transaction\n" if $opt_v;
+
+$dbh->commit or die $dbh->errstr;
+$dbh->disconnect or die $dbh->errstr;
+
+warn "Database initialization committed successfully\n" if $opt_v;
+
+sub usage {
+ die "Usage:\n freeside-create-initial-data -d domain.name [ -v ] user\n"
+}
+
+1;
+
diff --git a/bin/freeside-init b/bin/freeside-init
new file mode 100755
index 000000000..fe12931fc
--- /dev/null
+++ b/bin/freeside-init
@@ -0,0 +1,60 @@
+#! /bin/sh
+#
+# start the freeside job queue daemon
+
+#PATH=/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin
+DAEMON=/usr/local/bin/freeside-queued
+NAME=freeside-queued
+DESC="freeside job queue daemon"
+USER="ivan"
+
+test -f $DAEMON || exit 0
+
+set -e
+
+case "$1" in
+ start)
+ echo -n "Starting $DESC: "
+# start-stop-daemon --start --quiet --pidfile /var/run/$NAME.pid -b -m\
+# --exec $DAEMON
+ $DAEMON $USER &
+ echo "$NAME."
+ ;;
+ stop)
+ echo -n "Stopping $DESC: "
+ start-stop-daemon --stop --quiet --pidfile /var/run/$NAME.pid \
+ --exec $DAEMON
+ echo "$NAME."
+ rm /var/run/$NAME.pid
+ ;;
+ #reload)
+ #
+ # If the daemon can reload its config files on the fly
+ # for example by sending it SIGHUP, do it here.
+ #
+ # If the daemon responds to changes in its config file
+ # directly anyway, make this a do-nothing entry.
+ #
+ # echo "Reloading $DESC configuration files."
+ # start-stop-daemon --stop --signal 1 --quiet --pidfile \
+ # /var/run/$NAME.pid --exec $DAEMON
+ #;;
+ restart|force-reload)
+ #
+ # If the "reload" option is implemented, move the "force-reload"
+ # option to the "reload" entry above. If not, "force-reload" is
+ # just the same as "restart".
+ #
+ $0 stop
+ sleep 1
+ $0 start
+ ;;
+ *)
+ N=/etc/init.d/$NAME
+ # echo "Usage: $N {start|stop|restart|reload|force-reload}" >&2
+ echo "Usage: $N {start|stop|restart|force-reload}" >&2
+ exit 1
+ ;;
+esac
+
+exit 0
diff --git a/bin/freeside-migrate-events b/bin/freeside-migrate-events
new file mode 100644
index 000000000..76643b886
--- /dev/null
+++ b/bin/freeside-migrate-events
@@ -0,0 +1,229 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw( qsearch );
+use FS::part_bill_event;
+use FS::part_event;
+use FS::cust_bill_event;
+use FS::cust_event;
+
+my $user = shift or die &usage;
+adminsuidsetup($user);
+
+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-pkgpart' => 'suspend_if_pkgpart',
+ 'suspend-unless-pkgpart' => 'suspend_unless_pkgpart',
+ 'cancel' => 'cancel',
+ 'addpost' => 'addpost',
+ 'comp' => 'NOTYET', #XXX or N/A or something
+ 'credit' => 'NOTYET',
+ '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_alternate' => 'cust_bill_send_alternate',
+ 'send_if_newest' => 'cust_bill_send_if_newest',
+ 'send_agent' => 'cust_bill_send_agent',
+ 'send_csv_ftp' => 'cust_bill_send_csv_ftp',
+ 'spool_csv', => 'cust_bill_spool_csv',
+ 'bill' => 'bill',
+ 'apply' => 'apply',
+ 'collect' => 'collect',
+);
+
+
+foreach my $part_bill_event (
+ qsearch({
+ 'table' => 'part_bill_event',
+ })
+) {
+
+ print $part_bill_event->event;
+
+ my $action = $plan2action{ $part_bill_event->plan };
+
+ if ( $action eq 'NOTYET' ) {
+ warn "not migrating part_bill_event.eventpart ".$part_bill_event->eventpart.
+ "; ". $part_bill_event->plan. " plan not (yet) handled";
+ next;
+ } elsif ( ! $action ) {
+ warn "not migrating part_bill_event.eventpart ".$part_bill_event->eventpart.
+ "; unknown plan ". $part_bill_event->plan;
+ next;
+ }
+
+ my %plandata = map { /^(\w+) (.*)$/; ($1, $2); }
+ split(/\n/, $part_bill_event->plandata);
+
+ #XXX may need to fudge some plandata2option names!!!
+
+ my $part_event = new FS::part_event {
+ 'event' => $part_bill_event->event,
+ 'eventtable' => 'cust_bill',
+ 'check_freq' => $part_bill_event->freq || '1d',
+ 'weight' => $part_bill_event->weight,
+ 'action' => $action,
+ 'disabled' => $part_bill_event->disabled,
+ };
+
+ my $error = $part_event->insert(\%plandata);
+ die "error inserting part_event: $error\n" if $error;
+
+ print ' '. $part_event->eventpart;
+
+ my $once = new FS::part_event_condition {
+ 'eventpart' => $part_event->eventpart,
+ 'conditionname' => 'once'
+ };
+ $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 );
+ die $error if $error;
+
+ my $cust_bill_owed = new FS::part_event_condition {
+ 'eventpart' => $part_event->eventpart,
+ 'conditionname' => 'cust_bill_owed'
+ };
+ $error = $cust_bill_owed->insert( 'owed' => 0 );
+ die $error if $error;
+
+ my $payby = new FS::part_event_condition {
+ 'eventpart' => $part_event->eventpart,
+ 'conditionname' => 'payby'
+ };
+ $error = $payby->insert( 'payby' => { $part_bill_event->payby => 1 } );
+ die $error if $error;
+
+ if ( $part_bill_event->seconds ) {
+
+ my $age = new FS::part_event_condition {
+ 'eventpart' => $part_event->eventpart,
+ 'conditionname' => 'cust_bill_age'
+ };
+ $error = $age->insert( 'age' => ($part_bill_event->seconds/86400 ).'d' );
+ 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,
+ };
+
+ 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";
+
+}
+
+sub usage {
+ die "Usage:\n freeside-migrate-events user\n";
+}
+
+=head1 NAME
+
+freeside-migrate-events - Migrates 1.7/1.8-style invoice events to
+ 1.9/2.0-style billing events
+
+=head1 SYNOPSIS
+
+ freeside-migrate-events
+
+=head1 DESCRIPTION
+
+Migrates events from L<FS::part_bill_event> to L<FS::part_event> and friends,
+and from L<FS::cust_bill_event> records to L<FS::cust_event>
+
+=head1 BUGS
+
+Doesn't migrate any action options yet.
+
+Doesn't translate option names that changed.
+
+Doesn't migrate reasons.
+
+Doesn't delete the old events (which is not a big deal, since the new code
+won't run them...)
+
+=head1 SEE ALSO
+
+=cut
+
+1;
+
+__END__
+
+#part_bill_event part_event
+#
+#eventpart n/a
+#event event
+#freq check_freq
+#payby part_event_condition.conditionname = payby
+#eventcode PARSE_WITH_REGEX (probably can just get from plandata)
+#seconds part_event_condition.conditionname = cust_bill_age
+#plandata PARSE_WITH_REGEX (along with eventcode, yuck)
+#reason part_event_option.optionname = reason
+#disabled disabled
+#
+
+ #these might help parse existing eventcode
+
+ $c =~ /^\s*\$cust_main\->(suspend|cancel|invoicing_list_addpost|bill|collect)\(\);\s*("";)?\s*$/
+
+ or $c =~ /^\s*\$cust_bill\->(comp|realtime_(card|ach|lec)|batch_card|send)\((%options)*\);\s*$/
+
+ or $c =~ /^\s*\$cust_bill\->send(_if_newest)?\(\'[\w\-\s]+\'\s*(,\s*(\d+|\[\s*\d+(,\s*\d+)*\s*\])\s*,\s*'[\w\@\.\-\+]*'\s*)?\);\s*$/
+
+# or $c =~ /^\s*\$cust_main\->apply_payments; \$cust_main->apply_credits; "";\s*$/
+ or $c =~ /^\s*\$cust_main\->apply_payments_and_credits; "";\s*$/
+
+ or $c =~ /^\s*\$cust_main\->charge\( \s*\d*\.?\d*\s*,\s*\'[\w \!\@\#\$\%\&\(\)\-\+\;\:\"\,\.\?\/]*\'\s*\);\s*$/
+
+ or $c =~ /^\s*\$cust_main\->suspend_(if|unless)_pkgpart\([\d\,\s]*\);\s*$/
+
+ or $c =~ /^\s*\$cust_bill\->cust_suspend_if_balance_over\([\d\.\s]*\);\s*$/
+
+ or do {
+ #log
+ return "illegal eventcode: $c";
+ };
+
+ }
+
+
diff --git a/bin/freeside-session-kill b/bin/freeside-session-kill
new file mode 100755
index 000000000..d5fd703f6
--- /dev/null
+++ b/bin/freeside-session-kill
@@ -0,0 +1,103 @@
+#!/usr/bin/perl -w
+
+use strict;
+use vars qw($conf);
+use Fcntl qw(:flock);
+use FS::UID qw(adminsuidsetup datasrc dbh);
+use FS::Record qw(dbdef qsearch fields);
+use FS::session;
+use FS::svc_acct;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my $sessionlock = "/usr/local/etc/freeside/session-kill.lock.". datasrc;
+
+open(LOCK,"+>>$sessionlock") or die "Can't open $sessionlock: $!";
+select(LOCK); $|=1; select(STDOUT);
+unless ( flock(LOCK,LOCK_EX|LOCK_NB) ) {
+ seek(LOCK,0,0);
+ my($pid)=<LOCK>;
+ chop($pid);
+ #no reason to start loct of blocking processes
+ die "Is another session kill process running under pid $pid?\n";
+}
+seek(LOCK,0,0);
+print LOCK $$,"\n";
+
+$FS::UID::AutoCommit = 0;
+
+my $now = time;
+
+#uhhhhh
+
+use DBIx::DBSchema;
+use DBIx::DBSchema::Table; #down this path lies madness
+use DBIx::DBSchema::Column;
+
+my $dbdef = dbdef or die;
+#warn $dbdef;
+#warn $dbdef->{'tables'};
+#warn keys %{$dbdef->{'tables'}};
+my $session_table = $dbdef->table('session') or die;
+my $svc_acct_table = $dbdef->table('svc_acct') or die;
+
+my $session_svc_acct = new DBIx::DBSchema::Table ( 'session,svc_acct', '', '', '',
+ map( DBIx::DBSchema::Column->new( "session.$_",
+ $session_table->column($_)->type,
+ $session_table->column($_)->null,
+ $session_table->column($_)->length,
+ ), $session_table->columns() ),
+ map( DBIx::DBSchema::Column->new( "svc_acct.$_",
+ $svc_acct_table->column($_)->type,
+ $svc_acct_table->column($_)->null,
+ $svc_acct_table->column($_)->length,
+ ), $svc_acct_table->columns ),
+# map("svc_acct.$_", $svc_acct_table->columns),
+);
+
+$dbdef->addtable($session_svc_acct); #madness, i tell you
+
+$FS::Record::DEBUG = 1;
+my @session = qsearch('session,svc_acct', {}, '', ' WHERE '. join(' AND ',
+ 'svc_acct.svcnum = session.svcnum',
+ '( session.logout IS NULL OR session.logout = 0 )',
+ "( $now - session.login ) >= svc_acct.seconds"
+). " FOR UPDATE" );
+
+my $dbh = dbh;
+
+foreach my $join ( @session ) {
+
+ my $session = new FS::session ( {
+ map { $_ => $join->{'Hash'}{"session.$_"} } fields('session')
+ } ); #see no evil
+
+ my $svc_acct = new FS::svc_acct ( {
+ map { $_ => $join->{'Hash'}{"svc_acct.$_"} } fields('svc_acct')
+ } );
+
+ #false laziness w/ fs_session_server
+ my $nsession = new FS::session ( { $session->hash } );
+ my $error = $nsession->replace($session);
+ if ( $error ) {
+ $dbh->rollback;
+ die $error;
+ }
+ my $time = $nsession->logout - $nsession->login;
+ my $new_svc_acct = new FS::svc_acct ( { $svc_acct->hash } );
+ my $seconds = $new_svc_acct->seconds;
+ $seconds -= $time;
+ $seconds = 0 if $seconds < 0;
+ $new_svc_acct->seconds( $seconds );
+ $error = $new_svc_acct->replace( $svc_acct );
+ warn "can't debit time from ". $svc_acct->username. ": $error\n"; #don't want to rollback, though
+ #ssenizal eslaf
+
+}
+
+$dbh->commit or die $dbh->errstr;
+
+sub usage {
+ die "Usage:\n\n freeside-session-kill user\n";
+}
diff --git a/bin/freeside-upgrade-unicode b/bin/freeside-upgrade-unicode
new file mode 100755
index 000000000..c60336567
--- /dev/null
+++ b/bin/freeside-upgrade-unicode
@@ -0,0 +1,72 @@
+#!/bin/bash
+
+# based on example code from
+# http://blog.larik.nl:80/articles/2006/03/13/upgrade-your-postgresql-databases-to-unicode
+# by frodo larik / blog.larik.nl
+
+db=freeside
+
+# This script updates all dbs to use unicode
+
+dbhost='localhost'
+username='freeside'
+#odir=${HOME}/freeside_unicode_upgrade
+odir=/home/ivan/FREESIDE_unicode_upgrade
+
+if [ "${db}X" == "X" ]
+then
+ echo "I need a db for host ${dbhost} and username ${username} $db"
+ exit
+fi
+
+if [ ! -d $odir ]
+then
+ mkdir $odir || exit "Exit at mkdir"
+fi
+
+#echo -n "Enter a comma-separated list of country codes to keep [US,CA]:"
+#countries=`line`
+#if [ "${countries}X" == "X" ]
+#then
+# countries='US,CA'
+#fi
+
+echo "delete from cust_main_county where 0 = ( select count(*) from cust_main where cust_main_county.country = cust_main.country );" | su freeside -c 'psql freeside'
+
+dump_sql=${odir}/${db}_out.sql
+conv_sql=${odir}/${db}_conv.sql
+result_sql=${odir}/${db}_result.txt
+sql_diff=${odir}/${db}.diff
+
+# 0. stop
+
+/etc/init.d/freeside stop || die "can't stop freeside"
+/etc/init.d/apache stop || die "can't stop apache"
+/etc/init.d/apache2 stop || die "can't stop apache"
+
+echo "Dumping $db database to $dump_sql"
+
+su $username -c "pg_dump --host=$dbhost --username=$username -D --format=p $db" >$dump_sql || exit "exit at pg_dump"
+
+echo "Removing invalid characters from the dump"
+
+iconv -c -f UTF-8 -t UTF-8 ${dump_sql} > ${conv_sql} || exit "exit at iconv"
+
+echo "*** Making a diff from the dump: check $sql_diff ***"
+
+diff $dump_sql $conv_sql > $sql_diff
+
+echo "Removing current database"
+
+su $freeside -c "dropdb --host=$dbhost --username=$username $db" || exit "exit at dropdb"
+
+echo "Creating a new databse"
+
+su freeside -c "createdb --encoding='unicode' --host=$dbhost --username=$username $db" || exit "exit at createdb"
+
+echo "Loading data into new database"
+su freeside -c "psql -f $conv_sql -o $result_sql -h $dbhost -U $username $db" || exit "exit at psql ${extra_string}"
+
+# 99.
+/etc/init.d/freeside start || die "oh no, can't start freeside"
+/etc/init.d/apache start || die "oh no, can't start apache"
diff --git a/bin/freeside.import b/bin/freeside.import
new file mode 100644
index 000000000..fdfcc083e
--- /dev/null
+++ b/bin/freeside.import
@@ -0,0 +1,146 @@
+#!/usr/bin/perl -w
+
+use strict;
+use DBI;
+
+my $s_datasrc = 'DBI:mysql:host=ns1.enetonline.net;port=3307;user=ivan;dbname=freeside';
+my $s_dbuser = 'ivan';
+my $s_dbpass = '';
+
+my $d_datasrc = 'DBI:Pg:dbname=freeside';
+my $d_dbuser = 'freeside';
+my $d_dbpass = '';
+
+#my @tables = qw(
+#addr_block
+#agent
+#agent_type
+#cust_bill
+#cust_bill_event
+#cust_bill_pay
+#cust_bill_pkg
+#cust_bill_pkg_detail
+#cust_credit
+#cust_credit_bill
+#cust_credit_refund
+#cust_main
+#cust_main_county
+#cust_main_invoice
+#cust_pay
+#cust_pay_batch
+#cust_pkg
+#cust_refund
+#cust_svc
+#cust_tax_exempt
+#domain_record
+#export_svc
+#h_addr_block
+#h_agent
+#h_agent_type
+#h_cust_bill
+#h_cust_bill_event
+#h_cust_bill_pay
+#h_cust_bill_pkg
+#h_cust_bill_pkg_detail
+#h_cust_credit
+#h_cust_credit_bill
+#h_cust_credit_refund
+#h_cust_main
+#h_cust_main_county
+#h_cust_main_invoice
+#h_cust_pay
+#h_cust_pay_batch
+#h_cust_pkg
+#h_cust_refund
+#h_cust_svc
+#h_cust_tax_exempt
+#h_domain_record
+#h_export_svc
+#h_msgcat
+#h_nas
+#h_part_bill_event
+#h_part_export
+#h_part_export_option
+#h_part_pkg
+#h_part_pop_local
+#h_part_referral
+#h_part_svc
+#h_part_svc_column
+#h_part_svc_router
+#h_pkg_svc
+#h_port
+#h_prepay_credit
+#h_queue
+#h_queue_arg
+#h_queue_depend
+#h_radius_usergroup
+#h_router
+#h_router_field
+#h_sb_field
+#h_session
+#h_svc_acct
+#h_svc_acct_pop
+#h_svc_broadband
+#h_svc_domain
+#h_svc_forward
+#h_svc_www
+#h_type_pkgs
+#msgcat
+#nas
+#part_bill_event
+#part_export
+#part_export_option
+#part_pkg
+
+my @tables = qw(
+part_pop_local
+part_referral
+part_router_field
+part_sb_field
+part_svc
+part_svc_column
+part_svc_router
+pkg_svc
+port
+prepay_credit
+queue
+queue_arg
+queue_depend
+radius_usergroup
+router
+router_field
+sb_field
+session
+svc_acct
+svc_acct_pop
+svc_broadband
+svc_domain
+svc_forward
+svc_www
+type_pkgs
+);
+
+my $s_dbh = DBI->connect($s_datasrc, $s_dbuser, $s_dbpass) or die $DBI::errstr;
+my $d_dbh = DBI->connect($d_datasrc, $d_dbuser, $d_dbpass) or die $DBI::errstr;
+
+foreach my $table ( @tables ) {
+ $d_dbh->do("delete from $table");
+
+ my $s_sth = $s_dbh->prepare("select * from $table");
+ $s_sth->execute or die $s_sth->errstr;
+
+ my $row;
+ while ( $row = $s_sth->fetchrow_arrayref ) {
+ my $d_sth = $d_dbh->prepare(
+ "insert into $table ( ".
+ join(', ', @{$s_sth->{NAME}} ).
+ ' ) VALUES ( '.
+ join(', ', map { '?' } @{$s_sth->{NAME}} ).
+ ' )'
+ ) or die $d_dbh->errstr;
+
+ $d_sth->execute(@$row) or die $d_sth->errstr;
+
+ }
+}
+
diff --git a/bin/fs-migrate-cust_tax_exempt b/bin/fs-migrate-cust_tax_exempt
new file mode 100755
index 000000000..ede80b08e
--- /dev/null
+++ b/bin/fs-migrate-cust_tax_exempt
@@ -0,0 +1,323 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Time::Local;
+use Date::Format;
+use Time::Duration;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw( qsearch dbh );
+use FS::cust_tax_exempt;
+#use FS::cust_bill;
+use FS::h_cust_bill;
+use FS::h_cust_tax_exempt;
+use FS::cust_bill_pkg;
+use FS::cust_tax_exempt_pkg;
+#use Data::Dumper;
+
+my $start = time;
+
+adminsuidsetup shift;
+
+my $fuz = 7; #seconds
+
+ #site-specific rewrites
+my %rewrite = (
+ #cust_tax_exempt.exemptnum => { 'field' => 'newvalue', ... },
+ '23' => { month=>10, year=>2005, invnum=>1640 },
+
+ #etc.
+);
+
+my @cust_tax_exempt = qsearch('cust_tax_exempt', {} );
+my $num_cust_tax_exempt = scalar(@cust_tax_exempt);
+my $num_cust_tax_exempt_migrated = 0;
+my $total_cust_tax_exempt_migrated = 0;
+my $num_cust_tax_exempt_pkg_migrated = 0;
+my $total_cust_tax_exempt_pkg_migrated = 0;
+
+$FS::UID::AutoCommit = 0;
+
+foreach my $cust_tax_exempt ( @cust_tax_exempt ) {
+
+ if ( exists $rewrite{ $cust_tax_exempt->exemptnum } ) {
+ my $hashref = $rewrite{ $cust_tax_exempt->exemptnum };
+ $cust_tax_exempt->setfield($_, $hashref->{$_})
+ foreach keys %$hashref;
+ }
+
+ if ( $cust_tax_exempt->year < 1990 ) {
+ warn "exemption year is ". $cust_tax_exempt->year.
+ "; not migrating exemption ". $cust_tax_exempt->exemptnum.
+ ' for custnum '. $cust_tax_exempt->custnum. "\n\n";
+ next;
+ }
+
+ # also make sure cust_bill_pkg record dates contain the month/year
+# my $mon = $cust_tax_exempt->month;
+# my $year = $cust_tax_exempt->year;
+# $mon--;
+# my $edate_after = timelocal(0,0,0,1,$mon,$year);
+# $mon++;
+# if ( $mon >= 12 ) { $mon-=12; $year++ };
+# my $sdate_before = timelocal(0,0,0,1,$mon,$year);
+
+ my $mon = $cust_tax_exempt->month;
+ my $year = $cust_tax_exempt->year;
+ if ( $mon >= 12 ) { $mon-=12; $year++ };
+ my $sdate_before = timelocal(0,0,0,1,$mon,$year);
+ #$mon++;
+ #if ( $mon >= 12 ) { $mon-=12; $year++ };
+ my $edate_after = timelocal(0,0,0,1,$mon,$year);
+
+ # !! start a transaction? (yes, its started)
+
+ my @h_cust_tax_exempt = qsearch({
+ 'table' => 'h_cust_tax_exempt',
+ 'hashref' => { 'exemptnum' => $cust_tax_exempt->exemptnum },
+ 'extra_sql' => " AND ( history_action = 'insert'
+ OR history_action = 'replace_new' )
+ ORDER BY history_date ASC
+ ",
+ });
+
+ my $amount_so_far = 0;
+ my $num_cust_tax_exempt_pkg = 0;
+ my $total_cust_tax_exempt_pkg = 0;
+ H_CUST_TAX_EXEMPT: foreach my $h_cust_tax_exempt ( @h_cust_tax_exempt ) {
+
+ my $amount = sprintf('%.2f', $h_cust_tax_exempt->amount - $amount_so_far );
+ $amount_so_far += $amount;
+
+# print Dumper($h_cust_tax_exempt), "\n";
+
+ #find a matching cust_bill record
+ # (print time differences and choose a meaningful threshold, should work)
+
+ my @h_cust_bill = ();
+ if ( $cust_tax_exempt->invnum ) {
+ #warn "following invnum ". $cust_tax_exempt->invnum.
+ # " kludge for cust_tax_exempt ". $cust_tax_exempt->exemptnum. "\n";
+
+ @h_cust_bill = qsearch({
+ #'table' => 'cust_bill',
+ 'table' => 'h_cust_bill',
+ 'hashref' => { 'custnum' => $h_cust_tax_exempt->custnum,
+ 'invnum' => $cust_tax_exempt->invnum,
+ 'history_action' => 'insert',
+ },
+ #'extra_sql' =>
+ # ' AND history_date <= '. ( $h_cust_tax_exempt->history_date + $fuz ).
+ # ' AND history_date > '. ( $h_cust_tax_exempt->history_date - $fuz ),
+ });
+
+ } else {
+
+ @h_cust_bill = qsearch({
+ #'table' => 'cust_bill',
+ 'table' => 'h_cust_bill',
+ 'hashref' => { 'custnum' => $h_cust_tax_exempt->custnum,
+ 'history_action' => 'insert',
+ },
+ 'extra_sql' =>
+ ' AND history_date <= '. ( $h_cust_tax_exempt->history_date + $fuz ).
+ ' AND history_date > '. ( $h_cust_tax_exempt->history_date - $fuz ),
+ });
+
+ }
+
+ if ( scalar(@h_cust_bill) != 1 ) {
+ warn ' '. scalar(@h_cust_bill). ' h_cust_bill records matching '.
+ 'h_cust_tax_exempt.historynum '. $h_cust_tax_exempt->historynum.
+ "; not migrating (adjust fuz factor?)\n";
+ next;
+ }
+
+ my $h_cust_bill = $h_cust_bill[0];
+
+# print Dumper(@cust_bill), "\n\n";
+
+ # then find a matching cust_bill_pkg record with part_pkg.taxclass record
+ # that matches the one pointed to by cust_tax_exempt.taxnum
+ # (hopefully just one, see how many we can match automatically)
+
+ my $cust_main_county = $cust_tax_exempt->cust_main_county;
+ my $taxclass = $cust_main_county->taxclass;
+
+ my $hashref = {
+ 'custnum' => $cust_tax_exempt->custnum,
+ 'invnum' => $h_cust_bill->invnum,
+ 'pkgnum' => { op=>'>', value=>0, },
+ };
+ unless ( $cust_tax_exempt->invnum ) {
+ # also make sure cust_bill_pkg record dates contain the month/year
+
+ #$hashref->{'sdate'} = { op=>'<', value=>$sdate_before };
+ $hashref->{'sdate'} = { op=>'<=', value=>$sdate_before };
+
+ #$hashref->{'edate'} = { op=>'>', value=>$edate_after };
+ $hashref->{'edate'} = { op=>'>=', value=>$edate_after };
+ }
+
+ if ( $cust_tax_exempt->billpkgnum ) {
+ $hashref->{'billpkgnum'} = $cust_tax_exempt->billpkgnum;
+ }
+
+ my $extra_sql = 'ORDER BY billpkgnum';
+
+ $extra_sql = "AND taxclass = '$taxclass' $extra_sql"
+ unless $cust_tax_exempt->ignore_current_taxclass;
+
+ my @cust_bill_pkg = qsearch({
+ 'select' => 'cust_bill_pkg.*, part_pkg.freq',
+ 'table' => 'cust_bill_pkg',
+ 'addl_from' => 'LEFT JOIN cust_pkg using ( pkgnum ) '.
+ 'LEFT JOIN part_pkg using ( pkgpart ) ',
+ 'hashref' => $hashref,
+ 'extra_sql' => $extra_sql,
+ });
+
+ foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
+ $cust_bill_pkg->exemptable_per_month(
+ sprintf('%.2f',
+ ( $cust_bill_pkg->setup + $cust_bill_pkg->recur )
+ /
+ ( $cust_bill_pkg[0]->freq || 1 )
+ )
+ );
+ }
+
+ my(@cust_tax_exempt_pkg) = ();
+ if ( scalar(@cust_bill_pkg) == 1
+ && $cust_bill_pkg[0]->exemptable_per_month >= $amount
+ )
+ {
+
+ my $cust_bill_pkg = $cust_bill_pkg[0];
+
+ # finally, create an appropriate cust_tax_exempt_pkg record
+
+ push @cust_tax_exempt_pkg, new FS::cust_tax_exempt_pkg {
+ 'billpkgnum' => $cust_bill_pkg->billpkgnum,
+ 'taxnum' => $cust_tax_exempt->taxnum,
+ 'year' => $cust_tax_exempt->year,
+ 'month' => $cust_tax_exempt->month,
+ 'amount' => $amount,
+ };
+
+ } else {
+
+# warn ' '. scalar(@cust_bill_pkg). ' cust_bill_pkg records for invoice '.
+# $h_cust_bill->invnum.
+# "; not migrating h_cust_tax_exempt historynum ".
+# $h_cust_tax_exempt->historynum. " for \$$amount\n";
+# warn " *** DIFFERENT DATES ***\n"
+# if grep { $_->sdate != $cust_bill_pkg[0]->sdate
+# || $_->edate != $cust_bill_pkg[0]->edate
+# } @cust_bill_pkg;
+# foreach ( @cust_bill_pkg ) {
+# warn ' '. $_->billpkgnum. ': '. $_->setup. 's/'. $_->recur.'r'.
+# ' '. time2str('%D', $_->sdate). '-'. time2str('%D', $_->edate).
+# "\n";
+# }
+#
+# next;
+
+ my $remaining = $amount;
+ foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
+ last unless $remaining;
+ my $this_amount =sprintf('%.2f',
+ $remaining <= $cust_bill_pkg->exemptable_per_month
+ ? $remaining
+ : $cust_bill_pkg->exemptable_per_month
+ );;
+
+ push @cust_tax_exempt_pkg, new FS::cust_tax_exempt_pkg {
+ 'billpkgnum' => $cust_bill_pkg->billpkgnum,
+ 'taxnum' => $cust_tax_exempt->taxnum,
+ 'year' => $cust_tax_exempt->year,
+ 'month' => $cust_tax_exempt->month,
+ 'amount' => $this_amount,
+ };
+
+ $remaining -= $this_amount;
+
+ }
+
+ }
+
+ foreach my $cust_tax_exempt_pkg ( @cust_tax_exempt_pkg ) {
+ my $error = $cust_tax_exempt_pkg->insert;
+ #my $error = $cust_tax_exempt_pkg->check;
+ if ( $error ) {
+ warn "*** error inserting cust_tax_exempt_pkg record: $error\n";
+ next; #not necessary.. H_CUST_TAX_EXEMPT;
+
+ #not necessary, incorrect $total_cust_tax_exempt_pkg will error it out
+ # roll back at least the entire cust_tax_exempt transaction
+ # next CUST_TAX_EXEMPT;
+ }
+
+ $num_cust_tax_exempt_pkg++;
+
+ $total_cust_tax_exempt_pkg += $cust_tax_exempt_pkg->amount;
+
+ }
+
+ }
+
+ $total_cust_tax_exempt_pkg = sprintf('%.2f', $total_cust_tax_exempt_pkg );
+
+ unless ( $total_cust_tax_exempt_pkg == $cust_tax_exempt->amount ) {
+ warn "total h_ amount $total_cust_tax_exempt_pkg != cust_tax_exempt.amount ".
+ $cust_tax_exempt->amount.
+ ";\n not migrating exemption ". $cust_tax_exempt->exemptnum. " for ".
+ $cust_tax_exempt->month. '/'. $cust_tax_exempt->year.
+ ' (custnum '. $cust_tax_exempt->custnum. ") ".
+ #"\n (sdate < ". time2str('%D', $sdate_before ).
+ "\n (sdate <= ". time2str('%D', $sdate_before ). " [$sdate_before]".
+ #' / edate > '. time2str('%D', $edate_after ). ')'.
+ ' / edate >= '. time2str('%D', $edate_after ). " [$edate_after])".
+ "\n\n";
+
+ # roll back at least the entire cust_tax_exempt transaction
+ dbh->rollback;
+
+ # next CUST_TAX_EXEMPT;
+ next;
+ }
+
+ # remove the cust_tax_exempt record
+ my $error = $cust_tax_exempt->delete;
+ if ( $error ) {
+ #roll back at least the entire cust_tax_exempt transaction
+ dbh->rollback;
+
+ #next CUST_TAX_EXEMPT;
+ next;
+ }
+
+ $num_cust_tax_exempt_migrated++;
+ $total_cust_tax_exempt_migrated += $cust_tax_exempt->amount;
+
+ $num_cust_tax_exempt_pkg_migrated += $num_cust_tax_exempt_pkg;
+ $total_cust_tax_exempt_pkg_migrated += $total_cust_tax_exempt_pkg;
+
+ # commit the transaction
+ dbh->commit;
+
+}
+
+$total_cust_tax_exempt_migrated =
+ sprintf('%.2f', $total_cust_tax_exempt_migrated );
+$total_cust_tax_exempt_pkg_migrated =
+ sprintf('%.2f', $total_cust_tax_exempt_pkg_migrated );
+
+warn
+ "$num_cust_tax_exempt_migrated / $num_cust_tax_exempt (".
+ sprintf('%.2f', 100 * $num_cust_tax_exempt_migrated / $num_cust_tax_exempt).
+ '%) cust_tax_exempt records migrated ($'. $total_cust_tax_exempt_migrated.
+ ")\n to $num_cust_tax_exempt_pkg_migrated cust_tax_exempt_pkg records".
+ ' ($'. $total_cust_tax_exempt_pkg_migrated. ')'.
+ "\n in ". duration(time-$start). "\n"
+;
+
diff --git a/bin/fs-migrate-part_svc b/bin/fs-migrate-part_svc
new file mode 100755
index 000000000..b0f3ac57e
--- /dev/null
+++ b/bin/fs-migrate-part_svc
@@ -0,0 +1,41 @@
+#!/usr/bin/perl
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch fields);
+use FS::part_svc;
+
+my $user = shift or die &usage;
+my $dbh = adminsuidsetup $user;
+
+my $oldAutoCommit = $FS::UID::AutoCommit;
+local $FS::UID::AutoCommit = 0;
+
+foreach my $part_svc ( qsearch('part_svc', {} ) ) {
+ foreach my $field (
+ grep { defined($part_svc->getfield($part_svc->svcdb.'__'.$_.'_flag') ) }
+ fields($part_svc->svcdb)
+ ) {
+ my $flag = $part_svc->getfield($part_svc->svcdb.'__'.$field.'_flag');
+ if ( uc($flag) =~ /^([DF])$/ ) {
+ my $part_svc_column = new FS::part_svc_column {
+ 'svcpart' => $part_svc->svcpart,
+ 'columnname' => $field,
+ 'columnflag' => $1,
+ 'columnvalue' => $part_svc->getfield($part_svc->svcdb.'__'.$field),
+ };
+ my $error = $part_svc_column->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ die $error;
+ }
+ }
+ }
+}
+
+$dbh->commit or die $dbh->errstr;
+
+sub usage {
+ die "Usage:\n fs-migrate-part_svc user\n";
+}
+
diff --git a/bin/fs-migrate-payref b/bin/fs-migrate-payref
new file mode 100755
index 000000000..158419706
--- /dev/null
+++ b/bin/fs-migrate-payref
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch);
+use FS::cust_pay;
+use FS::cust_refund;
+
+my $user = shift or die &usage;
+my $dbh = adminsuidsetup $user;
+
+# apply payments to invoices
+
+foreach my $cust_pay ( qsearch('cust_pay', {} ) ) {
+ my $error = $cust_pay->upgrade_replace;
+ warn $error if $error;
+}
+
+# apply refunds to credits
+
+foreach my $cust_refund ( qsearch('cust_refund') ) {
+ my $error = $cust_refund->upgrade_replace;
+ warn $error if $error;
+}
+
+# ? apply credits to invoices
+
+sub usage {
+ die "Usage:\n fs-migrate-payref user\n";
+}
+
diff --git a/bin/fs-migrate-svc_acct_sm b/bin/fs-migrate-svc_acct_sm
new file mode 100755
index 000000000..07f7b611c
--- /dev/null
+++ b/bin/fs-migrate-svc_acct_sm
@@ -0,0 +1,227 @@
+#!/usr/bin/perl -Tw
+#
+# jeff@cmh.net 01-Jul-20
+
+#to delay loading dbdef until we're ready
+#BEGIN { $FS::Record::setup_hack = 1; }
+
+use strict;
+use Term::Query qw(query);
+#use DBI;
+#use DBIx::DBSchema;
+#use DBIx::DBSchema::Table;
+#use DBIx::DBSchema::Column;
+#use DBIx::DBSchema::ColGroup::Unique;
+#use DBIx::DBSchema::ColGroup::Index;
+use FS::Conf;
+use FS::UID qw(adminsuidsetup datasrc checkeuid getsecrets);
+use FS::Record qw(qsearch qsearchs);
+use FS::svc_domain;
+use FS::svc_forward;
+use vars qw( $conf $old_default_domain %part_domain_svc %part_acct_svc %part_forward_svc $svc_acct $svc_acct_sm $error);
+
+die "Not running uid freeside!" unless checkeuid();
+
+my $user = shift or die &usage;
+getsecrets($user);
+
+$conf = new FS::Conf;
+$old_default_domain = $conf->config('domain');
+
+#needs to match FS::Record
+#my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc;
+
+###
+# This section would be the appropriate place to manipulate
+# the schema & tables.
+###
+
+## we need to add the domsvc to svc_acct
+## we must add a svc_forward record....
+## I am thinking that the fields svcnum (int), destsvc (int), and
+## dest (varchar (80)) are appropriate, with destsvc/dest an either/or
+## much in the spirit of cust_main_invoice
+
+###
+# massage the data
+###
+
+my($dbh)=adminsuidsetup $user;
+
+$|=1;
+
+$FS::svc_Common::noexport_hack = 1;
+$FS::svc_domain::whois_hack = 1;
+
+%part_domain_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_domain'});
+%part_acct_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
+%part_forward_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_forward'});
+
+die "No services with svcdb svc_domain!\n" unless %part_domain_svc;
+die "No services with svcdb svc_acct!\n" unless %part_acct_svc;
+die "No services with svcdb svc_forward!\n" unless %part_forward_svc;
+
+my($svc_domain) = qsearchs('svc_domain', { 'domain' => $old_default_domain });
+if (! $svc_domain || $svc_domain->domain != $old_default_domain) {
+ print <<EOF;
+
+Your database currently does not contain a svc_domain record for the
+domain $old_default_domain. Would you like me to add one for you?
+EOF
+
+ my($response)=scalar(<STDIN>);
+ chop $response;
+ if ($response =~ /^[yY]/) {
+ print "\n\n", &menu_domain_svc, "\n", <<END;
+I need to create new domain accounts. Which service shall I use for that?
+END
+ my($domain_svcpart)=&getdomainpart;
+
+ $svc_domain = new FS::svc_domain {
+ 'domain' => $old_default_domain,
+ 'svcpart' => $domain_svcpart,
+ 'action' => 'M',
+ };
+# $error=$svc_domain->insert && die "Error adding domain $old_default_domain: $error";
+ $error=$svc_domain->insert;
+ die "Error adding domain $old_default_domain: $error" if $error;
+ }else{
+ print <<EOF;
+
+ This program cannot function properly until a svc_domain record matching
+your conf_dir/domain file exists.
+EOF
+
+ exit 1;
+ }
+}
+
+print "\n\n", &menu_acct_svc, "\n", <<END;
+I may need to create some new pop accounts and set up forwarding to them
+for some users. Which service shall I use for that?
+END
+my($pop_svcpart)=&getacctpart;
+
+print "\n\n", &menu_forward_svc, "\n", <<END;
+I may need to create some new forwarding for some users. Which service
+shall I use for that?
+END
+my($forward_svcpart)=&getforwardpart;
+
+sub menu_domain_svc {
+ ( join "\n", map "$_: ".$part_domain_svc{$_}->svc, sort keys %part_domain_svc ). "\n";
+}
+sub menu_acct_svc {
+ ( join "\n", map "$_: ".$part_acct_svc{$_}->svc, sort keys %part_acct_svc ). "\n";
+}
+sub menu_forward_svc {
+ ( join "\n", map "$_: ".$part_forward_svc{$_}->svc, sort keys %part_forward_svc ). "\n";
+}
+sub getdomainpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_domain_svc ];
+ $^W=1;
+ $return;
+}
+sub getacctpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_acct_svc ];
+ $^W=1;
+ $return;
+}
+sub getforwardpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_forward_svc ];
+ $^W=1;
+ $return;
+}
+
+
+#migrate data
+
+my(@svc_accts) = qsearch('svc_acct', {});
+foreach $svc_acct (@svc_accts) {
+ my(@svc_acct_sms) = qsearch('svc_acct_sm', {
+ domuid => $svc_acct->getfield('uid'),
+ }
+ );
+
+ # Ok.. we've got the svc_acct record, and an array of svc_acct_sm's
+ # What do we do from here?
+
+ # The intuitive:
+ # plop the svc_acct into the 'default domain'
+ # and then represent the svc_acct_sm's with svc_forwards
+ # they can be gussied up manually, later
+ #
+ # Perhaps better:
+ # when no svc_acct_sm exists, place svc_acct in 'default domain'
+ # when one svc_acct_sm exists, place svc_acct in corresponding
+ # domain & possibly create a svc_forward in 'default domain'
+ # when multiple svc_acct_sm's exists (in different domains) we'd
+ # better use the 'intuitive' approach.
+ #
+ # Specific way:
+ # as 'perhaps better,' but we may be able to guess which domain
+ # is correct by comparing the svcnum of domains to the username
+ # of the svc_acct
+ #
+
+ # The intuitive way:
+
+ my $def_acct = new FS::svc_acct ( { $svc_acct->hash } );
+ $def_acct->setfield('domsvc' => $svc_domain->getfield('svcnum'));
+ $error = $def_acct->replace($svc_acct);
+ die "Error replacing svc_acct for " . $def_acct->username . " : $error" if $error;
+
+ foreach $svc_acct_sm (@svc_acct_sms) {
+
+ my($domrec)=qsearchs('svc_domain', {
+ svcnum => $svc_acct_sm->getfield('domsvc'),
+ }) || die "svc_acct_sm references invalid domsvc $svc_acct_sm->getfield('domsvc')\n";
+
+ if ($svc_acct_sm->getfield('domuser') =~ /^\*$/) {
+
+ my($newdom) = new FS::svc_domain ( { $domrec->hash } );
+ $newdom->setfield('catchall', $svc_acct->svcnum);
+ $newdom->setfield('action', "M");
+ $error = $newdom->replace($domrec);
+ die "Error replacing svc_domain for (anything)@" . $domrec->domain . " : $error" if $error;
+
+ } else {
+
+ my($newacct) = new FS::svc_acct {
+ 'svcpart' => $pop_svcpart,
+ 'username' => $svc_acct_sm->getfield('domuser'),
+ 'domsvc' => $svc_acct_sm->getfield('domsvc'),
+ 'dir' => '/dev/null',
+ };
+ $error = $newacct->insert;
+ die "Error adding svc_acct for " . $newacct->username . " : $error" if $error;
+
+ my($newforward) = new FS::svc_forward {
+ 'svcpart' => $forward_svcpart,
+ 'srcsvc' => $newacct->getfield('svcnum'),
+ 'dstsvc' => $def_acct->getfield('svcnum'),
+ };
+ $error = $newforward->insert;
+ die "Error adding svc_forward for " . $newacct->username ." : $error" if $error;
+ }
+
+ $error = $svc_acct_sm->delete;
+ die "Error deleting svc_acct_sm for " . $svc_acct_sm->domuser ." : $error" if $error;
+
+ };
+
+};
+
+
+$dbh->commit or die $dbh->errstr;
+$dbh->disconnect or die $dbh->errstr;
+
+print "svc_acct_sm records sucessfully migrated\n";
+
+sub usage {
+ die "Usage:\n fs-migrate-svc_acct_sm user\n";
+}
+
diff --git a/bin/fs-radius-add-check b/bin/fs-radius-add-check
new file mode 100755
index 000000000..4e4769e58
--- /dev/null
+++ b/bin/fs-radius-add-check
@@ -0,0 +1,68 @@
+#!/usr/bin/perl -Tw
+
+# quick'n'dirty hack of fs-setup to add radius attributes
+
+use strict;
+use DBI;
+use FS::UID qw(adminsuidsetup checkeuid getsecrets);
+use FS::raddb;
+
+die "Not running uid freeside!" unless checkeuid();
+
+my %attrib2db =
+ map { lc($FS::raddb::attrib{$_}) => $_ } keys %FS::raddb::attrib;
+
+my $user = shift or die &usage;
+getsecrets($user);
+
+my $dbh = adminsuidsetup $user;
+
+###
+
+print "\n\n", <<END, ":";
+Enter the additional RADIUS check attributes you need to track for
+each user, separated by whitespace.
+END
+my @attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; }
+ split(" ",&getvalue);
+
+sub getvalue {
+ my($x)=scalar(<STDIN>);
+ chop $x;
+ $x;
+}
+
+###
+
+my($char_d) = 80; #default maxlength for text fields
+
+###
+
+foreach my $attribute ( @attributes ) {
+
+ my $statement =
+ "ALTER TABLE svc_acct ADD COLUMN rc_$attribute varchar($char_d) NULL";
+ my $sth = $dbh->prepare( $statement )
+ or warn "Error preparing $statement: ". $dbh->errstr;
+ my $rc = $sth->execute
+ or warn "Error executing $statement: ". $sth->errstr;
+
+ $statement =
+ "ALTER TABLE h_svc_acct ADD COLUMN rc_$attribute varchar($char_d) NULL";
+ $sth = $dbh->prepare( $statement )
+ or warn "Error preparing $statement: ". $dbh->errstr;
+ $rc = $sth->execute
+ or warn "Error executing $statement: ". $sth->errstr;
+
+}
+
+$dbh->commit or die $dbh->errstr;
+
+$dbh->disconnect or die $dbh->errstr;
+
+print "\n\n", "Now you must run dbdef-create.\n\n";
+
+sub usage {
+ die "Usage:\n fs-radius-add-check user\n";
+}
+
diff --git a/bin/fs-radius-add-reply b/bin/fs-radius-add-reply
new file mode 100755
index 000000000..3de01374f
--- /dev/null
+++ b/bin/fs-radius-add-reply
@@ -0,0 +1,69 @@
+#!/usr/bin/perl -Tw
+
+# quick'n'dirty hack of fs-setup to add radius attributes
+
+use strict;
+use DBI;
+use FS::UID qw(adminsuidsetup checkeuid getsecrets);
+use FS::raddb;
+
+die "Not running uid freeside!" unless checkeuid();
+
+my %attrib2db =
+ map { lc($FS::raddb::attrib{$_}) => $_ } keys %FS::raddb::attrib;
+
+my $user = shift or die &usage;
+getsecrets($user);
+
+my $dbh = adminsuidsetup $user;
+
+###
+
+print "\n\n", <<END, ":";
+Enter the additional RADIUS reply attributes you need to track for
+each user, separated by whitespace.
+END
+my @attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; }
+ split(" ",&getvalue);
+
+sub getvalue {
+ my($x)=scalar(<STDIN>);
+ chop $x;
+ $x;
+}
+
+###
+
+my($char_d) = 80; #default maxlength for text fields
+
+###
+
+foreach my $attribute ( @attributes ) {
+
+ my $statement =
+ "ALTER TABLE svc_acct ADD COLUMN radius_$attribute varchar($char_d) NULL";
+ my $sth = $dbh->prepare( $statement )
+ or warn "Error preparing $statement: ". $dbh->errstr;
+ my $rc = $sth->execute
+ or warn "Error executing $statement: ". $sth->errstr;
+
+ $statement =
+ "ALTER TABLE h_svc_acct ADD COLUMN radius_$attribute varchar($char_d) NULL";
+ $sth = $dbh->prepare( $statement )
+ or warn "Error preparing $statement: ". $dbh->errstr;
+ $rc = $sth->execute
+ or warn "Error executing $statement: ". $sth->errstr;
+
+}
+
+$dbh->commit or die $dbh->errstr;
+
+$dbh->disconnect or die $dbh->errstr;
+
+print "\n\n", "Now you must run dbdef-create.\n\n";
+
+sub usage {
+ die "Usage:\n fs-radius-add-reply user\n";
+}
+
+
diff --git a/bin/fs-setup b/bin/fs-setup
deleted file mode 100755
index 45332d85c..000000000
--- a/bin/fs-setup
+++ /dev/null
@@ -1,542 +0,0 @@
-#!/usr/bin/perl -Tw
-#
-# create database and necessary tables, etc. DBI version.
-#
-# ivan@sisd.com 97-nov-8,9
-#
-# agent_type and type_pkgs added.
-# (index need to be declared, & primary keys shoudln't have mysql syntax)
-# ivan@sisd.com 97-nov-13
-#
-# pulled modified version back out of register.cgi ivan@sisd.com 98-feb-21
-#
-# removed extraneous sample data ivan@sisd.com 98-mar-23
-#
-# gained the big hash from dbdef.pm, dbdef.pm usage rewrite ivan@sisd.com
-# 98-apr-19 - 98-may-11 plus
-#
-# finished up ivan@sisd.com 98-jun-1
-#
-# part_svc fields are all forced NULL, not the opposite
-# hmm: also are forced varchar($char_d) as fixed '0' for things like
-# uid is Not Good. will this break anything else?
-# ivan@sisd.com 98-jun-29
-#
-# ss is 11 chars ivan@sisd.com 98-jul-20
-#
-# setup of arbitrary radius fields ivan@sisd.com 98-aug-9
-#
-# ouch, removed index on company name that wasn't supposed to be there
-# ivan@sisd.com 98-sep-4
-#
-# fix radius attributes ivan@sisd.com 98-sep-27
-
-#to delay loading dbdef until we're ready
-BEGIN { $FS::Record::setup_hack = 1; }
-
-use strict;
-use DBI;
-use FS::dbdef;
-use FS::UID qw(adminsuidsetup datasrc);
-use FS::Record;
-use FS::cust_main_county;
-
-#needs to match FS::Record
-my($dbdef_file) = "/var/spool/freeside/dbdef.". datasrc;
-
-###
-
-print "\nEnter the maximum username length: ";
-my($username_len)=&getvalue;
-
-print "\n\n", <<END, ":";
-Freeside tracks the RADIUS attributes User-Name, Password and Framed-IP-Address
-for each user. Enter any additional RADIUS attributes you need to track for
-each user, separated by whitespace.
-END
-my @attributes = map { s/\-/_/g; $_; } split(" ",&getvalue);
-
-sub getvalue {
- my($x)=scalar(<STDIN>);
- chop $x;
- $x;
-}
-
-###
-
-my($char_d) = 80; #default maxlength for text fields
-
-#my(@date_type) = ( 'timestamp', '', '' );
-my(@date_type) = ( 'int', 'NULL', '' );
-my(@perl_type) = ( 'long varchar', 'NULL', '' );
-my(@money_type);
-if (datasrc =~ m/Pg/) { #Pg can't do decimal(10,2)
- @money_type = ( 'money', '', '' );
-} else {
- @money_type = ( 'decimal', '', '10,2' );
-}
-
-###
-# create a dbdef object from the old data structure
-###
-
-my(%tables)=&tables_hash_hack;
-
-#turn it into objects
-my($dbdef) = new FS::dbdef ( map {
- my(@columns);
- while (@{$tables{$_}{'columns'}}) {
- my($name,$type,$null,$length)=splice @{$tables{$_}{'columns'}}, 0, 4;
- push @columns, new FS::dbdef_column ( $name,$type,$null,$length );
- }
- FS::dbdef_table->new(
- $_,
- $tables{$_}{'primary_key'},
- #FS::dbdef_unique->new(@{$tables{$_}{'unique'}}),
- #FS::dbdef_index->new(@{$tables{$_}{'index'}}),
- FS::dbdef_unique->new($tables{$_}{'unique'}),
- FS::dbdef_index->new($tables{$_}{'index'}),
- @columns,
- );
-} (keys %tables) );
-
-#add radius attributes to svc_acct
-
-my($svc_acct)=$dbdef->table('svc_acct');
-
-my($attribute);
-foreach $attribute (@attributes) {
- $svc_acct->addcolumn ( new FS::dbdef_column (
- 'radius_'. $attribute,
- 'varchar',
- 'NULL',
- $char_d,
- ));
-}
-
-#make part_svc table (but now as object)
-
-my($part_svc)=$dbdef->table('part_svc');
-
-#because of svc_acct_pop
-#foreach (grep /^svc_/, $dbdef->tables) {
-#foreach (qw(svc_acct svc_acct_sm svc_charge svc_domain svc_wo)) {
-foreach (qw(svc_acct svc_acct_sm svc_domain)) {
- my($table)=$dbdef->table($_);
- my($col);
- foreach $col ( $table->columns ) {
- next if $col =~ /^svcnum$/;
- $part_svc->addcolumn( new FS::dbdef_column (
- $table->name. '__' . $table->column($col)->name,
- 'varchar', #$table->column($col)->type,
- 'NULL',
- $char_d, #$table->column($col)->length,
- ));
- $part_svc->addcolumn ( new FS::dbdef_column (
- $table->name. '__'. $table->column($col)->name . "_flag",
- 'char',
- 'NULL',
- 1,
- ));
- }
-}
-
-#important
-$dbdef->save($dbdef_file);
-FS::Record::reload_dbdef;
-
-###
-# create 'em
-###
-
-my($dbh)=adminsuidsetup;
-
-#create tables
-$|=1;
-
-my($table);
-foreach ($dbdef->tables) {
- my($table)=$dbdef->table($_);
- print "Creating $_...";
-
- my($statement);
-
- #create table
- foreach $statement ($table->sql_create_table(datasrc)) {
- #print $statement, "\n";
- $dbh->do( $statement )
- or die "CREATE error: ",$dbh->errstr, "\ndoing statement: $statement";
- }
-
- print "\n";
-}
-
-#not really sample data (and shouldn't default to US)
-
-#cust_main_county
-foreach ( qw(
-AL AK AS AZ AR CA CO CT DC DE FM FL GA GU HI ID IL IN IA KS KY LA
-ME MH MD MA MI MN MS MO MT NC ND NE NH NJ NM NV NY MP OH OK OR PA PW PR RI
-SC SD TN TX TT UT VT VI VA WA WV WI WY AE AA AP
-) ) {
- my($cust_main_county)=create FS::cust_main_county({
- 'state' => $_,
- 'tax' => 0,
- });
- my($error);
- $error=$cust_main_county->insert;
- die $error if $error;
-}
-
-$dbh->disconnect or die $dbh->errstr;
-
-###
-# Now it becomes an object. much better.
-###
-sub tables_hash_hack {
-
- #note that s/(date|change)/_$1/; to avoid keyword conflict.
- #put a kludge in FS::Record to catch this or? (pry need some date-handling
- #stuff anyway also)
-
- my(%tables)=( #yech.}
-
- 'agent' => {
- 'columns' => [
- 'agentnum', 'int', '', '',
- 'agent', 'varchar', '', $char_d,
- 'typenum', 'int', '', '',
- 'freq', 'smallint', 'NULL', '',
- 'prog', @perl_type,
- ],
- 'primary_key' => 'agentnum',
- 'unique' => [ [] ],
- 'index' => [ ['typenum'] ],
- },
-
- 'agent_type' => {
- 'columns' => [
- 'typenum', 'int', '', '',
- 'atype', 'varchar', '', $char_d,
- ],
- 'primary_key' => 'typenum',
- 'unique' => [ [] ],
- 'index' => [ [] ],
- },
-
- 'type_pkgs' => {
- 'columns' => [
- 'typenum', 'int', '', '',
- 'pkgpart', 'int', '', '',
- ],
- 'primary_key' => '',
- 'unique' => [ ['typenum', 'pkgpart'] ],
- 'index' => [ ['typenum'] ],
- },
-
- 'cust_bill' => {
- 'columns' => [
- 'invnum', 'int', '', '',
- 'custnum', 'int', '', '',
- '_date', @date_type,
- 'charged', @money_type,
- 'owed', @money_type,
- 'printed', 'int', '', '',
- ],
- 'primary_key' => 'invnum',
- 'unique' => [ [] ],
- 'index' => [ ['custnum'] ],
- },
-
- 'cust_bill_pkg' => {
- 'columns' => [
- 'pkgnum', 'int', '', '',
- 'invnum', 'int', '', '',
- 'setup', @money_type,
- 'recur', @money_type,
- 'sdate', @date_type,
- 'edate', @date_type,
- ],
- 'primary_key' => '',
- 'unique' => [ ['pkgnum', 'invnum'] ],
- 'index' => [ ['invnum'] ],
- },
-
- 'cust_credit' => {
- 'columns' => [
- 'crednum', 'int', '', '',
- 'custnum', 'int', '', '',
- '_date', @date_type,
- 'amount', @money_type,
- 'credited', @money_type,
- 'otaker', 'varchar', '', 8,
- 'reason', 'varchar', '', 255,
- ],
- 'primary_key' => 'crednum',
- 'unique' => [ [] ],
- 'index' => [ ['custnum'] ],
- },
-
- 'cust_main' => {
- 'columns' => [
- 'custnum', 'int', '', '',
- 'agentnum', 'int', '', '',
- 'last', 'varchar', '', $char_d,
- 'first', 'varchar', '', $char_d,
- 'ss', 'char', 'NULL', 11,
- 'company', 'varchar', 'NULL', $char_d,
- 'address1', 'varchar', '', $char_d,
- 'address2', 'varchar', 'NULL', $char_d,
- 'city', 'varchar', '', $char_d,
- 'county', 'varchar', 'NULL', $char_d,
- 'state', 'char', '', 2,
- 'zip', 'varchar', '', 10,
- 'country', 'char', '', 2,
- 'daytime', 'varchar', 'NULL', 20,
- 'night', 'varchar', 'NULL', 20,
- 'fax', 'varchar', 'NULL', 12,
- 'payby', 'char', '', 4,
- 'payinfo', 'varchar', 'NULL', 16,
- 'paydate', @date_type,
- 'payname', 'varchar', 'NULL', $char_d,
- 'tax', 'char', 'NULL', 1,
- 'otaker', 'varchar', '', 8,
- 'refnum', 'int', '', '',
- ],
- 'primary_key' => 'custnum',
- 'unique' => [ [] ],
- #'index' => [ ['last'], ['company'] ],
- 'index' => [ ['last'], ],
- },
-
- 'cust_main_county' => { #county+state are checked off the cust_main_county
- #table for validation and to provide a tax rate.
- #add country?
- 'columns' => [
- 'taxnum', 'int', '', '',
- 'state', 'char', '', 2, #two letters max in US... elsewhere?
- 'county', 'varchar', '', $char_d,
- 'tax', 'real', '', '', #tax %
- ],
- 'primary_key' => 'taxnum',
- 'unique' => [ [] ],
- # 'unique' => [ ['taxnum'], ['state', 'county'] ],
- 'index' => [ [] ],
- },
-
- 'cust_pay' => {
- 'columns' => [
- 'paynum', 'int', '', '',
- 'invnum', 'int', '', '',
- 'paid', @money_type,
- '_date', @date_type,
- 'payby', 'char', '', 4, # CARD/BILL/COMP, should be index into
- # payment type table.
- 'payinfo', 'varchar', 'NULL', 16, #see cust_main above
- 'paybatch', 'varchar', 'NULL', $char_d, #for auditing purposes.
- ],
- 'primary_key' => 'paynum',
- 'unique' => [ [] ],
- 'index' => [ ['invnum'] ],
- },
-
- 'cust_pay_batch' => { #what's this used for again? list of customers
- #in current CARD batch? (necessarily CARD?)
- 'columns' => [
- 'invnum', 'int', '', '',
- 'custnum', 'int', '', '',
- 'last', 'varchar', '', $char_d,
- 'first', 'varchar', '', $char_d,
- 'address1', 'varchar', '', $char_d,
- 'address2', 'varchar', 'NULL', $char_d,
- 'city', 'varchar', '', $char_d,
- 'state', 'char', '', 2,
- 'zip', 'varchar', '', 10,
- 'country', 'char', '', 2,
- 'trancode', 'TINYINT', '', '',
- 'cardnum', 'varchar', '', 16,
- 'exp', @date_type,
- 'payname', 'varchar', 'NULL', $char_d,
- 'amount', @money_type,
- ],
- 'primary_key' => '',
- 'unique' => [ [] ],
- 'index' => [ ['invnum'], ['custnum'] ],
- },
-
- 'cust_pkg' => {
- 'columns' => [
- 'pkgnum', 'int', '', '',
- 'custnum', 'int', '', '',
- 'pkgpart', 'int', '', '',
- 'otaker', 'varchar', '', 8,
- 'setup', @date_type,
- 'bill', @date_type,
- 'susp', @date_type,
- 'cancel', @date_type,
- 'expire', @date_type,
- ],
- 'primary_key' => 'pkgnum',
- 'unique' => [ [] ],
- 'index' => [ ['custnum'] ],
- },
-
- 'cust_refund' => {
- 'columns' => [
- 'refundnum', 'int', '', '',
- 'crednum', 'int', '', '',
- '_date', @date_type,
- 'refund', @money_type,
- 'otaker', 'varchar', '', 8,
- 'reason', 'varchar', '', $char_d,
- 'payby', 'char', '', 4, # CARD/BILL/COMP, should be index
- # into payment type table.
- 'payinfo', 'varchar', 'NULL', 16, #see cust_main above
- ],
- 'primary_key' => 'refundnum',
- 'unique' => [ [] ],
- 'index' => [ ['crednum'] ],
- },
-
- 'cust_svc' => {
- 'columns' => [
- 'svcnum', 'int', '', '',
- 'pkgnum', 'int', '', '',
- 'svcpart', 'int', '', '',
- ],
- 'primary_key' => 'svcnum',
- 'unique' => [ [] ],
- 'index' => [ ['svcnum'], ['pkgnum'], ['svcpart'] ],
- },
-
- 'part_pkg' => {
- 'columns' => [
- 'pkgpart', 'int', '', '',
- 'pkg', 'varchar', '', $char_d,
- 'comment', 'varchar', '', $char_d,
- 'setup', @perl_type,
- 'freq', 'smallint', '', '', #billing frequency (months)
- 'recur', @perl_type,
- ],
- 'primary_key' => 'pkgpart',
- 'unique' => [ [] ],
- 'index' => [ [] ],
- },
-
- 'pkg_svc' => {
- 'columns' => [
- 'pkgpart', 'int', '', '',
- 'svcpart', 'int', '', '',
- 'quantity', 'int', '', '',
- ],
- 'primary_key' => '',
- 'unique' => [ ['pkgpart', 'svcpart'] ],
- 'index' => [ ['pkgpart'] ],
- },
-
- 'part_referral' => {
- 'columns' => [
- 'refnum', 'int', '', '',
- 'referral', 'varchar', '', $char_d,
- ],
- 'primary_key' => 'refnum',
- 'unique' => [ [] ],
- 'index' => [ [] ],
- },
-
- 'part_svc' => {
- 'columns' => [
- 'svcpart', 'int', '', '',
- 'svc', 'varchar', '', $char_d,
- 'svcdb', 'varchar', '', $char_d,
- ],
- 'primary_key' => 'svcpart',
- 'unique' => [ [] ],
- 'index' => [ [] ],
- },
-
- #(this should be renamed to part_pop)
- 'svc_acct_pop' => {
- 'columns' => [
- 'popnum', 'int', '', '',
- 'city', 'varchar', '', $char_d,
- 'state', 'char', '', 2,
- 'ac', 'char', '', 3,
- 'exch', 'char', '', 3,
- #rest o' number?
- ],
- 'primary_key' => 'popnum',
- 'unique' => [ [] ],
- 'index' => [ [] ],
- },
-
- 'svc_acct' => {
- 'columns' => [
- 'svcnum', 'int', '', '',
- 'username', 'varchar', '', $username_len, #unique (& remove dup code)
- '_password', 'varchar', '', 25, #13 for encryped pw's plus ' *SUSPENDED*
- 'popnum', 'int', 'NULL', '',
- 'uid', 'bigint', 'NULL', '',
- 'gid', 'bigint', 'NULL', '',
- 'finger', 'varchar', 'NULL', $char_d,
- 'dir', 'varchar', 'NULL', $char_d,
- 'shell', 'varchar', 'NULL', $char_d,
- 'quota', 'varchar', 'NULL', $char_d,
- 'slipip', 'varchar', 'NULL', 15, #four TINYINTs, bah.
- ],
- 'primary_key' => 'svcnum',
- 'unique' => [ [] ],
- 'index' => [ ['username'] ],
- },
-
- 'svc_acct_sm' => {
- 'columns' => [
- 'svcnum', 'int', '', '',
- 'domsvc', 'int', '', '',
- 'domuid', 'bigint', '', '',
- 'domuser', 'varchar', '', $char_d,
- ],
- 'primary_key' => 'svcnum',
- 'unique' => [ [] ],
- 'index' => [ ['domsvc'], ['domuid'] ],
- },
-
- #'svc_charge' => {
- # 'columns' => [
- # 'svcnum', 'int', '', '',
- # 'amount', @money_type,
- # ],
- # 'primary_key' => 'svcnum',
- # 'unique' => [ [] ],
- # 'index' => [ [] ],
- #},
-
- 'svc_domain' => {
- 'columns' => [
- 'svcnum', 'int', '', '',
- 'domain', 'varchar', '', $char_d,
- ],
- 'primary_key' => 'svcnum',
- 'unique' => [ ['domain'] ],
- 'index' => [ [] ],
- },
-
- #'svc_wo' => {
- # 'columns' => [
- # 'svcnum', 'int', '', '',
- # 'svcnum', 'int', '', '',
- # 'svcnum', 'int', '', '',
- # 'worker', 'varchar', '', $char_d,
- # '_date', @date_type,
- # ],
- # 'primary_key' => 'svcnum',
- # 'unique' => [ [] ],
- # 'index' => [ [] ],
- #},
-
- );
-
- %tables;
-
-}
-
diff --git a/bin/generate-prepay b/bin/generate-prepay
new file mode 100755
index 000000000..cb4ba7fc6
--- /dev/null
+++ b/bin/generate-prepay
@@ -0,0 +1,35 @@
+#!/usr/bin/perl -w
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::prepay_credit;
+
+require 5.004; #srand(time|$$);
+
+my $user = shift or die &usage;
+&adminsuidsetup( $user );
+
+my $amount = shift or die &usage;
+
+my $seconds = shift or die &usage;
+
+my $num_digits = shift or die &usage;
+
+my $num_entries = shift or die &usage;
+
+for ( 1 .. $num_entries ) {
+ my $identifier = join( '', map int(rand(10)), ( 1 .. $num_digits ) );
+ my $prepay_credit = new FS::prepay_credit {
+ 'identifier' => $identifier,
+ 'amount' => $amount,
+ 'seconds' => $seconds,
+ };
+ my $error = $prepay_credit->insert;
+ die $error if $error;
+ print "$identifier\n";
+}
+
+sub usage {
+ die "Usage:\n\n generate-prepay user amount seconds num_digits num_entries";
+}
+
diff --git a/bin/generate-raddb b/bin/generate-raddb
new file mode 100755
index 000000000..af21c05a8
--- /dev/null
+++ b/bin/generate-raddb
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+
+# usage: generate-raddb radius-server/raddb/dictionary* >raddb.pm
+# i.e.: generate-raddb ~/freeradius/freeradius-1.0.5/share/dictionary* ~/wirelessoceans/dictionary.ip3networks ~/wtxs/dictionary.mot.canopy >raddb.pm.new
+print <<END;
+package FS::raddb;
+use vars qw(%attrib);
+
+%attrib = (
+END
+
+while (<>) {
+ next if /^(#|\s*$|\$INCLUDE\s+)/;
+ next if /^(VALUE|VENDOR|BEGIN\-VENDOR|END\-VENDOR)\s+/;
+ /^(ATTRIBUTE|ATTRIB_NMC)\s+([\w\-\/]+)\s+/ or die $_;
+ $attrib = $2;
+ $dbname = lc($2);
+ $dbname =~ s/[\-\/]/_/g;
+ $dbname = substr($dbname,0,24);
+ while ( exists $hash{$dbname} ) {
+ #warn $dbname;
+ $dbname =~ s/(.)$//;
+ my $w = $1;
+ $w =~ tr/_a-z0-9/a-z0-9_/;
+ $dbname = "$dbname$w";
+ }
+ $hash{$dbname} = $attrib;
+ #print "$2\n";
+}
+
+foreach ( sort keys %hash ) {
+# print "$_\n" if length($_)>24;
+# print substr($_,0,24),"\n" if length($_)>24;
+# $max = length($_) if length($_)>$max;
+# have to fudge things since everything >24 is *not* unique
+
+ #print " '". substr($_,0,24). "' => '$hash{$_}',\n";
+ print " '$_' ". ( " " x (24-length($_) ) ). "=> '$hash{$_}',\n";
+}
+
+print <<END;
+
+ #NETC.NET.AU (RADIATOR?)
+ 'authentication_type' => 'Authentication-Type',
+
+ #wtxs (dunno)
+ #'radius_operator' => 'Radius-Operator',
+
+);
+
+1;
+END
+
diff --git a/bin/generate-table-module b/bin/generate-table-module
new file mode 100755
index 000000000..509feeded
--- /dev/null
+++ b/bin/generate-table-module
@@ -0,0 +1,92 @@
+#!/usr/bin/perl
+
+use FS::Schema qw( dbdef_dist );
+
+my $table = shift;
+
+###
+# add a new FS/FS/table.pm
+###
+
+my %ut = ( #just guesses
+ 'int' => 'number',
+ 'number' => 'float',
+ 'varchar' => 'text',
+ 'text' => 'text',
+ 'serial' => 'number',
+);
+
+my $dbdef_table = dbdef_dist->table($table)
+ or die "define table in Schema.pm first";
+my $primary_key = $dbdef_table->primary_key;
+
+open(SRC,"<eg/table_template.pm") or die $!;
+-e "FS/FS/$table.pm" and die "FS/FS/$table.pm already exists!";
+open(DEST,">FS/FS/$table.pm") or die $!;
+
+while (my $line = <SRC>) {
+
+ $line =~ s/table_name/$table/g;
+
+ if ( $line =~ /^=item\s+field\s+-\s+description\s*$/ ) {
+
+ foreach my $column ( $dbdef_table->columns ) {
+ print DEST "=item $column\n\n";
+ if ( $column eq $primary_key ) {
+ print DEST "primary key\n\n";
+ } else {
+ print DEST "$column\n\n";
+ }
+ }
+ next;
+
+ } elsif ( $line=~ /^(\s*)\$self->ut_numbern\('primary_key'\)\s*/ ) {
+
+ print DEST "$1\$self->ut_numbern('$primary_key')\n"
+ if $primary_key;
+ next;
+
+ } elsif (
+ $line =~ /^(\s*)\|\|\s+\$self->ut_number\('validate_other_fields'\)\s*/
+ ) {
+
+ foreach my $column ( grep { $_ ne $primary_key } $dbdef_table->columns ) {
+ my $ut = $ut{$dbdef_table->column($column)->type};
+ $ut .= 'n' if $dbdef_table->column($column)->null;
+ print DEST "$1|| \$self->ut_$ut('$column')\n";
+ }
+ next;
+
+ }
+
+ print DEST $line;
+}
+
+close SRC;
+close DEST;
+
+###
+# add FS/t/table.t
+###
+
+open(TEST,">FS/t/$table.t") or die $!;
+print TEST <<ENDTEST;
+BEGIN { \$| = 1; print "1..1\\n" }
+END {print "not ok 1\\n" unless \$loaded;}
+use FS::$table;
+\$loaded=1;
+print "ok 1\\n";
+ENDTEST
+close TEST;
+
+###
+# add them to MANIFEST
+###
+
+system('cvs edit FS/MANIFEST');
+
+open(MANIFEST,">>FS/MANIFEST") or die $!;
+print MANIFEST "FS/$table.pm\n",
+ "t/$table.t\n";
+close MANIFEST;
+
diff --git a/bin/generate-tests b/bin/generate-tests
new file mode 100755
index 000000000..73fd29ecb
--- /dev/null
+++ b/bin/generate-tests
@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+@files = glob('FS/*.pm');
+foreach (@files) {
+# warn $_;
+ chomp;
+ s/^FS\///;
+ $f=$_;
+ $f=~s/pm$/t/;
+ $m=$_;
+ $m=~s/\.pm$//;
+ open(TEST,">t/$f");
+ print "t/$f\n";
+ print TEST
+ 'BEGIN { $| = 1; print "1..1\n" }'. "\n".
+ 'END {print "not ok 1\n" unless $loaded;}'. "\n".
+ "use FS::$m;\n".
+ '$loaded=1;'. "\n".
+ 'print "ok 1\n";'. "\n"
+ ;
+ close TEST;
+}
diff --git a/bin/import-county-tax-rates b/bin/import-county-tax-rates
new file mode 100755
index 000000000..05798c9a2
--- /dev/null
+++ b/bin/import-county-tax-rates
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+#
+# import-county-tax-rates username state country <filename.csv
+# example: import-county-tax-rates ivan CA US <taxes.csv
+#
+# rates.csv: taxrate,county
+
+use FS::UID qw(adminsuidsetup);
+use FS::cust_main_county;
+
+my $user = shift;
+adminsuidsetup $user;
+
+my($state, $country) = (shift, shift);
+
+while (<>) {
+ my($tax, $county) = split(','); #half-ass CSV parser
+
+ my $cust_main_county = new FS::cust_main_county {
+ 'county' => $county,
+ 'state' => $state,
+ 'country' => $country,
+ 'tax' => $tax,
+ };
+
+ my $error = $cust_main_county->insert;
+ #my $error = $cust_main_county->check;
+ die $error if $error;
+
+}
diff --git a/bin/import-optigold.pl b/bin/import-optigold.pl
new file mode 100755
index 000000000..d32a2a129
--- /dev/null
+++ b/bin/import-optigold.pl
@@ -0,0 +1,1077 @@
+#!/usr/bin/perl -Tw
+
+use strict;
+use DBI;
+use HTML::TableParser;
+use Date::Parse;
+use Text::CSV_XS;
+use FS::Record qw(qsearch qsearchs);
+use FS::cust_credit;
+use FS::cust_main;
+use FS::cust_pkg;
+use FS::cust_svc;
+use FS::svc_acct;
+use FS::part_referral;
+use FS::part_pkg;
+use FS::UID qw(adminsuidsetup);
+
+my $DEBUG = 0;
+
+my $dry_run = '0';
+
+my $s_dbname = 'DBI:Pg:dbname=optigoldimport';
+my $s_dbuser = 'freeside';
+my $s_dbpass = '';
+my $extension = '.htm';
+
+#my $d_dbuser = 'freeside';
+my $d_dbuser = 'enet';
+#my $d_dbuser = 'ivan';
+#my $d_dbuser = 'freesideimport';
+
+my $radius_file = 'radius.csv';
+my $email_file = 'email.csv';
+
+#my $agentnum = 1;
+my $agentnum = 13;
+my $legacy_domain_svcnum = 1;
+my $legacy_ppp_svcpart = 2;
+my $legacy_email_svcpart = 3;
+#my $legacy_broadband_svcpart = 4;
+#my $legacy_broadband_svcpart = 14;
+#my $previous_credit_reasonnum = 1;
+my $previous_credit_reasonnum = 1220;
+
+
+my $state = ''; #statemachine-ish
+my $sourcefile;
+my $s_dbh;
+my $columncount;
+my $rowcount;
+
+my @args = (
+ {
+ id => 1,
+ hdr => \&header,
+ row => \&row,
+ start => \&start,
+ end => \&end,
+ },
+ );
+
+
+$s_dbh = DBI->connect($s_dbname, $s_dbuser, $s_dbpass,
+ { 'AutoCommit' => 0,
+ 'ChopBlanks' => 1,
+ 'ShowErrorStatement' => 1
+ }
+ );
+
+foreach ( qw ( billcycle cust email product ) ) {
+ $sourcefile = $_;
+
+ print "parsing $sourcefile\n";
+
+ die "bad file name" unless $sourcefile =~ /^\w+$/;
+
+ $columncount = 0;
+ $rowcount = 0;
+
+ my $c_sth = '';
+ if ( $c_sth = $s_dbh->prepare("SELECT COUNT(*) FROM $sourcefile") ) {
+ if ( $c_sth->execute ) {
+ if ( $c_sth->fetchrow_arrayref->[0] ) {
+ warn "already have data in $sourcefile table; skipping";
+ next;
+ }
+ }
+ }
+
+ my $tp = new HTML::TableParser( \@args, { Decode => 1, Trim => 1, Chomp => 1 });
+ $tp->parse_file($sourcefile.$extension) or die "failed";
+ $s_dbh->commit or die $s_dbh->errstr;
+# $s_dbh->disconnect;
+}
+
+
+sub start {
+ warn "start\n" if $DEBUG;
+ my $table_id = shift;
+ die "unexpected state change" unless $state eq '';
+ die "unexpected table" unless $table_id eq '1';
+ $state = 'table';
+}
+
+sub end {
+ warn "end\n" if $DEBUG;
+ my ($tbl_id, $line, $udata) = @_;
+ die "unexpected state change in header" unless $state eq 'rows';
+ die "unexpected table" unless $tbl_id eq '1';
+ $state = '';
+}
+
+sub header {
+ warn "header\n" if $DEBUG;
+ my ($tbl_id, $line, $cols, $udata) = @_;
+ die "unexpected state change in header" unless $state eq 'table';
+ die "unexpected table" unless $tbl_id eq '1';
+ $state = 'rows';
+
+ die "invalid column ". join (', ', grep { !/^[ \w\r]+$/ } @$cols)
+ if scalar(grep { !/^[ \w\r]+$/ } @$cols);
+
+ my $sql = "CREATE TABLE $sourcefile ( ".
+ join(', ', map { s/[ \r]/_/g; "$_ varchar NULL" } @$cols). " )";
+ $s_dbh->do($sql) or die "create table failed: ". $s_dbh->errstr;
+ $columncount = scalar( @$cols );
+}
+
+sub row {
+ warn "row\n" if $DEBUG;
+ my ($tbl_id, $line, $cols, $udata) = @_;
+ die "unexpected state change in row" unless $state eq 'rows';
+ die "unexpected table" unless $tbl_id eq '1';
+
+ die "invalid number of columns: ". join(', ', @$cols)
+ unless (scalar(@$cols) == $columncount);
+
+ my $sql = "INSERT INTO $sourcefile VALUES(".
+ join(', ', map { s/\s*(\S[\S ]*?)\s*$/$1/; $s_dbh->quote($_) } @$cols). ")";
+ $s_dbh->do($sql) or die "insert failed: ". $s_dbh->errstr;
+ $rowcount++;
+ warn "row $rowcount\n" unless ($rowcount % 1000);
+}
+
+## now svc_acct from CSV files
+
+$FS::cust_main::import=1;
+$FS::cust_pkg::disable_agentcheck = 1;
+$FS::cust_svc::ignore_quantity = 1;
+
+my (%master_map) = ();
+my (%referrals) = ();
+my (%custid) = ();
+my (%cancel) = ();
+my (%susp) = ();
+my (%adjo) = ();
+my (%bill) = ();
+my (%cust_pkg_map) = ();
+my (%object_map) = ();
+my (%package_cache) = ();
+my $count = 0;
+
+my $d_dbh = adminsuidsetup $d_dbuser;
+local $FS::UID::AutoCommit = 0;
+
+my @import = ( { 'file' => $radius_file,
+ 'sep_char' => ';',
+ 'fields' => [ qw( garbage1 username garbage2 garbage3 _password ) ],
+ 'fixup' => sub {
+ my $hash = shift;
+ delete $hash->{$_}
+ foreach qw (garbage1 garbage2 garbage3);
+ $hash->{'svcpart'} = $legacy_ppp_svcpart;
+ $hash->{'domsvc'} = $legacy_domain_svcnum;
+ '';
+ },
+ 'mapkey' => 'legacy_ppp',
+ 'skey' => 'username',
+ },
+ { 'file' => $email_file,
+ 'sep_char' => ';',
+ 'fields' => [ qw( username null finger _password status garbage ) ],
+ 'fixup' => sub {
+ my $hash = shift;
+ #return 1
+ # if $object_map{'legacy_ppp'}{$hash->{'username'}};
+ delete $hash->{$_}
+ foreach qw (null status garbage);
+ $hash->{'svcpart'} = $legacy_email_svcpart;
+ $hash->{'domsvc'} = $legacy_domain_svcnum;
+ '';
+ },
+ 'mapkey' => 'legacy_email',
+ 'skey' => 'username',
+ },
+);
+
+while ( @import ) {
+ my $href = shift @import;
+ my $file = $href->{'file'} or die "No file specified";
+ my (@fields) = @{$href->{'fields'}};
+ my ($sep_char) = $href->{'sep_char'} || ';';
+ my ($fixup) = $href->{'fixup'};
+ my ($mapkey) = $href->{'mapkey'};
+ my ($skey) = $href->{'skey'};
+ my $line;
+
+ my $csv = new Text::CSV_XS({'sep_char' => $sep_char});
+ open(FH, $file) or die "cannot open $file: $!";
+ $count = 0;
+
+ while ( defined($line=<FH>) ) {
+ chomp $line;
+
+ $line &= "\177" x length($line); # i hope this isn't really necessary
+ $csv->parse($line)
+ or die "cannot parse: " . $csv->error_input();
+
+ my @values = $csv->fields();
+ my %hash;
+ foreach my $field (@fields) {
+ $hash{$field} = shift @values;
+ }
+
+ if (@values) {
+ warn "skipping malformed line: $line\n";
+ next;
+ }
+
+ my $skip = &{$fixup}(\%hash)
+ if $fixup;
+
+ unless ($skip) {
+ my $svc_acct = new FS::svc_acct { %hash };
+ my $error = $svc_acct->insert;
+ if ($error) {
+ warn $error;
+ next;
+ }
+
+ if ($skey && $mapkey) {
+ my $key = (ref($skey) eq 'CODE') ? &{$skey}($svc_acct) : $hash{$skey};
+ $object_map{$mapkey}{$key} = $svc_acct->svcnum;
+ }
+
+ $count++
+ }
+ }
+ print "Imported $count service records\n";
+
+}
+
+
+
+sub pkg_freq {
+ my ( $href ) = ( shift );
+ my $once;
+ $href->{'one_time_list'} =~ /^\s*(\S[\S ]*?)\s*$/ && ($once = $1);
+ $once
+ ? 0
+ : int(eval "$href->{'months_credit'} + 0");
+# int(eval "$href->{'month_credit'} + 0");
+}
+
+sub account_id {
+ my $href = shift;
+ if ($href->{'slave_account_id'} =~ /^\s*(\S[\S ]*?)\s*$/) {
+ "slave:$1";
+ }else{
+ my $l = $href->{cbilling_cycle_login};
+ $l =~ /^\s*(\S[\S ]*?)\s*$/ && ($l = $1);
+ $l;
+ }
+}
+
+sub b_or {
+ my ( $field, $hash ) = ( shift, shift );
+ $field = 'billing_'. $field
+ if $hash->{'billing_use'} eq 'Billing Address';
+ $hash->{$field};
+}
+
+sub p_or {
+ my ( $field, $hash ) = ( shift, shift );
+ $field = 'billing_'. $field
+ if $hash->{'billing_use'} eq 'Billing Address';
+ my $ac = ( $hash->{$field. '_area_code'}
+ && $hash->{$field. '_area_code'} =~ /^\d{3}$/ )
+ ? $hash->{$field. '_area_code'}. '-'
+ : '903-' # wtf?
+ ;
+ ( $hash->{$field} && $hash->{$field} =~ /^\d{3}-\d{4}$/)
+ ? $ac. $hash->{$field}
+ : '';
+}
+
+sub or_b {
+ my ( $field, $hash ) = ( shift, shift );
+ $hash->{'billing_use'} eq 'Billing Address' ? $hash->{$field} : '';
+}
+
+sub or_p {
+ my ( $field, $hash ) = ( shift, shift );
+ $hash->{'billing_use'} eq 'Billing Address' && $hash->{$field} =~ /^\d{3}-\d{4}$/
+ ? ( $hash->{$field. '_area_code'} =~ /^\d{3}$/
+ ? $hash->{$field. '_area_code'}. '-'
+ : '903-' # wtf?
+ ). $hash->{$field}
+ : '';
+}
+
+my %payby_map = ( '' => 'BILL',
+ 'None' => 'BILL',
+ 'Credit Card' => 'CARD',
+ 'Bank Debit' => 'CHEK',
+ 'Virtual Check' => 'CHEK',
+);
+sub payby {
+ $payby_map{ shift->{billing_type} };
+}
+
+sub payinfo {
+ my $hash = shift;
+ my $payby = payby($hash);
+ my $info;
+ my $cc =
+ $hash->{'credit_card_number_1'}.
+ $hash->{'credit_card_number_2'}.
+ $hash->{'credit_card_number_3'}.
+ $hash->{'credit_card_number_4'};
+ my $bank =
+ $hash->{'bank_account_number'}.
+ '@'.
+ $hash->{'bank_transit_number'};
+ if ($payby eq 'CARD') {
+ $info = $cc;
+ }elsif ($payby eq 'CHEK') {
+ $info = $bank;
+ }elsif ($payby eq 'BILL') {
+ $info = $hash->{'blanket_purchase_order_number'};
+ $bank =~ s/[^\d\@]//g;
+ $cc =~ s/\D//g;
+ if ( $bank =~ /^\d+\@\d{9}/) {
+ $info = $bank;
+ $payby = 'DCHK';
+ }
+ if ( $cc =~ /^\d{13,16}/ ) {
+ $info = $cc;
+ $payby = 'DCRD';
+ }
+ }else{
+ die "unexpected payby";
+ }
+ ($info, $payby);
+}
+
+sub ut_name_fixup {
+ my ($object, $field) = (shift, shift);
+ my $value = $object->getfield($field);
+ $value =~ s/[^\w \,\.\-\']/ /g;
+ $object->setfield($field, $value);
+}
+
+sub ut_text_fixup {
+ my ($object, $field) = (shift, shift);
+ my $value = $object->getfield($field);
+ $value =~ s/[^\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]/ /g;
+ $object->setfield($field, $value);
+}
+
+sub ut_state_fixup {
+ my ($object, $field) = (shift, shift);
+ my $value = $object->getfield($field);
+ $value = 'TX' if $value eq 'TTX';
+ $object->setfield($field, $value);
+}
+
+sub ut_zip_fixup {
+ my ($object, $field) = (shift, shift);
+ my $value = $object->getfield($field);
+ $value =~ s/[^-\d]//g;
+ $object->setfield($field, $value);
+}
+
+my @tables = (
+part_pkg => { 'stable' => 'product',
+#part_pkg => { 'stable' => 'billcycle',
+ 'mapping' =>
+ { 'pkg' => sub { my $href = shift;
+ $href->{'description'}
+ ? $href->{'description'}
+ : $href->{'product_id'};
+ },
+ 'comment' => 'product_id',
+ 'freq' => sub { pkg_freq(shift) },
+ 'recur_fee'=> sub { my $href = shift;
+ my $price = ( pkg_freq($href)
+ ? $href->{'unit_price'}
+ : 0
+ );
+ $price =~ s/[^\d.]//g;
+ $price = 0 unless $price;
+ sprintf("%.2f", $price);
+ },
+ 'setuptax' => sub { my $href = shift;
+ $href->{'taxable'} ? '' : 'Y';
+ },
+ 'recurtax' => sub { my $href = shift;
+ $href->{'taxable'} ? '' : 'Y';
+ },
+ 'plan' => sub { 'flat' },
+ 'disabled' => sub { 'Y' },
+ 'pkg_svc' => sub { my $href = shift;
+ my $result = {};
+ if (pkg_freq($href)){
+ $result->{$legacy_ppp_svcpart} = 1;
+ $result->{$legacy_email_svcpart} =
+ $href->{emails_allowed}
+ if $href->{emails_allowed};
+ }
+ },
+ 'primary_svc'=> sub { pkg_freq(shift)
+ ? $legacy_ppp_svcpart
+ : ''
+ ;
+ },
+ },
+ 'fixup' => sub { my $part_pkg = shift;
+ my $row = shift;
+ unless ($part_pkg->pkg =~ /^\s*(\S[\S ]*?)\s*$/) {
+ warn "no pkg: ". $part_pkg->pkg. " for ". $row->{product_id};
+ return 1;
+ }
+
+ unless ($part_pkg->comment =~ /^\s*(\S[\S ]*?)\s*$/) {
+ warn "no comment: ". $part_pkg->comment. " for ". $row->{product_id};
+ return 1;
+ }
+
+ return 1 if exists($package_cache{$1});
+ $package_cache{$1} = $part_pkg;
+ 1;
+ },
+ 'wrapup' => sub { foreach (keys %package_cache) {
+ my $part_pkg = $package_cache{$_};
+ my $options =
+ { map { my $v = $part_pkg->$_;
+ $part_pkg->$_('');
+ ($_ => $v);
+ }
+ qw (setup_fee recur_fee)
+ };
+ my $error =
+ $part_pkg->insert(options=>$options);
+ die "Error inserting package: $error"
+ if $error;
+ $count++ unless $error;
+ }
+ },
+ },
+part_referral => { 'stable' => 'cust',
+ 'mapping' =>
+ { 'agentnum' => sub { $agentnum },
+ 'referral' => sub { my $r = shift->{'referred_from'};
+ $referrals{$r} = 1;
+ },
+ },
+ 'fixup' => sub { 1 },
+ 'wrapup' => sub { foreach (keys %referrals) {
+ my $part_referral =
+ new FS::part_referral( {
+ 'agentnum' => $agentnum,
+ 'referral' => $referrals{$_},
+ } );
+ my $error = $part_referral->insert;
+ die "Error inserting referral: $error"
+ if $error;
+ $count++ unless $error;
+ $referrals{$_} = $part_referral->refnum;
+ }
+ },
+ },
+#svc_acct => { 'stable' => 'cust',
+# 'mapping' =>
+# { 'username' => 'login',
+# '_password' => 'password',
+# 'svcpart' => sub{ $legacy_ppp_svcpart },
+# 'domsvc' => sub{ $legacy_domain_svcnum },
+# 'status' => 'status',
+# },
+# 'fixup' => sub { my $svc_acct = shift;
+# my $row = shift;
+# my $id = $row->{'master_account'}
+# ? 'slave:'. $row->{'customer_id'}
+# : $row->{'login'};
+# my $status = $svc_acct->status;
+# if ( $status ne 'Current'
+# && $status ne 'On Hold' )
+# {
+# $cancel{$id} =
+# str2time($row->{termination_date});
+# warn "not creating (cancelled) svc_acct for " .
+# $svc_acct->username. "\n";
+# return 1
+# }
+# $susp{$id} = str2time($row->{hold_date})
+# if $status eq 'On Hold';
+# $adjo{$id} = str2time($row->{hold_date})
+# if ( $status eq 'Current' &&
+# $row->{hold_date} );
+# $bill{$id} =
+# str2time($row->{expiration_date});
+# '';
+# },
+# 'skey' => sub { my $svc_acct = shift;
+# my $row = shift;
+# my $id = $row->{'master_account'}
+# ? 'slave:'. $row->{'customer_id'}
+# : $row->{'login'};
+# },
+# },
+cust_main => { 'stable' => 'cust',
+ 'mapping' =>
+ { 'agentnum' => sub { $agentnum },
+ 'agent_custid' => sub { my $id = shift->{'customer_number'};
+ if (exists($custid{$id})) {
+ $custid{$id}++;
+ $id. chr(64 + $custid{$id});
+ }else{
+ $custid{$id} = 0;
+ $id;
+ }
+ },
+ 'last' => sub { b_or('last_name', shift) || ' ' },
+ 'first' => sub { b_or('first_name', shift) || ' ' },
+ 'stateid' => 'drivers_license_number',
+ 'signupdate' => sub { str2time(shift->{'creation_date'}) },
+ 'company' => sub { b_or('company_name', shift) },
+ 'address1' => sub { b_or('address', shift) || ' ' },
+ 'city' => sub { b_or('city', shift) || 'Paris' },
+ 'state' => sub { uc(b_or('state', shift)) || 'TX' },
+ 'zip' => sub { b_or('zip_code', shift) || '75460' },
+ 'country' => sub { 'US' },
+ 'daytime' => sub { p_or('phone', shift) },
+ 'night' => sub { p_or('phone_alternate_1', shift) },
+ 'fax' => sub { p_or('fax', shift) },
+ 'ship_last' => sub { or_b('last_name', shift) },
+ 'ship_first' => sub { or_b('first_name', shift) },
+ 'ship_company' => sub { or_b('company_name', shift) },
+ 'ship_address1'=> sub { or_b('address', shift) },
+ 'ship_city' => sub { or_b('city', shift) },
+ 'ship_state' => sub { uc(or_b('state', shift)) },
+ 'ship_zip' => sub { or_b('zip_code', shift) },
+ 'ship_daytime' => sub { or_p('phone', shift) },
+ 'ship_fax' => sub { or_p('fax', shift) },
+ 'tax' => sub { shift->{taxable} eq '' ? 'Y' : '' },
+ 'refnum' => sub { $referrals{shift->{'referred_from'}}
+ || 1
+ },
+ },
+ 'fixup' => sub { my $cust_main = shift;
+ my $row = shift;
+
+ my ($master_account, $customer_id, $login) =
+ ('', '', '');
+ $row->{'master_account'} =~ /^\s*(\S[\S ]*?)\s*$/
+ && ($master_account = $1);
+ $row->{'customer_id'} =~ /^\s*(\S[\S ]*?)\s*$/
+ && ($customer_id = $1);
+ $row->{'login'} =~ /^\s*(\S[\S ]*?)\s*$/
+ && ($login = $1);
+
+ my ($first, $last, $company) =
+ ('', '', '');
+ $cust_main->first =~ /^\s*(\S[\S ]*?)\s*$/
+ && ($first = $1);
+ $cust_main->last =~ /^\s*(\S[\S ]*?)\s*$/
+ && ($last = $1);
+ $cust_main->company =~ /^\s*(\S[\S ]*?)\s*$/
+ && ($company = $1);
+
+ unless ($first || $last || $company) {
+ warn "bogus entry: ". $row->{'login'};
+ return 1;
+ }
+
+ my $id = $master_account
+ ? 'slave:'. $customer_id
+ : $login;
+ #my $id = $login;
+ my $status = $row->{status};
+
+ my $cancelled = 0;
+ if ( $status ne 'Current'
+ && $status ne 'current'
+ && $status ne 'On Hold' )
+ {
+ $cancelled = 1;
+ $cancel{$login} =
+ str2time($row->{termination_date});
+ }
+ $susp{$id} = str2time($row->{hold_date})
+ if ($status eq 'On Hold' && !$cancelled);
+ $adjo{$id} = str2time($row->{hold_date})
+ if ( $status eq 'Current' && !$cancelled &&
+ $row->{hold_date} );
+ $bill{$id} =
+ str2time($row->{expiration_date})
+ if (!$cancelled);
+
+ my $svcnum =
+ $object_map{legacy_ppp}{$row->{'login'} };
+ unless( $cancelled || $svcnum || $status eq 'Pn Hold' ) {
+ warn "can't find svc_acct for legacy ppp ".
+ $row->{'login'}, "\n";
+ }
+
+ $object_map{svc_acct}{$id} = $svcnum
+ unless $cancelled;
+
+ $master_map{$login} = $master_account
+ if $master_account;
+ return 1 if $master_account;
+ $cust_main->ship_country('US')
+ if $cust_main->has_ship_address;
+ ut_name_fixup($cust_main, 'first');
+ ut_name_fixup($cust_main, 'company');
+ ut_name_fixup($cust_main, 'last');
+
+ my ($info, $payby) = payinfo($row);
+ $cust_main->payby($payby);
+ $cust_main->payinfo($info);
+
+ $cust_main->paycvv(
+ $row->{'credit_card_cvv_number'}
+ )
+ if ($payby eq 'CARD' or $payby eq 'DCRD');
+
+ $cust_main->paydate('20'.
+ $row->{'credit_card_exp_date_2'}. '-'.
+ substr(
+ $row->{'credit_card_exp_date_1'},
+ 0,
+ 2,
+ ).
+ '-01'
+ )
+ if ($payby eq 'CARD' or $payby eq 'DCRD');
+
+ my $payname = '';
+ $payname = $row->{'credit_card_name'}
+ if ($payby eq 'CARD' or $payby eq 'DCRD');
+ $payname = $row->{'bank_name'}
+ if ($payby eq 'CHEK' or $payby eq 'DCHK');
+ $cust_main->payname($payname);
+
+ $cust_main->paytype(
+ $row->{'bank_account_to_debit'}
+ ? 'Personal '.
+ $row->{bank_account_to_debit}
+ : ''
+ )
+ if ($payby eq 'CHEK' or $payby eq 'DCHK');
+
+ $cust_main->payby('BILL')
+ if ($cust_main->payby eq 'CHEK' &&
+ $cust_main->payinfo !~ /^\d+\@\d{9}$/);
+ $cust_main->payby('BILL')
+ if ($cust_main->payby eq 'CARD' &&
+ $cust_main->payinfo =~ /^\s*$/);
+ $cust_main->paydate('2037-12-01')
+ if ($cust_main->payby eq 'BILL');
+ ut_text_fixup($cust_main, 'address1');
+ ut_state_fixup($cust_main, 'state');
+ ut_zip_fixup($cust_main, 'zip');
+
+
+ '';
+ },
+ 'skey' => sub { my $object = shift;
+ my $href = shift;
+ my $balance = sprintf("%.2f",
+ $href->{balance_due});
+ if ($balance < 0) {
+ my $cust_credit = new FS::cust_credit({
+ 'custnum' => $object->custnum,
+ 'amount' => sprintf("%.2f", -$balance),
+ 'reasonnum' => $previous_credit_reasonnum,
+ });
+ my $error = $cust_credit->insert;
+ warn "Error inserting credit for ",
+ $href->{'login'}, " : $error\n"
+ if $error;
+
+ }elsif($balance > 0) {
+ my $error = $object->charge(
+ $balance, "Prior balance",
+ );
+ warn "Error inserting balance charge for ",
+ $href->{'login'}, " : $error\n"
+ if $error;
+
+ }
+ $href->{'login'};
+ },
+ },
+#cust_main => { 'stable' => 'cust',
+# 'mapping' =>
+# { 'referred_by' => sub { my $href = shift;
+# my $u = shift->{'login'};
+# my $cn = $href->{'customer_number'};
+#
+# my $c = qsearch( 'cust_main',
+# { 'custnum' => $cn }
+# ) or die "can't fine customer $cn";
+#
+# my $s = qsearch( 'svc_acct',
+# { 'username' => $u }
+# ) or return '';
+#
+# my $n = $s->cust_svc
+# ->cust_pkg
+# ->cust_main
+# ->custnum;
+#
+# $c->referral_custnum($n);
+# my $error = $c->replace;
+# die "error setting referral: $error"
+# if $error;
+# '';
+# },
+# };
+# 'fixup' => sub { 1 },
+# },
+cust_pkg => { 'stable' => 'billcycle',
+ 'mapping' =>
+ { 'custnum' => sub { my $l = shift->{cbilling_cycle_login};
+ $l =~ /^\s*(\S[\S ]*?)\s*$/ && ($l = $1);
+ my $r = $object_map{'cust_main'}{$l};
+ unless ($r) {
+ my $m = $master_map{$l};
+ $r = $object_map{'cust_main'}{$m}
+ if $m;
+ }
+ $r;
+ },
+ 'pkgpart' => sub { my $href = shift;
+ my $p = $href->{product_id};
+ $p =~ /^\s*(\S[\S ]*?)\s*$/ && ($p = $1);
+ my $pkg = $package_cache{$p}
+ if $package_cache{$p};
+
+ my $month = '';
+ $href->{month_credit} =~ /\s*(\S[\S ]*?)\s*$/ && ($month = $1);
+ $month = int(eval "$month + 0");
+
+ my $price = 0;
+ $href->{unit_price} =~ /\s*(\S[\S ]*?)\s*$/ && ($price = $1);
+ $price = eval "$price + 0";
+
+ if ($pkg) {
+ $pkg = ''
+ unless $pkg->freq + 0 == $month;
+
+ if ($pkg && ($pkg->freq + 0)) {
+ my $recur = 0;
+ $pkg->recur_fee =~ /\s*(\S[\S ]*?)\s*$/ && ($recur = $1);
+ $recur = eval "$recur + 0";
+ $pkg = ''
+ unless $recur == $price;
+ }
+
+ if ($pkg) {
+ $pkg = ''
+ unless $pkg->setuptax
+ eq ($href->{taxable} ? '' : 'Y');
+ }
+
+ }
+
+ unless ($pkg) {
+ my $pkghref = { 'pkg' => ($href->{description} ? $href->{description} : $href->{product_id} ),
+ 'comment' => $href->{product_id},
+ 'freq' => $month,
+ 'setuptax' => ($href->{'taxable'} ? '' : 'Y'),
+ 'recurtax' => ($href->{'taxable'} ? '' : 'Y'),
+ 'plan' => 'flat',
+ 'disabled' => 'Y',
+ };
+
+ my @pkgs = qsearch('part_pkg', $pkghref);
+ my $recur = sprintf("%.2f", ($month ? $price : 0));
+ for (@pkgs) {
+ my %options = $_->options;
+ if ($options{recur_fee} eq $recur) {
+ $pkg = $_;
+ last;
+ }
+ }
+
+ $pkghref->{recur_fee} = $recur
+ unless $pkg;
+
+ my $pkg_svc = {};
+
+ if ($month){
+ $pkg_svc->{$legacy_ppp_svcpart} = 1;
+ $pkg_svc->{$legacy_email_svcpart} =
+ $href->{emails_allowed}
+ if $href->{emails_allowed};
+ }
+ $pkghref->{pkg_svc} = $pkg_svc;
+ $pkghref->{primary_svc}
+ = ( $month
+ ? $legacy_ppp_svcpart
+ : '');
+ unless ($pkg) {
+ $pkg = new FS::part_pkg $pkghref;
+ my $options =
+ { map { my $v = $pkg->$_;
+ $pkg->$_('');
+ ($_ => $v);
+ }
+ qw (setup_fee recur_fee)
+ };
+ my $error =
+ $pkg->insert(options=>$options);
+ if ($error) {
+ warn "Error inserting pkg ".
+ join(", ", map{"$_ => ". $pkg->get($_)} fields $pkg).
+ ": $error\n";
+ $pkg = '';
+ }
+ }
+ }
+ $pkg ? $pkg->pkgpart : '';
+ },
+ 'setup' => sub { str2time(shift->{creation_date}) },
+ 'bill' => sub { $bill{account_id(shift)}
+ #$bill{$href->{cbilling_cycle_login}};
+ },
+ 'susp' => sub { $susp{account_id(shift)}
+ #$susp{$href->{cbilling_cycle_login}};
+ },
+ 'adjo' => sub { $adjo{account_id(shift)}
+ #$adjo{$href->{cbilling_cycle_login}};
+ },
+ 'cancel' => sub { $cancel{account_id(shift)}
+ #$cancel{$href->{cbilling_cycle_login}};
+ },
+ },
+ 'fixup' => sub { my ($object, $row) = (shift,shift);
+ unless ($object->custnum) {
+ warn "can't find customer for ".
+ $row->{cbilling_cycle_login}. "\n";
+ return 1;
+ }
+ unless ($object->pkgpart) {
+ warn "can't find package for ".
+ $row->{product_id}. "\n";
+ return 1;
+ }
+ '';
+ },
+ 'skey' => sub { my $object = shift;
+ my $href = shift;
+ my $id = $href->{'billing_cycle_item_id'};
+ $id =~ /^\s*(\S[\S ]*?)\s*$/ && ($id = $1);
+ $cust_pkg_map{$id} = $object->pkgnum;
+ account_id($href);
+ },
+ 'wrapup' => sub { for my $id (keys %{$object_map{'cust_pkg'}}){
+ my $cust_svc =
+ qsearchs( 'cust_svc', { 'svcnum' =>
+ $object_map{'svc_acct'}{$id} }
+ );
+ unless ($cust_svc) {
+ warn "can't find legacy ppp $id\n";
+ next;
+ }
+ $cust_svc->
+ pkgnum($object_map{'cust_pkg'}{$id});
+ my $error = $cust_svc->replace;
+ warn "error linking legacy ppp $id: $error\n"
+ if $error;
+ }
+ },
+ },
+svc_acct => { 'stable' => 'email',
+ 'mapping' =>
+ { 'username' => 'email_name',
+ '_password' => 'password',
+ 'svcpart' => sub{ $legacy_email_svcpart },
+ 'domsvc' => sub{ $legacy_domain_svcnum },
+ },
+# 'fixup' => sub { my ($object, $row) = (shift,shift);
+# my ($sd,$sm,$sy) = split '/',
+# $row->{shut_off_date}
+# if $row->{shut_off_date};
+# if ($sd && $sm && $sy) {
+# my ($cd, $cm, $cy) = (localtime)[3,4,5];
+# $cy += 1900; $cm++;
+# return 1 if $sy < $cy;
+# return 1 if ($sy == $cy && $sm < $cm);
+# return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd);
+# }
+# return 1 if $object_map{'cust_main'}{$object->username};
+# '';
+# },
+ 'fixup' => sub { my ($object, $row) = (shift,shift);
+ my ($sd,$sm,$sy) = split '/',
+ $row->{shut_off_date}
+ if $row->{shut_off_date};
+ if ($sd && $sm && $sy) {
+ my ($cd, $cm, $cy) = (localtime)[3,4,5];
+ $cy += 1900; $cm++;
+ return 1 if $sy < $cy;
+ return 1 if ($sy == $cy && $sm < $cm);
+ return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd);
+ }
+ #return 1 if $object_map{'cust_main'}{$object->username};
+
+ my $email_name;
+ $row->{email_name} =~ /^\s*(\S[\S ]*?)\s*$/
+ && ($email_name = $1);
+
+ my $svcnum =
+ $object_map{legacy_email}{$email_name}
+ if $email_name;
+ unless( $svcnum ) {
+ warn "can't find svc_acct for legacy email ".
+ $row->{'email_name'}, "\n";
+ return 1;
+ }
+
+ $object_map{svc_acct}{'email:'.$row->{'email_customer_id'}} = $svcnum;
+ return 1;
+ },
+# 'skey' => sub { my $object = shift;
+# my $href = shift;
+# 'email:'. $href->{'email_customer_id'};
+# },
+ 'wrapup' => sub { for my $id (keys %{$object_map{'svc_acct'}}){
+ next unless $id =~ /^email:(\d+)/;
+ my $custid = $1;
+ my $cust_svc =
+ qsearchs( 'cust_svc', { 'svcnum' =>
+ $object_map{'svc_acct'}{$id} }
+ );
+ unless ($cust_svc) {
+ warn "can't find legacy email $id\n";
+ next;
+ }
+
+ if ($cust_svc->pkgnum) {
+ warn "service already linked for $id\n";
+ next;
+ }
+
+ $cust_svc->
+ pkgnum($cust_pkg_map{$custid});
+ if ($cust_svc->pkgnum){
+ my $error = $cust_svc->replace;
+ warn "error linking legacy email $id: $error\n"
+ if $error;
+ }else{
+ warn "can't find package for $id\n"
+ }
+ }
+ },
+ },
+);
+
+#my $s_dbh = DBI->connect($s_datasrc, $s_dbuser, $s_dbpass) or die $DBI::errstr;
+
+while ( @tables ) {
+ my ($table, $href) = (shift @tables, shift @tables);
+ my $stable = $href->{'stable'} or die "No source table"; # good enough for now
+ my (%mapping) = %{$href->{'mapping'}};
+ my ($fixup) = $href->{'fixup'};
+ my ($wrapup) = $href->{'wrapup'};
+ my ($id) = $href->{'id'};
+ my ($skey) = $href->{'skey'};
+
+ #$d_dbh->do("delete from $table");
+
+ my $s_sth = $s_dbh->prepare("select count(*) from $stable");
+ $s_sth->execute or die $s_sth->errstr;
+ my $rowcount = $s_sth->fetchrow_arrayref->[0];
+
+ $s_sth = $s_dbh->prepare("select * from $stable");
+ $s_sth->execute or die $s_sth->errstr;
+
+ my $row;
+ $count = 0;
+ while ( $row = $s_sth->fetchrow_hashref ) {
+ my $class = "FS::$table";
+
+ warn sprintf("%.2f", 100*$count/$rowcount). "% of $table processed\n"
+ unless( !$count || $count % 100 );
+
+ my $object = new $class ( {
+ map { $_ => ( ref($mapping{$_}) eq 'CODE'
+ ? &{$mapping{$_}}($row)
+ : $row->{$mapping{$_}}
+ )
+ }
+ keys(%mapping)
+ } );
+ my $skip = &{$fixup}($object, $row)
+ if $fixup;
+
+ unless ($skip) {
+ my $error = $object->insert;
+ if ($error) {
+ warn "Error inserting $table ".
+ join(", ", map{"$_ => ". $object->get($_)} fields $object).
+ ": $error\n";
+ next;
+ }
+ if ($skey) {
+ my $key = (ref($skey) eq 'CODE') ? &{$skey}($object, $row)
+ : $row->{$skey};
+ $object_map{$table}{$key} = $object->get($object->primary_key)
+ }
+ $count++;
+ }
+ }
+
+ &{$wrapup}()
+ if $wrapup;
+
+ print "$count/$rowcount of $table SUCCESSFULLY processed\n";
+
+}
+
+# link to any uncancelled package on customer
+foreach my $username ( keys %{$object_map{'legacy_email'}} ) {
+ my $cust_svc = qsearchs( 'cust_svc',
+ { 'svcnum' => $object_map{legacy_email}{$username} }
+ );
+ next unless $cust_svc;
+ next if $cust_svc->pkgnum;
+
+ my $custnum = $object_map{cust_main}{$username};
+ unless ($custnum) {
+ my $master = $master_map{$username};
+ $custnum = $object_map{'cust_main'}{$master}
+ if $master;
+ next unless $custnum;
+ }
+
+ #my $extra_sql = ' AND 0 != (select freq from part_pkg where '.
+ # 'cust_pkg.pkgpart = part_pkg.pkgpart )';
+ my $extra_sql = " AND 'Prior balance' != (select pkg from part_pkg where ".
+ "cust_pkg.pkgpart = part_pkg.pkgpart )";
+
+ my @cust_pkg = qsearch( {
+ 'table' => 'cust_pkg',
+ 'hashref' => { 'custnum' => $custnum,
+ 'cancel' => '',
+ },
+ 'extra_sql' => $extra_sql,
+ } );
+ next unless scalar(@cust_pkg);
+
+ $cust_svc->pkgnum($cust_pkg[0]->pkgnum);
+ $cust_svc->replace;
+}
+
+
+if ($dry_run) {
+ $d_dbh->rollback;
+}else{
+ $d_dbh->commit or die $d_dbh->errstr;
+}
+
diff --git a/bin/import-tax-rates b/bin/import-tax-rates
new file mode 100755
index 000000000..1cb76e0ba
--- /dev/null
+++ b/bin/import-tax-rates
@@ -0,0 +1,56 @@
+#!/usr/bin/perl -Tw
+
+use strict;
+use vars qw($opt_c $opt_p $opt_t $opt_d $opt_z $opt_f);
+use vars qw($DEBUG);
+use Getopt::Std;
+use FS::UID qw(adminsuidsetup);
+use FS::Conf;
+use FS::tax_rate;
+use FS::cust_tax_location;
+
+getopts('c:p:t:d:z:f:');
+
+my $user = shift or die &usage;
+my $dbh = adminsuidsetup $user;
+
+my ($format) = $opt_f =~ /^([-\w]+)$/;
+
+my @list = (
+ 'CODE', $opt_c, \&FS::tax_class::batch_import,
+ 'PLUS4', $opt_p, \&FS::cust_tax_location::batch_import,
+ 'ZIP', $opt_z, \&FS::cust_tax_location::batch_import,
+ 'TXMATRIX', $opt_t, \&FS::part_pkg_taxrate::batch_import,
+ 'DETAIL', $opt_d, \&FS::tax_rate::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;
+
+ my $f = $format;
+ $f .= '-zip' if $name eq 'ZIP';
+
+ open $fh, '<', $file or die "can't open $name file: $!\n";
+ $error ||= &{$method}( { filehandle => $fh, 'format' => $f, } );
+
+ 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:\nimport-tax-rates f FORMAT -c CODEFILE -p PLUS4FILE -z ZIPFILE -t TXMATRIXFILE -d DETAILFILE user\n\n"; }
diff --git a/bin/ispman.ldap.import b/bin/ispman.ldap.import
new file mode 100755
index 000000000..7495f47f8
--- /dev/null
+++ b/bin/ispman.ldap.import
@@ -0,0 +1,114 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Net::LDAP::LDIF;
+
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearchs);
+use FS::svc_domain;
+use FS::svc_acct;
+
+my $user = shift or die;
+adminsuidsetup($user);
+
+$FS::svc_Common::noexport_hack = 1;
+$FS::svc_domain::whois_hack = 1;
+
+my $domain_svcpart = 1;
+my $account_svcpart = 2;
+my $mailbox_svcpart = 3;
+my $fedweeknet_svcpart = 4;
+
+#my $ldif =
+# Net::LDAP::LDIF->new( "ispman-06-23-04.ldif", "r", onerror => 'undef' );
+my $ldif =
+ Net::LDAP::LDIF->new( "ispman-06-23-04.ldif", "r", onerror => 'warn' );
+
+#my %objectclass;
+
+my $acct = 0;
+my $imported = 0;
+
+my $entry;
+while ( $entry = $ldif->read_entry ) {
+ #warn "$entry\n";
+ my %attributes = map { $_ => [ $entry->get_value( $_ ) ] } $entry->attributes;
+
+ my $objectclass = join('/', @{$attributes{'objectclass'}} );
+
+ next unless $objectclass eq 'posixAccount/ispmanDomainUser/radiusprofile';
+
+ foreach my $attr ( keys %attributes ) {
+ print join( " => ", substr($attr.' 'x30,0,30), @{$attributes{ $attr }} ), "\n";
+ #if ( $attr eq 'objectclass' ) {
+ # $objectclass{ join('/', @{$attributes{$attr}} ) }++;
+ #}
+ }
+ print "\n";
+
+ $acct++;
+
+ my $email = $attributes{'maillocaladdress'}->[0];
+ $email =~ /^(\w+)\@([\w\.\-]+)$/ or die $email;
+ die "$1 ne ". $attributes{'ispmanuserid'}->[0]. "\n"
+ unless lc($1) eq $attributes{'ispmanuserid'}->[0];
+ my $username = lc($1);
+ my $domain = lc($2);
+
+ my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } )
+ || new FS::svc_domain { 'svcpart' => $domain_svcpart,
+ 'domain' => $domain,
+ 'action' => 'N',
+ };
+
+ unless ( $svc_domain->svcnum ) {
+ my $error = $svc_domain->insert;
+ if ( $error ) {
+ die "inserting domain: $error\n";
+ }
+ }
+
+ ( my $password = $attributes{'userpassword'}->[0] ) =~ s/^\{crypt\}//;
+
+ # pick svcpart
+ my $svcpart = $account_svcpart;
+ if ( $domain eq 'fedweeknet.com' ) {
+ $svcpart = $fedweeknet_svcpart;
+ } elsif ( $attributes{'dialupaccess'}->[0] =~ /(false|no)/i ) {
+ $svcpart = $mailbox_svcpart;
+ }
+
+ my $dir = $attributes{'homedirectory'}->[0];
+ $dir =~ s/\s+//g;
+ $dir =~ s/\@/_/;
+
+ my $svc_acct = new FS::svc_acct {
+ 'svcpart' => $svcpart,
+ 'username' => $username,
+ '_password' => $password,
+ 'finger' => $attributes{'cn'}->[0],
+ 'domsvc' => $svc_domain->svcnum,
+ 'shell' => $attributes{'loginshell'}->[0],
+ 'uid' => $attributes{'uidnumber'}->[0],
+ 'gid' => $attributes{'gidnumber'}->[0],
+ 'dir' => $dir,
+ 'quota' => $attributes{'mailquota'}->[0],
+ };
+ my $error = $svc_acct->insert;
+ #my $error = $svc_acct->check;
+
+ if ( $error ) {
+ warn "$error\n";
+ } else {
+ $imported++;
+ }
+
+}
+
+print "$imported of $acct imported\n";
+
+#print "\n\n";
+
+#foreach ( sort { $objectclass{$b} <=> $objectclass{$a} } keys %objectclass ) {
+# print "$objectclass{$_}: $_\n";
+#}
diff --git a/bin/japan.pl b/bin/japan.pl
new file mode 100755
index 000000000..14e44e4ec
--- /dev/null
+++ b/bin/japan.pl
@@ -0,0 +1,32 @@
+#!/usr/bin/perl
+
+use FS::UID qw( adminsuidsetup );
+use FS::Record qw( qsearch );
+use FS::cust_main_county;
+
+adminsuidsetup shift;
+
+my $country = 'JP';
+
+foreach my $cust_main_county (
+ qsearch('cust_main_county', { 'country' => $country } )
+) {
+
+ if ( $cust_main_county->state =~ /\[([\w ]+)\]\s*$/ ) {
+ $cust_main_county->state($1);
+ my $error = $cust_main_county->replace;
+ die $error if $error;
+ }
+
+}
+
+
+#use Locale::SubCountry;
+#
+##my $state = 'Tôkyô [Tokyo]';
+#my $state = 'Tottori';
+#
+#my $lsc = new Locale::SubCountry 'JP';
+#
+#print $lsc->code($state)."\n";
+
diff --git a/bin/mapsecrets2access_user b/bin/mapsecrets2access_user
new file mode 100755
index 000000000..945f130ef
--- /dev/null
+++ b/bin/mapsecrets2access_user
@@ -0,0 +1,87 @@
+#!/usr/bin/perl -w
+
+use strict;
+use File::Copy "cp";
+use FS::UID qw(adminsuidsetup);
+use FS::CurrentUser;
+use FS::AccessRight;
+use FS::Record qw(qsearchs qsearch);
+use FS::access_group;
+use FS::access_user;
+use FS::access_usergroup;
+use FS::access_right;
+use FS::access_groupagent;
+use FS::agent;
+
+$FS::CurrentUser::upgrade_hack = 1;
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my $supergroup = qsearchs('access_group', { 'groupname' => 'Superuser' } );
+unless ( $supergroup ) {
+
+ $supergroup = new FS::access_group { 'groupname' => 'Superuser' };
+ my $error = $supergroup->insert;
+ die $error if $error;
+
+ foreach my $rightname ( FS::AccessRight->rights ) {
+ my $access_right = new FS::access_right {
+ 'righttype' => 'FS::access_group',
+ 'rightobjnum' => $supergroup->groupnum,
+ 'rightname' => $rightname,
+ };
+ my $ar_error = $access_right->insert;
+ die $ar_error if $ar_error;
+ }
+
+ foreach my $agent ( qsearch('agent', {} ) ) {
+ my $access_groupagent = new FS::access_groupagent {
+ 'groupnum' => $supergroup->groupnum,
+ 'agentnum' => $agent->agentnum,
+ };
+ my $aga_error = $access_groupagent->insert;
+ die $aga_error if $aga_error;
+ }
+
+}
+my $supergroupnum = $supergroup->groupnum;
+
+my $conf = new FS::Conf;
+my $dir = $conf->base_dir;
+my $mapsecrets = "$dir/mapsecrets";
+open(MAPSECRETS, "<$mapsecrets") or die "Can't open $mapsecrets: $!";
+while (<MAPSECRETS>) {
+ /([\w]+)\s+secrets\s*$/ or die "unparsable line in mapsecrets: $_";
+ my $username = $1;
+
+ next if qsearchs('access_user', { 'username' => $username } );
+
+ my $access_user = new FS::access_user {
+ 'username' => $username,
+ '_password' => 'notyet',
+ 'first' => 'Legacy',
+ 'last' => 'User',
+ };
+ my $au_error = $access_user->insert;
+ die $au_error if $au_error;
+
+ my $access_usergroup = new FS::access_usergroup {
+ 'usernum' => $access_user->usernum,
+ 'groupnum' => $supergroupnum,
+ };
+ my $aug_error = $access_usergroup->insert;
+ die $aug_error if $aug_error;
+
+}
+close MAPSECRETS;
+
+# okay to clobber mapsecrets now i guess
+cp $mapsecrets, "$mapsecrets.bak$$";
+open(MAPSECRETS, ">$mapsecrets") or die $!;
+print MAPSECRETS '* secrets'. "\n";
+close MAPSECRETS or die $!;
+
+sub usage {
+ die "Usage:\n mapsecrets2access_user user\n";
+}
+
diff --git a/bin/masonize b/bin/masonize
new file mode 100755
index 000000000..509ef3ec8
--- /dev/null
+++ b/bin/masonize
@@ -0,0 +1,80 @@
+#!/usr/bin/perl
+
+foreach $file ( split(/\n/, `find . -depth -print`) ) {
+ next unless $file =~ /(cgi|html)$/;
+ open(F,$file) or die "can't open $file for reading: $!";
+ @file = <F>;
+ #print "$file ". scalar(@file). "\n";
+ close $file;
+ $newline = ''; #avoid prepending extraneous newlines
+ $all = join('',@file);
+
+ $w = '';
+
+ $mode = 'html';
+ while ( length($all) ) {
+
+ if ( $mode eq 'html' ) {
+
+ if ( $all =~ /^(.+?)(<%=?.*)$/s && $1 !~ /<%/s ) {
+ $w .= $1;
+ $all = $2;
+ next;
+ } elsif ( $all =~ /^<%=(.*)$/s ) {
+ $w .= '<%';
+ $all = $1;
+ $mode = 'perlv';
+ #die;
+ next;
+ } elsif ( $all =~ /^<%(.*)$/s ) {
+ $w .= $newline; $newline = "\n";
+ $all = $1;
+ $mode = 'perlc';
+
+ #avoid newline prepend fix from borking indented first <%
+ $w =~ s/\n\s+\z/\n/;
+ $w .= "\n" if $w =~ /.+\z/;
+
+ next;
+ } elsif ( $all !~ /<%/s ) {
+ $w .= $all;
+ last;
+ } else {
+ warn length($all); die;
+ }
+ die;
+
+ } elsif ( $mode eq 'perlv' ) {
+
+ if ( $all =~ /^(.*?%>)(.*)$/s ) {
+ $w .= $1;
+ $all=$2;
+ $mode = 'html';
+ next;
+ }
+ die "unterminated <%= ??? (in $file):";
+
+ } elsif ( $mode eq 'perlc' ) {
+
+ if ( $all =~ /^([^\n]*?)%>(.*)$/s ) {
+ $w .= "%$1\n";
+ $all=$2;
+ $mode='html';
+ next;
+ }
+ if ( $all =~ /^([^\n]*)\n(.*)$/s ) {
+ $w .= "%$1\n";
+ $all=$2;
+ next;
+ }
+
+ } else { die };
+
+ }
+
+ system("chmod u+w $file");
+ select W; $| = 1; select STDOUT;
+ open(W,">$file") or die "can't open $file for writing: $!";
+ print W $w;
+ close W;
+}
diff --git a/bin/passwd.import b/bin/passwd.import
new file mode 100755
index 000000000..8ab9e2ae3
--- /dev/null
+++ b/bin/passwd.import
@@ -0,0 +1,121 @@
+#!/usr/bin/perl -Tw
+
+use strict;
+use vars qw(%part_svc);
+use Date::Parse;
+use Term::Query qw(query);
+use Net::SCP qw(iscp);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch qsearchs);
+use FS::svc_acct;
+use FS::part_svc;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others?
+
+my($spooldir)="/usr/local/etc/freeside/export.". datasrc;
+
+#$FS::svc_acct::nossh_hack = 1;
+$FS::svc_Common::noexport_hack = 1;
+
+###
+
+%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
+
+die "No services with svcdb svc_acct!\n" unless %part_svc;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Enter part number to import.
+END
+my($shell_svcpart)=&getpart;
+
+print "\n\n", <<END;
+Enter the location and name of your _user_ passwd file, for example
+"mail.isp.com:/etc/passwd" or "nis.isp.com:/etc/global/passwd"
+END
+my($loc_passwd)=&getvalue(":");
+iscp("root\@$loc_passwd", "$spooldir/passwd.import");
+
+print "\n\n", <<END;
+Enter the location and name of your _user_ shadow file, for example
+"mail.isp.com:/etc/shadow" or "bsd.isp.com:/etc/master.passwd"
+END
+my($loc_shadow)=&getvalue(":");
+iscp("root\@$loc_shadow", "$spooldir/shadow.import");
+
+sub menu_svc {
+ ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n";
+}
+sub getpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_svc ];
+ $^W=1;
+ $return;
+}
+sub getvalue {
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
+}
+
+print "\n\n";
+
+###
+
+open(PASSWD,"<$spooldir/passwd.import");
+open(SHADOW,"<$spooldir/shadow.import");
+
+my(%password);
+while (<SHADOW>) {
+ chop;
+ my($username,$password)=split(/:/);
+ #$password =~ s/^\!$/\*/;
+ #$password =~ s/\!+/\*SUSPENDED\* /;
+ $password =~ s/^NP$/\*/;
+ $password =~ s/^\*LK\*$/\*/;
+ $password{$username}=$password;
+}
+
+while (<PASSWD>) {
+ chop;
+ my($username,$x,$uid,$gid,$finger,$dir,$shell) = split(/:/);
+ my $password = $password{$username};
+
+ my $svcpart = $shell_svcpart;
+
+ #if ( qsearchs('svc_acct', { 'username' => $username } ) ) {
+ # warn "warning: $username already exists; skipping\n";
+ # next;
+ #}
+
+ my($svc_acct) = new FS::svc_acct ({
+ 'svcpart' => $svcpart,
+ 'username' => $username,
+ '_password' => $password,
+ 'uid' => $uid,
+ 'gid' => $gid,
+ 'finger' => $finger,
+ 'dir' => $dir,
+ 'shell' => $shell,
+ #%{$allparam{$username}},
+ });
+ my($error);
+ $error=$svc_acct->insert;
+ if ( $error ) {
+ if ( $error =~ /duplicate/i ) {
+ warn "$username: $error";
+ } else {
+ die "$username: $error";
+ }
+ }
+
+}
+
+sub usage {
+ die "Usage:\n\n passwd.import user\n";
+}
+
diff --git a/bin/payment-faker b/bin/payment-faker
new file mode 100755
index 000000000..03316e1c0
--- /dev/null
+++ b/bin/payment-faker
@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+
+use Date::Parse;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch);
+use FS::cust_pay;
+use FS::cust_credit;
+
+my $user;
+$user = shift or die "usage: payment-faker $user";
+adminsuidsetup($user);
+
+for $month ( 1 .. 11 ) {
+
+ print "month $month\n";
+
+ system(qq!freeside-daily -d "$month/1/2006" $user!);
+
+ foreach my $cust_main ( qsearch('cust_main', {} ) ) {
+ next unless $cust_main->balance > 0;
+ my $item = '';
+ if ( rand() > .95 ) {
+ $item = new FS::cust_credit {
+ 'amount' => $cust_main->balance,
+ '_date' => str2time("$month/1/2006"),
+ 'reason' => 'testing',
+ };
+ } else {
+
+ if ( rand() > .5 ) {
+ $payby = 'BILL';
+ $payinfo = int(rand(10000));
+ } else {
+ $payby = 'CARD';
+ $payinfo = '4111111111111111';
+ }
+
+ $item = new FS::cust_pay {
+ 'paid' => $cust_main->balance,
+ '_date' => str2time("$month/1/2006"),
+ 'payby' => $payby,
+ 'payinfo' => $payinfo,
+ };
+ }
+
+ $item->custnum($cust_main->custnum);
+ my $error = $item->insert;
+ die $error if $error;
+ $cust_main->apply_payments;
+ $cust_main->apply_credits;
+
+ }
+
+}
diff --git a/bin/pg-readonly b/bin/pg-readonly
new file mode 100644
index 000000000..ad69fbde2
--- /dev/null
+++ b/bin/pg-readonly
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+#
+# hack to update/add read-only permissions for a user on the db
+#
+# usage: pg-readonly freesideuser readonlyuser
+
+use strict;
+use DBI;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(dbdef);
+
+my $user = shift or die &usage;
+my $rouser = shift or die &usage;
+
+my $dbh = adminsuidsetup $user;
+
+foreach my $table ( dbdef->tables ) {
+ $dbh->do("GRANT SELECT ON $table TO $rouser");
+ $dbh->commit();
+ if ( my $pkey = dbdef->table($table)->primary_key ) {
+ $dbh->do("GRANT SELECT ON ${table}_${pkey}_seq TO $rouser");
+ $dbh->commit();
+ }
+}
diff --git a/bin/pg-version b/bin/pg-version
new file mode 100755
index 000000000..b6cddb612
--- /dev/null
+++ b/bin/pg-version
@@ -0,0 +1,13 @@
+#!/usr/bin/perl -w
+
+use strict;
+use FS::UID qw(adminsuidsetup dbh);
+
+my $user = shift or die &usage;
+adminsuidsetup($user);
+
+print "pg_server_version: ". dbh->{'pg_server_version'}. "\n";
+
+sub usage {
+ "\n\nUsage: pg-version username\n";
+};
diff --git a/bin/pod2x b/bin/pod2x
index 1edb1c41e..ecb7f913b 100755
--- a/bin/pod2x
+++ b/bin/pod2x
@@ -1,23 +1,145 @@
-#!/usr/bin/perl
+#!/usr/bin/perl -w
-#use Pod::Text;
-#$Pod::Text::termcap=1;
+use strict;
-my $site_perl = "./site_perl";
-#my $catman = "./catman";
-my $catman = "./htdocs/docs/man";
-#my $html = "./htdocs/docs/man";
+my $mw_username = 'ivan';
+chomp( my $mw_password = `cat .mw-password` );
+
+my $site_perl = "./FS";
+#my $html = "Freeside:1.7:Documentation:Developer";
+my $html = "Freeside:1.9:Documentation:Developer";
+
+foreach my $dir (
+ $html,
+ map "$html/$_", qw( bin FS FS/UI FS/part_export FS/part_pkg
+ FS/part_event FS/part_event/Condition FS/part_event/Action
+ FS/ClientAPI FS/Cron FS/Misc FS/Report FS/Report/Table
+ FS/TicketSystem FS/UI
+ FS/SelfService
+ )
+) {
+ -d $dir or mkdir $dir;
+}
$|=1;
-die "Can't find $site_perl and $catman"
- unless [ -d $site_perl ] && [ -d $catman ] && [ -d $html ];
+die "Can't find $site_perl" unless -d $site_perl;
+#die "Can't find $catman" unless -d $catman;
+-d $html or mkdir $html;
+
+my $count = 0;
-foreach my $file (glob("$site_perl/*.pm")) {
- $file =~ /\/([\w\-]+)\.pm$/ or die "oops file $file";
- my $name = $1;
- print "$name\n";
- system "pod2text $file >$catman/$name.txt";
-# system "pod2html --podpath=$site_perl $file >$html/$name.html";
-# system "pod2html $file >$html/$name.html";
+#make some useless links
+foreach my $file (
+ glob("$site_perl/bin/freeside-*"),
+) {
+ next if $file =~ /\.pod$/;
+ #symlink $file, "$file.pod"; # or die "link $file to $file.pod: $!";
+ #system("cp $file $file.pod");
+ -e "$file.pod" or system("cp $file $file.pod");
}
+
+#just for filename_to_pagename for now
+use WWW::Mediawiki::Client;
+my $mvs = WWW::Mediawiki::Client->new(
+ 'host' => 'www.freeside.biz',
+ 'wiki_path' => 'mediawiki/index.php',
+ 'username' => $mw_username,
+ 'password' => $mw_password,
+ #'commit_message' => 'import from POD'
+ );
+#$mvs->do_login;
+
+use MediaWiki;
+
+my $c = MediaWiki->new;
+# $is_ok = $c->setup("config.ini");
+$c->setup({
+ 'bot' => { 'user' => $mw_username, 'pass' => $mw_password },
+ 'wiki' => {
+ 'host' => 'www.freeside.biz',
+ 'path' => 'mediawiki',
+ #'has_query' => 1,
+
+ }
+}) or die "Mediawiki->setup failed";
+
+my @files;
+if ( @ARGV ) {
+ @files = @ARGV;
+} else {
+ @files = (
+ glob("$site_perl/*.pm"),
+ glob("$site_perl/*/*.pm"),
+ glob("$site_perl/*/*/*.pm"),
+ glob("$site_perl/*/*/*/*.pm"),
+ glob("$site_perl/bin/*.pod"),
+ glob("./fs_selfservice/FS-SelfService/*.pm"),
+ glob("./fs_selfservice/FS-SelfService/*/*.pm"),
+ );
+
+}
+
+foreach my $file (@files) {
+ next if $file =~ /(^|\/)blib\//;
+ next if $file =~ /(^|\/)CVS\//;
+ #$file =~ /\/([\w\-]+)\.pm$/ or die "oops file $file";
+ my $name;
+ if ( $file =~ /fs_\w+\/FS\-\w+\/(.*)\.pm$/ ) {
+ $name = "FS/$1";
+ } elsif ( $file =~ /$site_perl\/(.*)\.(pm|pod)$/ ) {
+ $name = $1;
+ } else {
+ die "oops file $file";
+ }
+
+ #exit if $count++ == 10;
+
+ my $htmlroot = join('/', map '..',1..(scalar($file =~ tr/\///)-2)) || '.';
+
+ system "pod2wiki --style mediawiki $file >$html/$name.rawwiki";
+
+ if ( -e "$html/$name.rawwiki" ) {
+ print "processing $name\n";
+ } else {
+ print "skipping $name\n";
+ next;
+ };
+
+# $mvs->do_update("$html/$name.wiki");
+
+
+ my $text = '';
+ open(RAW, "<$html/$name.rawwiki") or die $!;
+ while (<RAW>) {
+ s/\[\[([^#p][^\]]*)\]\]/"[[$html\/". w_e($1). "|$1]]"/ge;
+ $text .= $_;
+ }
+ close RAW;
+
+ my $pagename = $mvs->filename_to_pagename("$html/$name.wiki");
+ #print " uploading to $pagename\n";
+
+ $c->text( $pagename, $text );
+
+}
+
+sub w_e {
+ my $s = shift;
+ $s =~ s/_/ /g;
+ $s =~ s/::/\//g;
+ $s =~ s/^freeside-/bin\/freeside-/g;
+ $s;
+}
+
+
+## system "pod2text $file >$catman/$name.txt";
+##
+# system "pod2html --podroot=$site_perl --podpath=./FS:./FS/UI:.:./bin --norecurse --htmlroot=$htmlroot $file >$html/$name.html";
+# #system "pod2html --podroot=$site_perl --htmlroot=$htmlroot $file >$html/$name.html";
+## system "pod2html $file >$html/$name.html";
+##
+
+#remove the useless links
+unlink glob("$site_perl/bin/*.pod");
+
diff --git a/bin/postfix.export b/bin/postfix.export
new file mode 100755
index 000000000..61380da59
--- /dev/null
+++ b/bin/postfix.export
@@ -0,0 +1,122 @@
+#!/usr/bin/perl -w
+
+use strict;
+#use File::Path;
+use File::Rsync;
+use Net::SSH qw(ssh);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch); # qsearchs);
+use FS::part_export;
+#use FS::cust_pkg;
+use FS::cust_svc;
+#use FS::svc_domain;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/postfix";
+mkdir $spooldir, 0700 unless -d $spooldir;
+
+my @exports = qsearch('part_export', { 'exporttype' => 'postfix' } );
+
+my $rsync = File::Rsync->new({
+ rsh => 'ssh',
+# dry_run => 1,
+});
+
+foreach my $export ( @exports ) {
+
+ my $machine = $export->machine;
+ my $prefix = "$spooldir/$machine";
+ mkdir $prefix, 0700 unless -d $prefix;
+
+ #construct %domain hash
+
+ my $mydomain = $export->option('mydomain');
+ my %domain;
+ foreach my $svc_forward ( $export->svc_x ) {
+
+ my( $username, $domain );
+ my $srcsvc_acct = $svc_forward->srcsvc_acct;
+ if ( $srcsvc_acct ) {
+ ( $username, $domain ) = ( $srcsvc_acct->username, $srcsvc_acct->domain );
+ } elsif ( $svc_forward->src =~ /^([^@]*)\@([^@]+)$/ ) {
+ ( $username, $domain ) = ( $1, $2 );
+ } else {
+ die "bad svc_forward record? svcnum ". $svc_forward->svcnum. "\n";
+ }
+
+ my( $dusername, $ddomain );
+ my $dstsvc_acct = $svc_forward->dstsvc_acct;
+ if ( $dstsvc_acct ) {
+ $dusername = $dstsvc_acct->username;
+ $ddomain = $dstsvc_acct->domain;
+ } elsif ( $svc_forward->dst =~ /([^@]+)\@([^@]+)$/ ) {
+ ( $dusername, $ddomain ) = ( $1, $2 );
+ } else {
+ die "bad svc_forward record? svcnum ". $svc_forward->svcnum. "\n";
+ }
+ my $dest;
+ if ( $ddomain eq $mydomain ) {
+ $dest = $dusername;
+ } else {
+ $dest = "$dusername\@$ddomain";
+ }
+
+ push @{$domain{$domain}{$username}}, $dest;
+
+ }
+
+ #write aliases
+
+ my $aliases = delete $domain{$mydomain};
+ open(ALIASES, ">$prefix/aliases") or die "can't open $prefix/aliases: $!";
+ foreach my $alias ( keys %$aliases ) {
+ print ALIASES "$alias: ". join(',', @{ $aliases->{$alias} } ). "\n";
+ }
+ close ALIASES;
+
+ #write virtual
+
+ open(VIRTUAL, ">$prefix/virtual") or die "can't open $prefix/virtual: $!";
+ foreach my $domain ( keys %domain ) {
+ print VIRTUAL "$domain DOMAIN\n";
+ #foreach my $virtual ( sort { $a ne '' <=> $b ne '' } keys %{$domain{$domain}} ) {
+ foreach my $virtual ( sort { ( ($b ne '') <=> ($a ne '') ) || $a cmp $b } keys %{$domain{$domain}} ) {
+ print VIRTUAL "$virtual\@$domain ".
+ join(',', @{ $domain{$domain}{$virtual} } ). "\n";
+ }
+ print VIRTUAL "\n";
+ }
+ close VIRTUAL;
+
+ #rsync
+
+ my $user = $export->option('user');
+ $rsync->exec( {
+ src => "$prefix/aliases",
+ dest => "$user\@$machine:". $export->option('aliases'),
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+# warn $rsync->out;
+
+ ssh("$user\@$machine", $export->option('newaliases') || 'newaliases');
+# ssh("$user\@$machine", "postfix reload");
+
+ $rsync->exec( {
+ src => "$prefix/virtual",
+ dest => "$user\@$machine:". $export->option('virtual'),
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+# warn $rsync->out;
+ ssh("$user\@$machine", $export->option('postmap')
+ || 'postmap hash:/etc/postfix/virtual');
+ ssh("$user\@$machine", $export->option('reload') || 'postfix reload');
+
+}
+
+# -----
+
+sub usage {
+ die "Usage:\n postfix.export user\n";
+}
+
+
diff --git a/bin/postfix_courierimap.import b/bin/postfix_courierimap.import
new file mode 100755
index 000000000..12c138b49
--- /dev/null
+++ b/bin/postfix_courierimap.import
@@ -0,0 +1,137 @@
+#!/usr/bin/perl -Tw
+
+use strict;
+use vars qw(%part_svc %domain_part_svc);
+#use Date::Parse;
+use DBI;
+use Term::Query qw(query);
+use FS::UID qw(adminsuidsetup); #datasrc
+use FS::Record qw(qsearch qsearchs);
+use FS::svc_acct;
+use FS::part_svc;
+use FS::svc_domain;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+#push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others?
+
+$FS::svc_Common::noexport_hack = 1;
+$FS::svc_domain::whois_hack = 1;
+
+###
+
+%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
+
+die "No services with svcdb svc_acct!\n" unless %part_svc;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Enter part number to import.
+END
+my $mailbox_svcpart = &getpart;
+
+%domain_part_svc = map { $_->svcpart, $_ }
+ qsearch('part_svc', { 'svcdb' => 'svc_domain'} );
+
+die "No services with svcdb svc_domain!\n" unless %domain_part_svc;
+
+print "\n\n", &menu_domain_svc, "\n", <<END;
+Enter part number for domains.
+END
+my $domain_svcpart = &getdomainpart;
+
+my $datasrc = &getvalue("\n\nEnter the DBI datasource:");
+my $db_user = &getvalue("\n\nEnter the database user:");
+my $db_pass = &getvalue("\n\nEnter the database password:");
+
+sub menu_svc {
+ ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n";
+}
+sub menu_domain_svc {
+ ( join "\n", map "$_: ".$domain_part_svc{$_}->svc, sort keys %domain_part_svc ). "\n";
+}
+sub getpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_svc ];
+ $^W=1;
+ $return;
+}
+sub getdomainpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %domain_part_svc ];
+ $^W=1;
+ $return;
+}
+sub getvalue {
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
+}
+
+print "\n\n";
+
+###
+
+my $dbh = DBI->connect( $datasrc, $db_user, $db_pass )
+ or die $DBI::errstr;
+
+my $sth = $dbh->prepare('SELECT username, password, crypt, name, domain FROM mailbox')
+ or die $dbh->errstr;
+$sth->execute or die $sth->errstr;
+
+my $row;
+while ( defined ( $row = $sth->fetchrow_arrayref ) ) {
+ my( $r_username, $password, $crypt, $finger, $r_domain ) = @$row;
+
+ my( $username, $domain );
+ if ( $r_username =~ /^([^@]+)\@([^@]+)$/ ) {
+ $username = $1;
+ $domain = $2;
+ } else {
+ $username = $r_username;
+ $domain = $r_domain;
+ }
+ my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } )
+ || new FS::svc_domain {
+ 'domain' => $domain,
+ 'svcpart' => $domain_svcpart,
+ 'action' => 'N',
+ };
+ unless ( $svc_domain->svcnum ) {
+ my $error = $svc_domain->insert;
+ if ( $error ) {
+ die "can't insert domain $domain: $error\n";
+ }
+ }
+
+ $password = $crypt if $password eq '*CRYPTED*';
+
+ $finger =~ s/Outdoor Power.*$/Outdoor Power/;
+
+ my $svc_acct = new FS::svc_acct {
+ 'svcpart' => $mailbox_svcpart,
+ 'username' => $username,
+ 'domsvc' => $svc_domain->svcnum,
+ '_password' => $password,
+ 'finger' => $finger,
+ };
+
+ my $error = $svc_acct->insert;
+ #my $error = $svc_acct->check;
+ if ( $error ) {
+ if ( $error =~ /duplicate/i ) {
+ warn "$r_username / $r_domain: $error";
+ } else {
+ die "$r_username / $r_domain: $error";
+ }
+ }
+
+}
+
+sub usage {
+ die "Usage:\n\n postfix_courierimap.import user\n";
+}
+
+
diff --git a/bin/print-schema b/bin/print-schema
new file mode 100755
index 000000000..886e3250b
--- /dev/null
+++ b/bin/print-schema
@@ -0,0 +1,7 @@
+#!/usr/bin/perl
+
+use DBIx::DBSchema;
+
+$l = load DBIx::DBSchema "/usr/local/etc/freeside/dbdef.DBI:Pg:dbname=freeside";
+
+print $l->pretty_print, "\n";
diff --git a/bin/rate-us.import b/bin/rate-us.import
new file mode 100755
index 000000000..66ac5de94
--- /dev/null
+++ b/bin/rate-us.import
@@ -0,0 +1,109 @@
+#!/usr/bin/perl -w
+
+use strict;
+#use Spreadsheet::ParseExcel;
+use DBI;
+use FS::UID qw(adminsuidsetup);
+use FS::rate_region;
+use FS::rate_prefix;
+use FS::rate_region;
+
+my $ratenum = 1;
+
+my $user = shift or usage();
+adminsuidsetup $user;
+
+sub usage {
+ #die "Usage:\n\n rate.import user rates.xls worksheet_name";
+ die "Usage:\n\n rate.import user";
+}
+
+my %rate_region;
+
+foreach my $file ( 'areas and rates US.xls',
+ 'areas and rates US2.xls',
+ 'areas and rates US3.xls',
+ )
+{
+
+ my $dbh = DBI->connect("DBI:Excel:file=$file")
+ or die "can't connect: $DBI::errstr";
+
+ #my $table = shift or usage();
+ my $table = 'Sheet1';
+ my $sth = $dbh->prepare("select * from $table")
+ or die "can't prepare: ". $dbh->errstr;
+ $sth->execute
+ or die "can't execute: ". $sth->errstr;
+
+ while ( my $row = $sth->fetchrow_hashref ) {
+
+ #print join(' - ', map $row->{$_}, qw( rate_center Code Area_Prefix Rate ) ). "\n";
+
+ my $regionname = $row->{'rate_center'};
+ $regionname =~ s/\xA0//g;
+ #$regionname =~ s/\xE9/e/g; #e with accent aigu
+ $regionname =~ s/(^\s+|\s+$)//;
+ $regionname .= ', USA';
+
+ my $prefix = $row->{'area_prefix'};
+ $prefix =~ s/\xA0//g;
+ $prefix =~ s/\s$//;
+ #my $prefixprefix = '';
+ #if ( $prefix =~ /^\s*(\d+)\s*\((.*)\)\s*$/ ) {
+ # $prefixprefix = $1;
+ # $prefix = $2;
+ #} elsif ( $prefix =~ /^\s*\((\d{3})\)\s*(.*)$/ ) {
+ # $prefixprefix = $1;
+ # $prefix = $2;
+ #}
+
+ my @rate_prefix = map {
+ #warn $row->{'rate_center'}. ": $prefixprefix$_\n";
+ new FS::rate_prefix {
+ 'countrycode' => '1', # $row->{'Country'}
+ #'npa' => $prefixprefix.$_,
+ 'npa' => $_,
+ };
+ }
+ split(/\s*[;,]\s*/, $prefix);
+
+
+ my $dest_detail = new FS::rate_detail {
+ 'ratenum' => $ratenum,
+ 'min_included' => 0,
+ 'min_charge' =>
+ sprintf('%.2f', $row->{'rate'} ),
+ 'sec_granularity' => 60,
+ };
+
+ unless ( exists $rate_region{$regionname} ) {
+
+ my $rate_region = new FS::rate_region {
+ 'regionname' => $regionname,
+ };
+
+ my $error = $rate_region->insert( 'rate_prefix' => \@rate_prefix,
+ 'dest_detail' => [ $dest_detail ],
+ );
+ die $error if $error;
+
+ $rate_region{$regionname} = $rate_region->regionnum;
+
+ } else {
+
+ foreach my $rate_prefix ( @rate_prefix ) {
+ $rate_prefix->regionnum($rate_region{$regionname});
+ my $error = $rate_prefix->insert;
+ die $error if $error;
+ }
+
+ #$rate_detail->dest_regionnum($rate_region{$regionname});
+ #$error = $rate_detail->insert;
+ #die $error if $error;
+
+ }
+
+ }
+
+}
diff --git a/bin/rate.delete b/bin/rate.delete
new file mode 100644
index 000000000..7b7e4bcf5
--- /dev/null
+++ b/bin/rate.delete
@@ -0,0 +1,3 @@
+#delete from rate_detail where ratenum = 18;
+#delete from rate_region where 0 = ( select count(*) from rate_detail where rate_region.regionnum = rate_detail.dest_regionnum );
+#delete from rate_prefix where 0 = ( select count(*) from rate_region where rate_prefix.regionnum = rate_region.regionnum );
diff --git a/bin/rate.import b/bin/rate.import
new file mode 100755
index 000000000..fdd756d72
--- /dev/null
+++ b/bin/rate.import
@@ -0,0 +1,95 @@
+#!/usr/bin/perl
+
+use strict;
+#use Spreadsheet::ParseExcel;
+use DBI;
+use FS::UID qw(adminsuidsetup);
+use FS::rate_region;
+use FS::rate_prefix;
+use FS::rate_region;
+
+my $ratenum = 1;
+
+my $user = shift or usage();
+adminsuidsetup $user;
+
+#my $file = shift or usage();
+my $file = 'areas and rates.xls';
+my $dbh = DBI->connect("DBI:Excel:file=$file")
+ or die "can't connect: $DBI::errstr";
+
+#my $table = shift or usage();
+my $table = 'areas_and_rates';
+my $sth = $dbh->prepare("select * from $table")
+ or die "can't prepare: ". $dbh->errstr;
+$sth->execute
+ or die "can't execute: ". $sth->errstr;
+
+sub usage {
+ #die "Usage:\n\n rate.import user rates.xls worksheet_name";
+ die "Usage:\n\n rate.import user";
+}
+
+##
+
+while ( my $row = $sth->fetchrow_hashref ) {
+
+ #print join(' - ', map $row->{$_}, qw( Country Code Area_Prefix Rate ) ). "\n";
+
+ my $regionname = $row->{'Country'};
+ $regionname =~ s/\xA0//g;
+ $regionname =~ s/\xE9/e/g; #e with accent aigu
+ $regionname =~ s/(^\s+|\s+$)//;
+
+ #next if $regionname =~ /Sweden Telia Mobile/;
+
+ my $rate_region = new FS::rate_region {
+ 'regionname' => $regionname,
+ };
+
+ my $prefix = $row->{'Area_Prefix'};
+ $prefix =~ s/\xA0//g;
+ $prefix =~ s/\s$//;
+ my $prefixprefix = '';
+ if ( $prefix =~ /^\s*(\d+)\s*\((.*)\)\s*$/ ) {
+ $prefixprefix = $1;
+ $prefix = $2;
+ } elsif ( $prefix =~ /^\s*\((\d{3})\)\s*(.*)$/ ) {
+ $prefixprefix = $1;
+ $prefix = $2;
+ }
+
+ my @rate_prefix = ();
+ if ( $prefix =~ /\d/ ) {
+
+ @rate_prefix = map {
+ #warn $row->{'Country'}. ": $prefixprefix$_\n";
+ new FS::rate_prefix {
+ 'countrycode' => $row->{'Code'},
+ 'npa' => $prefixprefix.$_,
+ };
+ }
+ split(/\s*[;,]\s*/, $prefix);
+
+ } else {
+ @rate_prefix = ( new FS::rate_prefix {
+ 'countycode' => $row->{'Code'},
+ 'npa' => '',
+ };
+ );
+ }
+
+ my $dest_detail = new FS::rate_detail {
+ 'ratenum' => $ratenum,
+ 'min_included' => 0,
+ 'min_charge' =>
+ sprintf('%.2f', $row->{'Rate'} ),
+ 'sec_granularity' => 60,
+ };
+
+ my $error = $rate_region->insert( 'rate_prefix' => \@rate_prefix,
+ 'dest_detail' => [ $dest_detail ],
+ );
+ die $error if $error;
+
+}
diff --git a/bin/reset-cust_credit-otaker b/bin/reset-cust_credit-otaker
new file mode 100755
index 000000000..93002d05a
--- /dev/null
+++ b/bin/reset-cust_credit-otaker
@@ -0,0 +1,88 @@
+#!/usr/bin/perl -w
+
+use strict;
+use vars qw($opt_d);
+use Getopt::Std;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch qsearchs);
+use FS::cust_credit;
+use FS::h_cust_credit;
+
+getopts('d:');
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+die &usage
+ unless ($opt_d);
+
+$FS::Record::nowarn_identical = 1;
+
+if ( $opt_d ) {
+ $opt_d =~ /^(\d+)$/ or die "invalid date";
+} else {
+ die "no date specified\n";
+}
+
+my @cust_credit = qsearch('cust_credit', { otaker => $user } );
+die "no credits found\n" unless @cust_credit;
+
+my $cust_credit = new FS::cust_credit;
+my @fields = grep { $_ !~ /^otaker|reason|reasonnum$/ } $cust_credit->fields;
+
+foreach my $cust_credit ( @cust_credit ) {
+ my %hash = $cust_credit->hash;
+ foreach (qw(otaker reason reasonnum)) {
+ delete $hash{$_};
+ }
+ $hash{'history_action'} = 'replace_old';
+ my $h_cust_credit =
+ qsearchs({ 'table' => 'h_cust_credit',
+ 'hashref' => \%hash,
+ 'select' => '*',
+ 'extra_sql' => " AND history_date <= $opt_d",
+ 'order_by' => 'ORDER BY history_date DESC LIMIT 1',
+ });
+ if ($h_cust_credit) {
+ $cust_credit->otaker($h_cust_credit->otaker);
+ my $reason = $h_cust_credit->getfield('reason');
+ if ($reason =~ /^\s*$/) {
+ $reason = '(none)';
+ }
+ $cust_credit->otaker($h_cust_credit->otaker);
+ $cust_credit->reason($reason);
+ my $error = $cust_credit->replace
+ if $cust_credit->modified;
+ die "error replacing cust_credit: $error\n"
+ if $error;
+ }else{
+ warn "Skipping credit.crednum ". $cust_credit->crednum;
+ }
+}
+
+sub usage {
+ die "Usage:\n\n reset-cust_credit-otaker -d epoch_date user\n";
+}
+
+=head1 NAME
+
+reset-cust_credit-otaker - Command line tool to reset the otaker column for cust_credits to a previous value
+
+=head1 SYNOPSIS
+
+ reset-cust_credit-otaker -d epoch_date user
+
+=head1 DESCRIPTION
+
+ Sets the otaker column of the cust_credit records specified by user and
+ datespec to the value just prior to datespec.
+
+ The reasonnum of the cust_credit record is also set to reason record
+ which matches the reason specified in the history.
+
+=head1 SEE ALSO
+
+L<FS::cust_credit>, L<FS::h_cust_credit>;
+
+=cut
+
diff --git a/bin/rollback b/bin/rollback
new file mode 100755
index 000000000..7f83ef41a
--- /dev/null
+++ b/bin/rollback
@@ -0,0 +1,38 @@
+#!/usr/bin/perl
+
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch qsearchs fields);
+
+use FS::svc_acct;
+
+#cust_pkg pkgnum 240133 241206 replace_old
+#cust_svc svcnum 31102 32083 delete
+#svc_acct svcnum 37162 37652 delete
+my($user, $table, $pkey, $start, $end, $action) = @ARGV;
+
+adminsuidsetup $user or die;
+
+#eval "use FS::h_$table;";
+#die $@ if $@;
+eval "use FS::$table;";
+die $@ if $@;
+
+my @history = grep { $_->historynum <= $end } qsearch("h_$table", { 'historynum' => { op=>'>=', value=>$start }, history_action => $action } );
+
+my %seen;
+foreach my $h (@history) {
+ my $error;
+ if ( $action eq 'replace_old' ) {
+ my $old = qsearchs($table, { $pkey => $h->get($pkey) } );
+ unless ( $old ) { die "can't find $table $pkey ". $h->get($pkey). "\n"; }
+ my $new = "FS::$table"->new( { map { $_ => $h->get($_) } fields($table) } );
+ $error = $new->replace($old);
+ } elsif ( $action eq 'delete' ) {
+ next if $seen{$h->get($pkey)}++;
+ my $new = "FS::$table"->new( { map { $_ => $h->get($_) } fields($table) } );
+ $error = $new->insert;
+ } else {
+ die "unknown action $action\n";
+ }
+ die $error if $error;
+}
diff --git a/bin/rotate-cdrs b/bin/rotate-cdrs
new file mode 100755
index 000000000..7bef0bbb0
--- /dev/null
+++ b/bin/rotate-cdrs
@@ -0,0 +1,38 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Fcntl qw(:flock);
+use IO::File;
+
+my $dir = '/usr/local/etc/freeside/export/cdr';
+#chdir $dir;
+
+#XXX glob might not handle lots of args at some point...
+foreach my $file ( glob("$dir/*/CDR*-spool.CSV") ) {
+
+ $file =~ m{(\d+)/CDR(\d+)-spool.CSV$}
+ or die "guru meditation #54: can't parse filename: $file\n";
+ my($custnum, $date) = ($1, $2);
+
+
+ my $alpha = 'A';
+ while ( -e "$dir/$custnum/CDR$date$alpha.CSV" ) {
+ $alpha++; # A -> Z -> AA etc.
+ }
+ my $newfile = "$dir/$custnum/CDR$date$alpha.CSV";
+
+ rename $file, $newfile
+ or die "$! moving $file to $newfile\n";
+
+ use IO::File;
+ my $lock = new IO::File ">>$newfile"
+ or die "can't open $newfile: $!\n";
+ sleep 1; #just in case. i guess there's still a *remotely* possible
+ #race condition, but i'm not losing any sleep over it... (rimshot)
+ flock($lock, LOCK_EX)
+ or die "can't lock $newfile: $!\n";
+ #okay we've got the lock, any pending write should be done...
+
+ print "$custnum: $newfile\n";
+
+}
diff --git a/bin/rt-drop-tables b/bin/rt-drop-tables
new file mode 100755
index 000000000..b027542b3
--- /dev/null
+++ b/bin/rt-drop-tables
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+
+my @tables = qw(
+Attachments
+Queues
+Links
+Principals
+Groups
+ScripConditions
+Transactions
+Scrips
+ACL
+GroupMembers
+CachedGroupMembers
+Users
+Tickets
+ScripActions
+Templates
+TicketCustomFieldValues
+CustomFields
+CustomFieldValues
+sessions
+);
+
+foreach my $table ( @tables ) {
+ print "drop table $table;\n";
+ print "drop sequence ${table}_id_seq;\n";
+}
+
diff --git a/bin/rt-update-links b/bin/rt-update-links
new file mode 100644
index 000000000..75d554f48
--- /dev/null
+++ b/bin/rt-update-links
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+
+use FS::UID qw(adminsuidsetup);
+
+my( $olddb, $newdb ) = ( shift, shift );
+
+$FS::CurrentUser::upgrade_hack = 1;
+my $dbh = adminsuidsetup;
+
+my $statement = "select * from links where base like 'fsck.com-rt://$olddb/%' OR target like 'fsck.com-rt://$olddb/%'";
+
+my $sth = $dbh->prepare($statement) or die $dbh->errstr;
+$sth->execute or die $sth->errstr;
+
+while ( my $row = $sth->fetchrow_hashref ) {
+
+ ( my $base = $row->{'base'} )
+ =~ s(^fsck\.com-rt://$olddb/)(fsck.com-rt://$newdb/);
+
+ ( my $target = $row->{'target'} )
+ =~ s(^fsck\.com-rt://$olddb/)(fsck.com-rt://$newdb/);
+
+ if ( $row->{'base'} ne $base || $row->{'target'} ne $target ) {
+
+ my $update = 'UPDATE links SET base = ?, target = ? where id = ?';
+ my @param = ( $base, $target, $row->{'id'} );
+
+ warn "$update : ". join(', ', @param). "\n";
+ $dbh->do($update, {}, @param );
+
+ }
+
+}
+
+$dbh->commit;
+
diff --git a/bin/sendmail.import b/bin/sendmail.import
new file mode 100644
index 000000000..ef745fc46
--- /dev/null
+++ b/bin/sendmail.import
@@ -0,0 +1,178 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Term::Query qw(query);
+use Net::SCP qw(iscp);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch qsearchs);
+##use FS::svc_acct_sm;
+#use FS::svc_domain;
+#use FS::domain_record;
+use FS::svc_acct;
+##use FS::part_svc;
+use FS::svc_forward;
+use FS::svc_domain;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+#$FS::svc_Common::noexport_hack = 1;
+#$FS::domain_record::noserial_hack = 1;
+
+use vars qw($defaultdomain);
+$defaultdomain = '295.ca';
+
+use vars qw(@svcpart $forward_svcpart);
+@svcpart = qw( 2 4 );
+$forward_svcpart = 7;
+
+use vars qw($spooldir);
+$spooldir = "/usr/local/etc/freeside/export.". datasrc. "/sendmail";
+mkdir($spooldir, 0755) unless -d $spooldir;
+
+print "\n\n", <<END;
+Enter the location and name of your Sendmail aliases file, for example
+"mail.isp.com:/etc/mail/aliases"
+END
+my($aliases)=&getvalue(":");
+
+use vars qw($aliases_machine $aliases_prefix);
+$aliases_machine = (split(/:/, $aliases))[0];
+$aliases_prefix = "$spooldir/$aliases_machine";
+mkdir($aliases_prefix, 0755) unless -d $aliases_prefix;
+
+#iscp("root\@$aliases","$aliases_prefix/aliases.import");
+iscp("ivan\@$aliases","$aliases_prefix/aliases.import");
+
+print "\n\n", <<END;
+Enter the location and name of your Sendmail virtusertable directory, for example
+"mail.isp.com:/etc/mail/virtusertable"
+END
+my($virtusertable)=&getvalue(":");
+
+use vars qw($virtusertable_machine $virtusertable_prefix);
+$virtusertable_machine = (split(/:/, $virtusertable))[0];
+$virtusertable_prefix = "$spooldir/$virtusertable_machine";
+mkdir($virtusertable_prefix, 0755) unless -d $virtusertable_prefix;
+mkdir("$virtusertable_prefix/virtusertable.import", 0755)
+ unless -d "$virtusertable_prefix/virtusertable.import";
+
+#iscp("root\@$virtusertable/*","$aliases_prefix/virtusertable.import/");
+iscp("ivan\@$virtusertable/*","$aliases_prefix/virtusertable.import/");
+
+sub getvalue {
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
+}
+
+print "\n\n";
+
+##
+
+foreach my $file (
+ "$aliases_prefix/aliases.import",
+ glob("$aliases_prefix/virtusertable.import/*"),
+) {
+
+ warn "importing $file\n";
+
+ open(FILE,"<$file") or die $!;
+ while (<FILE>) {
+ next if /^\s*#/ || /^\s*$/; #skip comments & blank lines
+
+ unless ( /^([\w\@\.\-]+)[:\s]\s*(.*\S)\s*$/ ) {
+ warn "Unparsable line: $_";
+ next;
+ }
+ my($rawusername, $rawdest) = ($1, $2);
+
+ my($username, $domain);
+ if ( $rawusername =~ /^([\w\-\.\&]*)\@([\w\.\-]+)$/ ) {
+ $username = $1;
+ $domain = $2;
+ } elsif ( $rawusername =~ /\@/ ) {
+ die "Unparsable username: $rawusername\n";
+ } else {
+ $username = $rawusername;
+ $domain = $defaultdomain;
+ }
+
+ #find svc_acct record or set $src
+ my($srcsvc, $src) = &svcnum_or_literal($username, $domain);
+
+ foreach my $dest ( split(/,/, $rawdest) ) {
+
+ my($dusername, $ddomain);
+ if ( $dest =~ /^([\w\-\.\&]+)\@([\w\.\-]+)$/ ) {
+ $dusername = $1;
+ $ddomain = $2;
+ } elsif ( $dest =~ /\@/ ) {
+ die "Unparsable username: $dest\n";
+ } else {
+ $dusername = $dest;
+ $ddomain = $defaultdomain;
+ }
+ my($dstsvc, $dst) = &svcnum_or_literal($dusername, $ddomain);
+
+ my $svc_forward = new FS::svc_forward ({
+ svcpart => $forward_svcpart,
+ srcsvc => $srcsvc,
+ src => $src,
+ dstsvc => $dstsvc,
+ dst => $dst,
+ });
+ my $error = $svc_forward->insert;
+ #my $error = $svc_forward->check;
+ if ( $error ) {
+ die "$rawusername: $rawdest: $error\n";
+ }
+ }
+
+
+ } #next entry
+
+} #next file
+
+##
+
+sub svcnum_or_literal {
+ my($username, $domain) = @_;
+
+ my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } );
+ my $domsvc = $svc_domain ? $svc_domain->svcnum : '';
+
+ my @svc_acct = grep { my $svc_acct = $_;
+ grep { $svc_acct->cust_svc->svcpart == $_ } @svcpart
+ }
+ qsearch('svc_acct', {
+ 'username' => $username,
+ 'domsvc' => $domsvc,
+ });
+
+ if ( scalar(@svc_acct) > 1 ) {
+ die "multiple sources found for $username\@$domain !\n";
+ }
+
+ my( $svcnum, $literal ) = ('', '');
+ if ( @svc_acct ) {
+ my $svc_acct = $svc_acct[0];
+ $svcnum = $svc_acct->svcnum;
+ } else {
+ $literal = "$username\@$domain";
+ }
+
+ return( $svcnum, $literal );
+
+}
+
+sub usage {
+ die "Usage:\n\n sendmail.import user\n";
+}
+
+
+
+
+
diff --git a/bin/sequences.reset b/bin/sequences.reset
new file mode 100644
index 000000000..2dc1d3bb2
--- /dev/null
+++ b/bin/sequences.reset
@@ -0,0 +1,32 @@
+#!/usr/bin/perl
+
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(dbdef dbh);
+
+my $user = shift;
+adminsuidsetup $user or die;
+
+foreach my $table ( dbdef->tables ) {
+ my $primary_key = dbdef->table($table)->primary_key;
+ next unless $primary_key;
+ #my $local = dbdef->table($table)->column($primary_key)->local;
+ ##next unless $default =~ /nextval/;
+ #print "$local\n";
+
+ my $statement = "select setval('${table}_${primary_key}_seq', ( select max($primary_key) from $table ) )";
+
+ print "$statement;\n";
+ next;
+
+ my $sth = dbh->prepare($statement) or do {
+ warn dbh->errstr. " preparing $statement\n";
+ next;
+ };
+ $sth->execute or do {
+ warn dbh->errstr. " executing $statement\n";
+ dbh->commit;
+ next;
+ }
+
+}
+
diff --git a/bin/shadow.reimport b/bin/shadow.reimport
new file mode 100755
index 000000000..7957011eb
--- /dev/null
+++ b/bin/shadow.reimport
@@ -0,0 +1,125 @@
+#!/usr/bin/perl -w
+#
+# -d: dry-run: make no changes
+# -r: replace: overwrite existing passwords (otherwise only "*" passwords will
+# be changed)
+# -b: blowfish replace: overwrite existing passwords only if they are
+# blowfish-encrypted
+
+use strict;
+use vars qw(%part_svc);
+use Getopt::Std;
+use Term::Query qw(query);
+use Net::SCP qw(iscp);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch qsearchs);
+use FS::svc_acct;
+use FS::part_svc;
+
+use vars qw($opt_d $opt_r $opt_b);
+getopts("drb");
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others?
+
+my($spooldir)="/usr/local/etc/freeside/export.". datasrc;
+
+#$FS::svc_acct::nossh_hack = 1;
+$FS::svc_Common::noexport_hack = 1;
+
+###
+
+%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
+
+die "No services with svcdb svc_acct!\n" unless %part_svc;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Enter part number or part numbers to import.
+END
+my($shell_svcpart)=&getvalue;
+my @shell_svcpart = split(/[,\s]+/, $shell_svcpart);
+
+print "\n\n", <<END;
+Enter the location and name of your _user_ shadow file, for example
+"mail.isp.com:/etc/shadow" or "bsd.isp.com:/etc/master.passwd"
+END
+my($loc_shadow)=&getvalue(":");
+iscp("root\@$loc_shadow", "$spooldir/shadow.import");
+
+sub menu_svc {
+ ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n";
+}
+sub getpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_svc ];
+ $^W=1;
+ $return;
+}
+sub getvalue {
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
+}
+
+print "\n\n";
+
+###
+
+open(SHADOW,"<$spooldir/shadow.import");
+
+my($line, $updated);
+while (<SHADOW>) {
+ $line++;
+ chop;
+ my($username,$password)=split(/:/);
+
+# my @svc_acct = grep { $_->cust_svc->svcpart == $shell_svcpart }
+# qsearch('svc_acct', { 'username' => $username } );
+ my @svc_acct = grep {
+ my $svcpart = $_->cust_svc->svcpart;
+ grep { $_ == $svcpart } @shell_svcpart;
+ } qsearch('svc_acct', { 'username' => $username } );
+
+ next unless @svc_acct;
+
+ if ( scalar(@svc_acct) > 1 ) {
+ die "more than one $username found!\n";
+ next;
+ }
+
+ my $svc_acct = shift @svc_acct;
+
+ next unless $svc_acct->_password eq '*'
+ || $opt_r
+ || ( $opt_b && $svc_acct->_password =~ /^\$2a?\$/ );
+
+ next if $svc_acct->username eq 'root';
+
+ next if $password eq 'NP' || $password eq '*LK*';
+
+ next if $svc_acct->_password eq $password;
+ next if $svc_acct->_password =~ /^\*SUSPENDED\*/;
+
+ my $new_svc_acct = new FS::svc_acct( { $svc_acct->hash } );
+ $new_svc_acct->_password($password);
+ #warn "$username: ". $svc_acct->_password. " -> $password\n";
+ warn "changing password for $username\n";
+ unless ( $opt_d ) {
+ my $error = $new_svc_acct->replace($svc_acct);
+ die "$username: $error" if $error;
+ }
+
+ $updated++;
+
+}
+
+warn "$updated of $line passwords changed\n";
+
+sub usage {
+ die "Usage:\n\n shadow.reimport [ -d ] [ -r ] user\n";
+}
+
diff --git a/bin/slony-setup b/bin/slony-setup
new file mode 100755
index 000000000..0798c1a03
--- /dev/null
+++ b/bin/slony-setup
@@ -0,0 +1,109 @@
+#!/usr/bin/perl
+#
+# slony replication setup
+#
+# usage: slony-setup freesideuser
+
+use strict;
+use DBI;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(dbdef);
+
+my $user = shift or die "usage: slony-setup username\n";
+adminsuidsetup($user);
+
+#---
+
+my $MASTERHOST = '192.168.20.10';
+my $SLAVEHOST = '192.168.20.50';
+#my $REPLICATIONUSER='pgsql';
+my $REPLICATIONUSER='postgres';
+
+#--------
+
+print <<END;
+
+#on slave:
+useradd freeside
+cp -pr /etc/skel /home/freeside
+chown -R freeside /home/freeside
+
+su postgres -c 'createuser freeside' #n y n
+su freeside -c 'createdb freeside'
+
+#on master:
+su postgres -c 'createlang plpgsql freeside'
+
+pg_dump -s -U $REPLICATIONUSER -h $MASTERHOST freeside | psql -U $REPLICATIONUSER -h $SLAVEHOST freeside
+
+END
+
+#--------
+
+#drop set ( id = 1, origin = 1);
+
+print <<END;
+#on master:
+slonik <<_EOF_
+
+cluster name = freeside;
+node 1 admin conninfo = 'dbname=freeside host=$MASTERHOST user=$REPLICATIONUSER';
+node 2 admin conninfo = 'dbname=freeside host=$SLAVEHOST user=$REPLICATIONUSER';
+init cluster ( id=1, comment = 'Master Node');
+
+create set (id=1, origin=1, comment='All freeside tables');
+
+END
+
+my $id = 1;
+
+foreach my $table ( dbdef->tables ) {
+ #next if $table =~ /^sql_/i;
+ print "set add table (set id=1, origin=1, id=". $id++. ", fully qualified name = 'public.$table' );\n";
+
+}
+
+print <<END;
+
+store node (id=2, comment = 'Slave node');
+store path (server = 1, client = 2, conninfo='dbname=freeside host=$MASTERHOST user=$REPLICATIONUSER');
+store path (server = 2, client = 1, conninfo='dbname=freeside host=$SLAVEHOST user=$REPLICATIONUSER');
+store listen (origin=1, provider = 1, receiver =2);
+store listen (origin=2, provider = 2, receiver =1);
+
+_EOF_
+END
+
+print <<END;
+
+### start slon processes (both machines) (this is debian-specific)
+mkdir /etc/slony1/freeside
+
+cat >/etc/slony1/freeside/slon.conf <<_EOF_
+# Set the cluster name that this instance of slon is running against
+# default is to read it off the command line
+cluster_name='freeside'
+
+# Set slon's connection info, default is to read it off the command line
+conn_info='host=localhost port=5432 dbname=freeside user=postgres'
+_EOF_
+
+/etc/init.d/slony1 start
+
+END
+
+
+print <<END;
+#on master:
+slonik <<_EOF_
+
+cluster name = freeside;
+
+node 1 admin conninfo = 'dbname=freeside host=$MASTERHOST user=$REPLICATIONUSER';
+node 2 admin conninfo = 'dbname=freeside host=$SLAVEHOST user=$REPLICATIONUSER';
+
+subscribe set ( id = 1, provider = 1, receiver = 2, forward = no);
+
+_EOF_
+END
+
diff --git a/bin/sqlradius-norealm.reimport b/bin/sqlradius-norealm.reimport
new file mode 100755
index 000000000..b7d016609
--- /dev/null
+++ b/bin/sqlradius-norealm.reimport
@@ -0,0 +1,113 @@
+#!/usr/bin/perl -Tw
+
+use strict;
+use vars qw(%part_svc);
+#use Date::Parse;
+use DBI;
+use Term::Query qw(query);
+use FS::UID qw(adminsuidsetup); #datasrc
+use FS::Record qw(qsearch qsearchs);
+use FS::svc_acct;
+use FS::part_svc;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+#push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others?
+
+$FS::svc_Common::noexport_hack = 1;
+
+###
+
+%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
+
+die "No services with svcdb svc_acct!\n" unless %part_svc;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Enter part number to import.
+END
+my $sqlradius_svcpart = &getpart;
+
+my $datasrc = &getvalue("\n\nEnter the DBI datasource:");
+my $db_user = &getvalue("\n\nEnter the database user:");
+my $db_pass = &getvalue("\n\nEnter the database password:");
+
+sub menu_svc {
+ ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n";
+}
+sub getpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_svc ];
+ $^W=1;
+ $return;
+}
+sub getvalue {
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
+}
+
+print "\n\n";
+
+###
+
+my $dbh = DBI->connect( $datasrc, $db_user, $db_pass )
+ or die $DBI::errstr;
+
+my $sth = $dbh->prepare('SELECT DISTINCT UserName FROM radcheck')
+ or die $dbh->errstr;
+$sth->execute or die $sth->errstr;
+
+my $row;
+while ( defined ( $row = $sth->fetchrow_arrayref ) ) {
+ my( $username ) = @$row;
+
+ my( $password, $group ) = ( '', '', '' );
+
+ my $rc_sth = $dbh->prepare(
+ 'SELECT Attribute, Value'.
+ ' FROM radcheck'.
+ ' WHERE UserName = ?'
+ ) or die $dbh->errstr;
+ $rc_sth->execute($username) or die $rc_sth->errstr;
+
+ foreach my $rc_row ( @{$rc_sth->fetchall_arrayref} ) {
+ my($attribute, $value) = @$rc_row;
+ if ( $attribute =~ /^((Crypt|User)-)?Password$/ ) {
+ $password = $value unless $password && !$1;
+ } else {
+ #handle other params!
+ }
+ }
+
+ my @svc_acct = grep { $_->cust_svc->svcpart == $sqlradius_svcpart }
+ qsearch('svc_acct', { 'username' => $username, } );
+
+ #print "$r_username / $realm: $password / $finger: ";
+ print "$username: $password: ";
+ if ( scalar(@svc_acct) == 0 ) {
+ print "not found\n";
+ next;
+ } elsif ( scalar(@svc_acct) > 1 ) {
+ print "multiple matches found?!?!\n";
+ next;
+ } else {
+ #print "correcting password and name\n";
+ print "correcting password\n";
+ }
+
+ my $svc_acct = $svc_acct[0];
+ #my $new = new FS::svc_acct { $svc_acct->hash, '_password' => $password, 'finger' => $finger };
+ my $new = new FS::svc_acct { $svc_acct->hash, '_password' => $password };
+ my $error = $new->replace($svc_acct);
+ #my $error = $new->check;
+ die "$username: $error" if $error;
+
+}
+
+sub usage {
+ die "Usage:\n\n sqlradius-norealm.reimport user\n";
+}
+
diff --git a/bin/sqlradius.import b/bin/sqlradius.import
new file mode 100644
index 000000000..e75f65b17
--- /dev/null
+++ b/bin/sqlradius.import
@@ -0,0 +1,152 @@
+#!/usr/bin/perl -Tw
+
+use strict;
+use vars qw(%part_svc %domain_part_svc);
+#use Date::Parse;
+use DBI;
+use Term::Query qw(query);
+use FS::UID qw(adminsuidsetup); #datasrc
+use FS::Record qw(qsearch qsearchs);
+use FS::svc_acct;
+use FS::part_svc;
+use FS::svc_domain;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+#push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others?
+
+$FS::svc_Common::noexport_hack = 1;
+$FS::svc_domain::whois_hack = 1;
+
+###
+
+%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
+
+die "No services with svcdb svc_acct!\n" unless %part_svc;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Enter part number to import.
+END
+my $sqlradius_svcpart = &getpart;
+
+%domain_part_svc = map { $_->svcpart, $_ }
+ qsearch('part_svc', { 'svcdb' => 'svc_domain'} );
+
+die "No services with svcdb svc_domain!\n" unless %domain_part_svc;
+
+print "\n\n", &menu_domain_svc, "\n", <<END;
+Enter part number for domains.
+END
+my $domain_svcpart = &getdomainpart;
+
+my $datasrc = &getvalue("\n\nEnter the DBI datasource:");
+my $db_user = &getvalue("\n\nEnter the database user:");
+my $db_pass = &getvalue("\n\nEnter the database password:");
+
+sub menu_svc {
+ ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n";
+}
+sub menu_domain_svc {
+ ( join "\n", map "$_: ".$domain_part_svc{$_}->svc, sort keys %domain_part_svc ). "\n";
+}
+sub getpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_svc ];
+ $^W=1;
+ $return;
+}
+sub getdomainpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %domain_part_svc ];
+ $^W=1;
+ $return;
+}
+sub getvalue {
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
+}
+
+print "\n\n";
+
+###
+
+my $dbh = DBI->connect( $datasrc, $db_user, $db_pass )
+ or die $DBI::errstr;
+
+my $sth = $dbh->prepare('SELECT DISTINCT UserName, Realm FROM radcheck')
+ or die $dbh->errstr;
+$sth->execute or die $sth->errstr;
+
+my $row;
+while ( defined ( $row = $sth->fetchrow_arrayref ) ) {
+ my( $r_username, $realm ) = @$row;
+
+ my( $username, $domain );
+ if ( $r_username =~ /^([^@]+)\@([^@]+)$/ ) {
+ $username = $1;
+ $domain = $2;
+ } else {
+ $username = $r_username;
+ $domain = $realm;
+ }
+ my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } )
+ || new FS::svc_domain {
+ 'domain' => $domain,
+ 'svcpart' => $domain_svcpart,
+ 'action' => 'N',
+ };
+ unless ( $svc_domain->svcnum ) {
+ my $error = $svc_domain->insert;
+ if ( $error ) {
+ die "can't insert domain $domain: $error\n";
+ }
+ }
+
+ my( $password, $finger, $group ) = ( '', '', '' );
+
+ my $rc_sth = $dbh->prepare(
+ 'SELECT Attribute, Value, Name, GroupName'.
+ ' FROM radcheck'.
+ ' WHERE UserName = ? and Realm = ?'
+ ) or die $dbh->errstr;
+ $rc_sth->execute($r_username, $realm) or die $rc_sth->errstr;
+
+ foreach my $rc_row ( @{$rc_sth->fetchall_arrayref} ) {
+ my($attribute, $value, $name, $groupname) = @$rc_row;
+ if ( $attribute =~ /^((User|Crypt)-)?Password$/ ) {
+ $password = $value;
+ $finger = $name;
+ $group = $groupname;
+ } else {
+ #handle other params!
+ }
+ }
+
+ my $svc_acct = new FS::svc_acct {
+ 'svcpart' => $sqlradius_svcpart,
+ 'username' => $username,
+ 'domsvc' => $svc_domain->svcnum,
+ '_password' => $password,
+ 'finger' => $finger,
+ };
+
+ my $error = $svc_acct->insert;
+ #my $error = $svc_acct->check;
+ if ( $error ) {
+ if ( $error =~ /duplicate/i ) {
+ warn "$r_username / $realm: $error";
+ } else {
+ die "$r_username / $realm: $error";
+ }
+ }
+
+}
+
+sub usage {
+ die "Usage:\n\n sqlradius.import user\n";
+}
+
diff --git a/bin/sqlradius.reimport b/bin/sqlradius.reimport
new file mode 100755
index 000000000..2218a3f13
--- /dev/null
+++ b/bin/sqlradius.reimport
@@ -0,0 +1,160 @@
+#!/usr/bin/perl -Tw
+
+use strict;
+use vars qw(%part_svc %domain_part_svc);
+#use Date::Parse;
+use DBI;
+use Term::Query qw(query);
+use FS::UID qw(adminsuidsetup); #datasrc
+use FS::Record qw(qsearch qsearchs);
+use FS::svc_acct;
+use FS::part_svc;
+use FS::svc_domain;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+#push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others?
+
+$FS::svc_Common::noexport_hack = 1;
+$FS::svc_domain::whois_hack = 1;
+
+###
+
+%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
+
+die "No services with svcdb svc_acct!\n" unless %part_svc;
+
+print "\n\n", &menu_svc, "\n", <<END;
+Enter part number to import.
+END
+my $sqlradius_svcpart = &getpart;
+
+%domain_part_svc = map { $_->svcpart, $_ }
+ qsearch('part_svc', { 'svcdb' => 'svc_domain'} );
+
+die "No services with svcdb svc_domain!\n" unless %domain_part_svc;
+
+print "\n\n", &menu_domain_svc, "\n", <<END;
+Enter part number for domains.
+END
+my $domain_svcpart = &getdomainpart;
+
+my $datasrc = &getvalue("\n\nEnter the DBI datasource:");
+my $db_user = &getvalue("\n\nEnter the database user:");
+my $db_pass = &getvalue("\n\nEnter the database password:");
+
+sub menu_svc {
+ ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n";
+}
+sub menu_domain_svc {
+ ( join "\n", map "$_: ".$domain_part_svc{$_}->svc, sort keys %domain_part_svc ). "\n";
+}
+sub getpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_svc ];
+ $^W=1;
+ $return;
+}
+sub getdomainpart {
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %domain_part_svc ];
+ $^W=1;
+ $return;
+}
+sub getvalue {
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
+}
+
+print "\n\n";
+
+###
+
+my $dbh = DBI->connect( $datasrc, $db_user, $db_pass )
+ or die $DBI::errstr;
+
+my $sth = $dbh->prepare('SELECT DISTINCT UserName, Realm FROM radcheck')
+ or die $dbh->errstr;
+$sth->execute or die $sth->errstr;
+
+my $row;
+while ( defined ( $row = $sth->fetchrow_arrayref ) ) {
+ my( $r_username, $realm ) = @$row;
+
+ my( $username, $domain );
+ if ( $r_username =~ /^([^@]+)\@([^@]+)$/ ) {
+ $username = $1;
+ $domain = $2;
+ } else {
+ $username = $r_username;
+ $domain = $realm;
+ }
+ my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } )
+ || new FS::svc_domain {
+ 'domain' => $domain,
+ 'svcpart' => $domain_svcpart,
+ 'action' => 'N',
+ };
+ unless ( $svc_domain->svcnum ) {
+ die "new domain? wtf";
+ my $error = $svc_domain->insert;
+ if ( $error ) {
+ die "can't insert domain $domain: $error\n";
+ }
+ }
+
+ #my( $password, $finger, $group ) = ( '', '', '' );
+ my( $password, $group ) = ( '', '', '' );
+
+ my $rc_sth = $dbh->prepare(
+ 'SELECT Attribute, Value, Name, GroupName'.
+ ' FROM radcheck'.
+ ' WHERE UserName = ? and Realm = ?'
+ ) or die $dbh->errstr;
+ $rc_sth->execute($r_username, $realm) or die $rc_sth->errstr;
+
+ foreach my $rc_row ( @{$rc_sth->fetchall_arrayref} ) {
+ my($attribute, $value, $name, $groupname) = @$rc_row;
+ if ( $attribute =~ /^((Crypt|User)-)?Password$/ ) {
+ $password = $value;
+ #$finger = $name;
+ $group = $groupname;
+ } else {
+ #handle other params!
+ }
+ }
+
+ my @svc_acct = grep { $_->cust_svc->svcpart == $sqlradius_svcpart }
+ qsearch('svc_acct', { 'username' => $username,
+ 'domsvc' => $svc_domain->svcnum, } );
+
+ #print "$r_username / $realm: $password / $finger: ";
+ print "$r_username / $realm: $password: ";
+ if ( scalar(@svc_acct) == 0 ) {
+ print "not found\n";
+ next;
+ } elsif ( scalar(@svc_acct) > 1 ) {
+ print "multiple matches found?!?!\n";
+ next;
+ } else {
+ #print "correcting password and name\n";
+ print "correcting password\n";
+ }
+
+ my $svc_acct = $svc_acct[0];
+ #my $new = new FS::svc_acct { $svc_acct->hash, '_password' => $password, 'finger' => $finger };
+ my $new = new FS::svc_acct { $svc_acct->hash, '_password' => $password };
+ my $error = $new->replace($svc_acct);
+ #my $error = $new->check;
+ die "$r_username / $realm: $error" if $error;
+
+}
+
+sub usage {
+ die "Usage:\n\n sqlradius.reimport user\n";
+}
+
diff --git a/bin/strip-eps b/bin/strip-eps
new file mode 100755
index 000000000..2c2d124d7
--- /dev/null
+++ b/bin/strip-eps
@@ -0,0 +1,20 @@
+#!/usr/bin/perl -w
+
+# Author: Andy Turner <andrew.turner@acadia.net>
+
+use strict;
+
+# The first line has some binary magic for file identification
+# purposes. GhostScript doesn't like it. Strip it.
+scalar <>;
+
+# Add a header so that we can use magic to determine the file type.
+print "%!PS-Adobe-3.0 EPSF-3.0\n";
+
+while (<>) {
+ print;
+
+ # Illustrator Version 7 format EPS files have a bunch of binary gook
+ # after the "%%EOF" line. (% is a comment in PostScript, right?)
+ last if /^%%EOF/;
+}
diff --git a/bin/svc_acct.export b/bin/svc_acct.export
deleted file mode 100755
index 3f65a08ba..000000000
--- a/bin/svc_acct.export
+++ /dev/null
@@ -1,351 +0,0 @@
-#!/usr/bin/perl -Tw
-#
-# Create and export password files: passwd, passwd.adjunct, shadow,
-# acp_passwd, acp_userinfo, acp_dialup, users
-#
-# ivan@voicenet.com late august/september 96
-# (the password encryption bits were from melody)
-#
-# use a temporary copy of svc_acct to minimize lock time on the real file,
-# and skip blank entries.
-#
-# ivan@voicenet.com 96-Oct-6
-#
-# change users / acp_dialup file formats
-# ivan@voicenet.com 97-jan-28-31
-#
-# change priority (after copies) to 19, not 10
-# ivan@voicenet.com 97-feb-5
-#
-# added exit if stuff is already locked 97-apr-15
-#
-# rewrite ivan@sisd.com 98-mar-9
-#
-# Changed 'password' to '_password' because Pg6.3 reserves this word
-# Added code to create a FreeBSD style master.passwd file
-# bmccane@maxbaud.net 98-Apr-3
-#
-# don't export non-root 0 UID's, even if they get put in the database
-# ivan@sisd.com 98-jul-14
-#
-# Uses Idle_Timeout, Port_Limit, Framed_Netmask and Framed_Route if they
-# exist; need some way to support arbitrary radius fields. also
-# /var/spool/freeside/conf/ ivan@sisd.com 98-jul-26, aug-9
-#
-# OOPS! added arbitrary radius fields (pry 98-aug-16) but forgot to say so.
-# ivan@sisd.com 98-sep-18
-
-use strict;
-use Fcntl qw(:flock);
-use FS::SSH qw(scp ssh);
-use FS::UID qw(adminsuidsetup);
-use FS::Record qw(qsearch fields);
-
-my($fshellmachines)="/var/spool/freeside/conf/shellmachines";
-my(@shellmachines);
-if ( -e $fshellmachines ) {
- open(SHELLMACHINES,$fshellmachines);
- @shellmachines=map {
- /^(.*)$/ or die "Illegal line in conf/shellmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <SHELLMACHINES>;
- close SHELLMACHINES;
-}
-
-my($fbsdshellmachines)="/var/spool/freeside/conf/bsdshellmachines";
-my(@bsdshellmachines);
-if ( -e $fbsdshellmachines ) {
- open(BSDSHELLMACHINES,$fbsdshellmachines);
- @bsdshellmachines=map {
- /^(.*)$/ or die "Illegal line in conf/bsdshellmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <BSDSHELLMACHINES>;
- close BSDSHELLMACHINES;
-}
-
-my($fnismachines)="/var/spool/freeside/conf/nismachines";
-my(@nismachines);
-if ( -e $fnismachines ) {
- open(NISMACHINES,$fnismachines);
- @nismachines=map {
- /^(.*)$/ or die "Illegal line in conf/nismachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <NISMACHINES>;
- close NISMACHINES;
-}
-
-my($ferpcdmachines)="/var/spool/freeside/conf/erpcdmachines";
-my(@erpcdmachines);
-if ( -e $ferpcdmachines ) {
- open(ERPCDMACHINES,$ferpcdmachines);
- @erpcdmachines=map {
- /^(.*)$/ or die "Illegal line in conf/erpcdmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <ERPCDMACHINES>;
- close ERPCDMACHINES;
-}
-
-my($fradiusmachines)="/var/spool/freeside/conf/radiusmachines";
-my(@radiusmachines);
-if ( -e $fradiusmachines ) {
- open(RADIUSMACHINES,$fradiusmachines);
- @radiusmachines=map {
- /^(.*)$/ or die "Illegal line in conf/radiusmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <RADIUSMACHINES>;
- close RADIUSMACHINES;
-}
-
-my($spooldir)="/var/spool/freeside/export";
-my($spoollock)="/var/spool/freeside/svc_acct.export.lock";
-
-adminsuidsetup;
-
-my(@saltset)= ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
-srand(time|$$);
-
-open(EXPORT,"+>>$spoollock") or die "Can't open $spoollock: $!";
-select(EXPORT); $|=1; select(STDOUT);
-unless ( flock(EXPORT,LOCK_EX|LOCK_NB) ) {
- seek(EXPORT,0,0);
- my($pid)=<EXPORT>;
- chop($pid);
- #no reason to start loct of blocking processes
- die "Is another export process running under pid $pid?\n";
-}
-seek(EXPORT,0,0);
-print EXPORT $$,"\n";
-
-my(@svc_acct)=qsearch('svc_acct',{});
-
-( open(MASTER,">$spooldir/master.passwd")
- and flock(MASTER,LOCK_EX|LOCK_NB)
-) or die "Can't open $spooldir/master.passwd: $!";
-( open(PASSWD,">$spooldir/passwd")
- and flock(PASSWD,LOCK_EX|LOCK_NB)
-) or die "Can't open $spooldir/passwd: $!";
-( open(SHADOW,">$spooldir/shadow")
- and flock(SHADOW,LOCK_EX|LOCK_NB)
-) or die "Can't open $spooldir/shadow: $!";
-( open(ACP_PASSWD,">$spooldir/acp_passwd")
- and flock (ACP_PASSWD,LOCK_EX|LOCK_NB)
-) or die "Can't open $spooldir/acp_passwd: $!";
-( open (ACP_DIALUP,">$spooldir/acp_dialup")
- and flock(ACP_DIALUP,LOCK_EX|LOCK_NB)
-) or die "Can't open $spooldir/acp_dialup: $!";
-( open (USERS,">$spooldir/users")
- and flock(USERS,LOCK_EX|LOCK_NB)
-) or die "Can't open $spooldir/users: $!";
-
-chmod 0644, "$spooldir/passwd",
- "$spooldir/acp_dialup",
-;
-chmod 0600, "$spooldir/master.passwd",
- "$spooldir/acp_passwd",
- "$spooldir/shadow",
- "$spooldir/users",
-;
-
-setpriority(0,0,10);
-
-my($svc_acct);
-foreach $svc_acct (@svc_acct) {
-
- my($password)=$svc_acct->getfield('_password');
- my($cpassword,$rpassword);
- if ( ( length($password) <= 8 )
- && ( $password ne '*' )
- && ( $password ne '' )
- ) {
- $cpassword=crypt($password,
- $saltset[int(rand(64))].$saltset[int(rand(64))]
- );
- $rpassword=$password;
- } else {
- $cpassword=$password;
- $rpassword='UNIX';
- }
-
- if ( $svc_acct->uid =~ /^(\d+)$/ ) {
-
- die "Non-root user ". $svc_acct->username. " has 0 UID!"
- if $svc_acct->uid == 0 && $svc_acct->username ne 'root';
-
- ###
- # FORMAT OF FreeBSD MASTER PASSWD FILE HERE
- print MASTER join(":",
- $svc_acct->username, # User name
- $cpassword, # Encrypted password
- $svc_acct->uid, # User ID
- $svc_acct->gid, # Group ID
- "", # Login Class
- "0", # Password Change Time
- "0", # Password Expiration Time
- $svc_acct->finger, # Users name
- $svc_acct->dir, # Users home directory
- $svc_acct->shell, # shell
- ), "\n" ;
-
- ###
- # FORMAT OF THE PASSWD FILE HERE
- print PASSWD join(":",
- $svc_acct->username,
- 'x', # "##". $svc_acct->$username,
- $svc_acct->uid,
- $svc_acct->gid,
- $svc_acct->finger,
- $svc_acct->dir,
- $svc_acct->shell,
- ), "\n";
-
- ###
- # FORMAT OF THE SHADOW FILE HERE
- print SHADOW join(":",
- $svc_acct->username,
- $cpassword,
- '',
- '',
- '',
- '',
- '',
- '',
- '',
- ), "\n";
-
- }
-
- if ( $svc_acct->slipip ne '' ) {
-
- ###
- # FORMAT OF THE ACP_* FILES HERE
- print ACP_PASSWD join(":",
- $svc_acct->username,
- $cpassword,
- "0",
- "0",
- "",
- "",
- "",
- ), "\n";
-
- my($ip)=$svc_acct->slipip;
-
- unless ( $ip eq '0.0.0.0' || $svc_acct->slipip eq '0e0' ) {
- print ACP_DIALUP $svc_acct->username, "\t*\t", $svc_acct->slipip, "\n";
- }
-
- ###
- # FORMAT OF THE USERS FILE HERE
- print USERS
- $svc_acct->username, qq(\tPassword = "$rpassword"\n\t),
-
- join ",\n\t",
- map {
- /^(radius_(.*))$/;
- my($field,$attrib)=($1,$2);
- $attrib =~ s/_/\-/g;
- "$attrib = \"". $svc_acct->getfield($field). "\"";
- } grep /^radius_/ && $svc_acct->getfield($_), fields('svc_acct')
- ;
- if ( $ip && $ip ne '0e0' ) {
- print USERS qq(,\n\tFramed-Address = "$ip"\n\n);
- } else {
- print USERS qq(\n\n);
- }
-
- }
-
-}
-
-flock(MASTER,LOCK_UN);
-flock(PASSWD,LOCK_UN);
-flock(SHADOW,LOCK_UN);
-flock(ACP_DIALUP,LOCK_UN);
-flock(ACP_PASSWD,LOCK_UN);
-flock(USERS,LOCK_UN);
-
-close MASTER;
-close PASSWD;
-close SHADOW;
-close ACP_DIALUP;
-close ACP_PASSWD;
-close USERS;
-
-###
-# export stuff
-#
-
-my($shellmachine);
-foreach $shellmachine (@shellmachines) {
- scp("$spooldir/passwd","root\@$shellmachine:/etc/passwd.new")
- == 0 or die "scp error: $!";
- scp("$spooldir/shadow","root\@$shellmachine:/etc/shadow.new")
- == 0 or die "scp error: $!";
- ssh("root\@$shellmachine",
- "( ".
- "mv /etc/passwd.new /etc/passwd; ".
- "mv /etc/shadow.new /etc/shadow; ".
- " )"
- )
- == 0 or die "ssh error: $!";
-}
-
-my($bsdshellmachine);
-foreach $bsdshellmachine (@bsdshellmachines) {
- scp("$spooldir/passwd","root\@$bsdshellmachine:/etc/passwd.new")
- == 0 or die "scp error: $!";
- scp("$spooldir/master.passwd","root\@$bsdshellmachine:/etc/master.passwd.new")
- == 0 or die "scp error: $!";
- ssh("root\@$bsdshellmachine",
- "( ".
- "mv /etc/passwd.new /etc/passwd; ".
- "mv /etc/master.passwd.new /etc/master.passwd; ".
- " )"
- )
- == 0 or die "ssh error: $!";
-}
-
-my($nismachine);
-foreach $nismachine (@nismachines) {
- scp("$spooldir/passwd","root\@$nismachine:/etc/global/passwd")
- == 0 or die "scp error: $!";
- scp("$spooldir/shadow","root\@$nismachine:/etc/global/shadow")
- == 0 or die "scp error: $!";
- ssh("root\@$nismachine",
- "( ".
- "cd /var/yp; make; ".
- " )"
- )
- == 0 or die "ssh error: $!";
-}
-
-my($erpcdmachine);
-foreach $erpcdmachine (@erpcdmachines) {
- scp("$spooldir/acp_passwd","root\@$erpcdmachine:/usr/annex/acp_passwd")
- == 0 or die "scp error: $!";
- scp("$spooldir/acp_dialup","root\@$erpcdmachine:/usr/annex/acp_dialup")
- == 0 or die "scp error: $!";
- ssh("root\@$erpcdmachine",
- "( ".
- "kill -USR1 \`cat /usr/annex/erpcd.pid\'".
- " )"
- )
- == 0 or die "ssh error: $!";
-}
-
-my($radiusmachine);
-foreach $radiusmachine (@radiusmachines) {
- scp("$spooldir/users","root\@$radiusmachine:/etc/raddb/users")
- == 0 or die "scp error: $!";
- ssh("root\@$erpcdmachine",
- "( ".
- "builddbm".
- " )"
- )
- == 0 or die "ssh error: $!";
-}
-
-unlink $spoollock;
-flock(EXPORT,LOCK_UN);
-close EXPORT;
-
diff --git a/bin/svc_acct.import b/bin/svc_acct.import
index c4b8c5ec5..aff26b943 100755
--- a/bin/svc_acct.import
+++ b/bin/svc_acct.import
@@ -1,31 +1,21 @@
#!/usr/bin/perl -Tw
-#
-# ivan@sisd.com 98-mar-9
-#
-# changed 'password' field to '_password' because PgSQL 6.3 reserves this word
-# bmccane@maxbaud.net 98-Apr-3
-#
-# generalized svcparts (still needs radius import) ivan@sisd.com 98-mar-23
-#
-# radius import, now an interactive script. still needs erpcd import?
-# ivan@sisd.com 98-jun-24
-#
-# arbitrary radius attributes ivan@sisd.com 98-aug-9
-#
-# don't import /var/spool/freeside/conf/shells! ivan@sisd.com 98-aug-13
use strict;
use vars qw(%part_svc);
use Date::Parse;
-use FS::SSH qw(iscp);
-use FS::UID qw(adminsuidsetup);
+use Term::Query qw(query);
+use Net::SCP qw(iscp);
+use FS::UID qw(adminsuidsetup datasrc);
use FS::Record qw(qsearch);
use FS::svc_acct;
+use FS::part_svc;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
-adminsuidsetup;
+push @FS::svc_acct::shells, qw(/bin/sync /sbin/shuddown /bin/halt); #others?
-#my($spooldir)="/var/spool/freeside/export";
-my($spooldir)="unix/";
+my($spooldir)="/usr/local/etc/freeside/export.". datasrc;
$FS::svc_acct::nossh_hack = 1;
@@ -33,6 +23,8 @@ $FS::svc_acct::nossh_hack = 1;
%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'});
+die "No services with svcdb svc_acct!\n" unless %part_svc;
+
print "\n\n", &menu_svc, "\n", <<END;
Most accounts probably have entries in passwd and users (with Port-Limit
nonexistant or 1).
@@ -58,8 +50,7 @@ my($oisdn_svcpart)=&getpart;
print "\n\n", &menu_svc, "\n", <<END;
POP mail accounts have entries in passwd only, and have a particular shell.
END
-print "Enter that shell: ";
-my($pop_shell)=&getvalue;
+my($pop_shell)=&getvalue("Enter that shell:");
my($popmail_svcpart)=&getpart;
print "\n\n", &menu_svc, "\n", <<END;
@@ -71,37 +62,38 @@ print "\n\n", <<END;
Enter the location and name of your _user_ passwd file, for example
"mail.isp.com:/etc/passwd" or "nis.isp.com:/etc/global/passwd"
END
-print ":";
-my($loc_passwd)=&getvalue;
+my($loc_passwd)=&getvalue(":");
iscp("root\@$loc_passwd", "$spooldir/passwd.import");
print "\n\n", <<END;
Enter the location and name of your _user_ shadow file, for example
"mail.isp.com:/etc/shadow" or "bsd.isp.com:/etc/master.passwd"
END
-print ":";
-my($loc_shadow)=&getvalue;
+my($loc_shadow)=&getvalue(":");
iscp("root\@$loc_shadow", "$spooldir/shadow.import");
print "\n\n", <<END;
Enter the location and name of your radius "users" file, for example
"radius.isp.com:/etc/raddb/users"
END
-print ":";
-my($loc_users)=&getvalue;
+my($loc_users)=&getvalue(":");
iscp("root\@$loc_users", "$spooldir/users.import");
sub menu_svc {
( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n";
}
sub getpart {
- print "Enter part number, or 0 for none: ";
- &getvalue;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query "Enter part number:", 'irk', [ keys %part_svc ];
+ $^W=1;
+ $return;
}
sub getvalue {
- my($x)=scalar(<STDIN>);
- chop $x;
- $x;
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
}
print "\n\n";
@@ -116,12 +108,14 @@ my(%upassword,%ip,%allparam);
my(%param,$username);
while (<USERS>) {
chop;
- next if /^$/;
+ next if /^\s*$/;
+ next if /^\s*#/;
if ( /^\S/ ) {
- /^(\w+)\s+Password\s+=\s+"([^"]+)"(,\s+Expiration\s+=\s+"([^"]*")\s*)?$/
+ /^(\w+)\s+(Auth-Type\s+=\s+Local,\s+)?Password\s+=\s+"([^"]+)"(,\s+Expiration\s+=\s+"([^"]*")\s*)?$/
or die "1Unexpected line in users.import: $_";
my($password,$expiration);
- ($username,$password,$expiration)=(lc($1),$2,$4);
+ ($username,$password,$expiration)=(lc($1),$3,$5);
+ $password = '' if $password eq 'UNIX';
$upassword{$username}=$password;
undef %param;
} else {
@@ -130,8 +124,12 @@ while (<USERS>) {
while (<USERS>) {
chop;
if ( /^\s*$/ ) {
- $ip{$username}=$param{'radius_Framed_IP_Address'}||'0e0';
- delete $param{'radius_Framed_IP_Address'};
+ if ( defined $param{'radius_Framed_IP_Address'} ) {
+ $ip{$username} = $param{'radius_Framed_IP_Address'};
+ delete $param{'radius_Framed_IP_Address'};
+ } else {
+ $ip{$username} = '0e0';
+ }
$allparam{$username}={ %param };
last;
} elsif ( /^\s+([\w\-]+)\s=\s"?([\w\.\-\s]+)"?,?\s*$/ ) {
@@ -144,14 +142,20 @@ while (<USERS>) {
}
}
#? incase there isn't a terminating blank line ?
-$ip{$username}=$param{'radius_Framed_IP_Address'}||'0e0';
-delete $param{'radius_Framed_IP_Address'};
+if ( defined $param{'radius_Framed_IP_Address'} ) {
+ $ip{$username} = $param{'radius_Framed_IP_Address'};
+ delete $param{'radius_Framed_IP_Address'};
+} else {
+ $ip{$username} = '0e0';
+}
$allparam{$username}={ %param };
my(%password);
while (<SHADOW>) {
chop;
my($username,$password)=split(/:/);
+ #$password =~ s/^\!$/\*/;
+ #$password =~ s/\!+/\*SUSPENDED\* /;
$password{$username}=$password;
}
@@ -176,16 +180,16 @@ while (<PASSWD>) {
$svcpart = $shell_svcpart;
}
- my($svc_acct) = create FS::svc_acct ({
- 'svcpart' => $svcpart,
- 'username' => $username,
- 'password' => $password,
- 'uid' => $uid,
- 'gid' => $gid,
- 'finger' => $finger,
- 'dir' => $dir,
- 'shell' => $shell,
- 'slipip' => $ip{$username},
+ my($svc_acct) = new FS::svc_acct ({
+ 'svcpart' => $svcpart,
+ 'username' => $username,
+ '_password' => $password,
+ 'uid' => $uid,
+ 'gid' => $gid,
+ 'finger' => $finger,
+ 'dir' => $dir,
+ 'shell' => $shell,
+ 'slipip' => $ip{$username},
%{$allparam{$username}},
});
my($error);
@@ -210,11 +214,11 @@ foreach $username ( keys %upassword ) {
die "Illegal Port-Limit in users!\n";
}
- my($svc_acct) = create FS::svc_acct ({
- 'svcpart' => $svcpart,
- 'username' => $username,
- 'password' => $password,
- 'slipip' => $ip{$username},
+ my($svc_acct) = new FS::svc_acct ({
+ 'svcpart' => $svcpart,
+ 'username' => $username,
+ '_password' => $password,
+ 'slipip' => $ip{$username},
%{$allparam{$username}},
});
my($error);
@@ -225,3 +229,9 @@ foreach $username ( keys %upassword ) {
delete $upassword{$username};
}
+#
+
+sub usage {
+ die "Usage:\n\n svc_acct.import user\n";
+}
+
diff --git a/bin/svc_acct_pop.import b/bin/svc_acct_pop.import
new file mode 100755
index 000000000..9e3d38bfe
--- /dev/null
+++ b/bin/svc_acct_pop.import
@@ -0,0 +1,59 @@
+#!/usr/bin/perl
+
+use strict;
+use Text::CSV_XS;
+use FS::UID qw(adminsuidsetup);
+use FS::svc_acct_pop;
+
+my @fields = qw( ac loc state city exch );
+my $fixup = sub {
+ my $hash = shift;
+ $hash->{ac} =~ /^\s*(\d{3})\s*$/;
+ $hash->{ac} = $1;
+ $hash->{loc} =~ /^\s*(\d{3})(\d{4})\s*$/;
+ $hash->{exch} = $1;
+ $hash->{loc} = $2;
+ $hash->{state} =~ /^\s*(\S{0,2})\s*$/;
+ $hash->{state} = $1;
+ $hash->{city} =~ /^\s*(.*?)\s*$/;
+ $hash->{city} = $1;
+
+ };
+
+my $user = shift or usage();
+adminsuidsetup $user;
+
+my $file = shift or usage();
+my $csv = new Text::CSV_XS;
+
+open(FH, $file) or die "cannot open $file: $!";
+
+sub usage {
+ die "Usage:\n\n svc_acct_pop.import user popfile.csv\n\n";
+}
+
+###
+
+my $line;
+while ( defined($line=<FH>) ) {
+ chomp $line;
+
+ $line &= "\177" x length($line); # i hope this isn't really necessary
+ $csv->parse($line)
+ or die "cannot parse: " . $csv->error_input();
+
+ my @values = $csv->fields();
+ my %hash;
+ foreach my $field (@fields) {
+ $hash{$field} = shift @values;
+ }
+
+ &{$fixup}(\%hash);
+
+ my $svc_acct_pop = new FS::svc_acct_pop { %hash };
+
+ #my $error = $svc_acct_pop->check;
+ my $error = $svc_acct_pop->insert;
+ die $error if $error;
+
+}
diff --git a/bin/svc_acct_sm.export b/bin/svc_acct_sm.export
deleted file mode 100755
index c2ec1e53f..000000000
--- a/bin/svc_acct_sm.export
+++ /dev/null
@@ -1,221 +0,0 @@
-#!/usr/bin/perl -Tw
-#
-# Create and export VoiceNet_quasar.m4
-#
-# ivan@voicenet.com late oct 96
-#
-# change priority (after copies) to 19, not 10
-# ivan@voicenet.com 97-feb-5
-#
-# put file in different place and run different script, as per matt and
-# mohamed
-# ivan@voicenet.com 97-mar-10
-#
-# added exit if stuff is already locked ivan@voicenet.com 97-apr-15
-#
-# removed mail2
-# ivan@voicenet.com 97-jul-10
-#
-# rewrote lots of the bits, now exports qmail "virtualdomain",
-# "recipientmap" and "rcpthosts" files as well
-#
-# ivan@voicenet.com 97-sep-4
-#
-# adds ".extra" files
-#
-# ivan@voicenet.com 97-sep-29
-#
-# added ".pp" files, ugh.
-#
-# ivan@voicenet.com 97-oct-1
-#
-# rewrite ivan@sisd.com 98-mar-9
-#
-# now can create .qmail-default files ivan@sisd.com 98-mar-10
-#
-# put example $my_domain declaration in ivan@sisd.com 98-mar-23
-#
-# /var/spool/freeside/conf and sendmail updates ivan@sisd.com 98-aug-14
-
-use strict;
-use Fcntl qw(:flock);
-use FS::SSH qw(ssh scp);
-use FS::UID qw(adminsuidsetup);
-use FS::Record qw(qsearch qsearchs);
-
-my($conf_shellm)="/var/spool/freeside/conf/shellmachine";
-my($fqmailmachines)="/var/spool/freeside/conf/qmailmachines";
-my($shellmachine);
-my(@qmailmachines);
-if ( -e $fqmailmachines ) {
- open(SHELLMACHINE,$conf_shellm) or die "Can't open $conf_shellm: $!";
- <SHELLMACHINE> =~ /^([\w\.\-]+)$/ or die "Illegal $conf_shellm";
- $shellmachine = $1;
- close SHELLMACHINE;
- open(QMAILMACHINES,$fqmailmachines);
- @qmailmachines=map {
- /^(.*)$/ or die "Illegal line in conf/qmailmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <QMAILMACHINES>;
- close QMAILMACHINES;
-}
-
-my($fsendmailmachines)="/var/spool/freeside/conf/sendmailmachines";
-my(@sendmailmachines);
-if ( -e $fsendmailmachines ) {
- open(SENDMAILMACHINES,$fsendmailmachines);
- @sendmailmachines=map {
- /^(.*)$/ or die "Illegal line in conf/sendmailmachines"; #we trust the file
- $1;
- } grep $_ !~ /^(#|$)/, <SENDMAILMACHINES>;
- close SENDMAILMACHINES;
-}
-
-my($conf_domain)="/var/spool/freeside/conf/domain";
-open(DOMAIN,$conf_domain) or die "Can't open $conf_domain: $!";
-my($mydomain)=map {
- /^(.*)$/ or die "Illegal line in $conf_domain!"; #yes, we trust the file
- $1
-} grep $_ !~ /^(#|$)/, <DOMAIN>;
-close DOMAIN;
-
-my($spooldir)="/var/spool/freeside/export";
-my($spoollock)="/var/spool/freeside/svc_acct_sm.export.lock";
-
-adminsuidsetup;
-umask 066;
-
-open(EXPORT,"+>>$spoollock") or die "Can't open $spoollock: $!";
-select(EXPORT); $|=1; select(STDOUT);
-unless ( flock(EXPORT,LOCK_EX|LOCK_NB) ) {
- seek(EXPORT,0,0);
- my($pid)=<EXPORT>;
- chop($pid);
- #no reason to start locks of blocking processes
- die "Is another export process running under pid $pid?\n";
-}
-seek(EXPORT,0,0);
-print EXPORT $$,"\n";
-
-my(@svc_acct_sm)=qsearch('svc_acct_sm',{});
-
-( open(RCPTHOSTS,">$spooldir/rcpthosts")
- and flock(RCPTHOSTS,LOCK_EX|LOCK_NB)
-) or die "Can't open $spooldir/rcpthosts: $!";
-( open(RECIPIENTMAP,">$spooldir/recipientmap")
- and flock(RECIPIENTMAP,LOCK_EX|LOCK_NB)
-) or die "Can't open $spooldir/recipientmap: $!";
-( open(VIRTUALDOMAINS,">$spooldir/virtualdomains")
- and flock(VIRTUALDOMAINS,LOCK_EX|LOCK_NB)
-) or die "Can't open $spooldir/virtualdomains: $!";
-( open(VIRTUSERTABLE,">$spooldir/virtusertable")
- and flock(VIRTUSERTABLE,LOCK_EX|LOCK_NB)
-) or die "Can't open $spooldir/virtusertable: $!";
-( open(SENDMAIL_CW,">$spooldir/sendmail.cw")
- and flock(SENDMAIL_CW,LOCK_EX|LOCK_NB)
-) or die "Can't open $spooldir/sendmail.cw: $!";
-
-setpriority(0,0,10);
-
-my($svc_domain,%domain);
-foreach $svc_domain ( qsearch('svc_domain',{}) ) {
- my($domain)=$svc_domain->domain;
- $domain{$svc_domain->svcnum}=$domain;
- print RCPTHOSTS "$domain\n.$domain\n";
- print SENDMAIL_CW "$domain\n";
-}
-
-my(@sendmail);
-
-my($svc_acct_sm);
-foreach $svc_acct_sm ( qsearch('svc_acct_sm') ) {
- my($domsvc,$domuid,$domuser)=(
- $svc_acct_sm->domsvc,
- $svc_acct_sm->domuid,
- $svc_acct_sm->domuser,
- );
- my($domain)=$domain{$domsvc};
- my($svc_acct)=qsearchs('svc_acct',{'uid'=>$domuid});
- my($username,$dir,$uid,$gid)=(
- $svc_acct->username,
- $svc_acct->dir,
- $svc_acct->uid,
- $svc_acct->gid,
- );
- next unless $username && $domain && $domuser;
-
- if ($domuser eq '*') {
- push @sendmail, "\@$domain\t$username\n";
- print VIRTUALDOMAINS "$domain:$username-$domain\n",
- ".$domain:$username-$domain\n",
- ;
- ###
- # qmail
- ssh("root\@$shellmachine",
- "[ -e $dir/.qmail-default ] || { touch $dir/.qmail-default; chown $uid:$gid $dir/.qmail-default; }"
- ) if ( $shellmachine && $dir && $uid );
-
- } else {
- print VIRTUSERTABLE "$domuser\@$domain\t$username\n";
- print RECIPIENTMAP "$domuser\@$domain:$username\@$mydomain\n";
- }
-
- print VIRTUSERTABLE @sendmail;
-
-}
-
-chmod 0644, "$spooldir/sendmail.cw",
- "$spooldir/virtusertable",
- "$spooldir/rcpthosts",
- "$spooldir/recipientmap",
- "$spooldir/virtualdomains",
-;
-
-flock(SENDMAIL_CW,LOCK_UN);
-flock(VIRTUSERTABLE,LOCK_UN);
-flock(RCPTHOSTS,LOCK_UN);
-flock(RECIPIENTMAP,LOCK_UN);
-flock(VIRTUALDOMAINS,LOCK_UN);
-
-close SENDMAIL_CW;
-close VIRTUSERTABLE;
-close RCPTHOSTS;
-close RECIPIENTMAP;
-close VIRTUALDOMAINS;
-
-###
-# export stuff
-#
-
-my($sendmailmachine);
-foreach $sendmailmachine (@sendmailmachines) {
- scp("$spooldir/sendmail.cw","root\@$sendmailmachine:/etc/sendmail.cw.new")
- == 0 or die "scp error: $!";
- scp("$spooldir/virtusertable","root\@$sendmailmachine:/etc/virtusertable.new")
- == 0 or die "scp error: $!";
- ssh("root\@$sendmailmachine",
- "( ".
- "mv /etc/sendmail.cw.new /etc/sendmail.cw; ".
- "mv /etc/virtusertable.new /etc/virtusertable; ".
- #"/etc/init.d/sendmail restart; ".
- " )"
- )
- == 0 or die "ssh error: $!";
-}
-
-my($qmailmachine);
-foreach $qmailmachine (@qmailmachines) {
- scp("$spooldir/recipientmap","root\@$qmailmachine:/var/qmail/control/recipientmap")
- == 0 or die "scp error: $!";
- scp("$spooldir/virtualdomains","root\@$qmailmachine:/var/qmail/control/virtualdomains")
- == 0 or die "scp error: $!";
- scp("$spooldir/rcpthosts","root\@$qmailmachine:/var/qmail/control/rcpthosts")
- == 0 or die "scp error: $!";
- #ssh("root\@$qmailmachine","/etc/init.d/qmail restart")
- # == 0 or die "ssh error: $!";
-}
-
-unlink $spoollock;
-flock(EXPORT,LOCK_UN);
-close EXPORT;
-
diff --git a/bin/svc_acct_sm.import b/bin/svc_acct_sm.import
deleted file mode 100755
index 10d7e4c20..000000000
--- a/bin/svc_acct_sm.import
+++ /dev/null
@@ -1,252 +0,0 @@
-#!/usr/bin/perl -Tw
-#
-# ivan@sisd.com 98-mar-9
-#
-# generalized svcparts ivan@sisd.com 98-mar-23
-
-# You really need to enable ssh into a shell machine as this needs to rename
-# .qmail-extension files.
-#
-# now an interactive script ivan@sisd.com 98-jun-30
-#
-# has an (untested) section for sendmail, s/warn/die/g and generates a program
-# to run on your mail machine _later_ instead of ssh'ing for each user
-# ivan@sisd.com 98-jul-13
-
-use strict;
-use vars qw(%d_part_svc %m_part_svc);
-use FS::SSH qw(iscp);
-use FS::UID qw(adminsuidsetup);
-use FS::Record qw(qsearch qsearchs);
-use FS::svc_acct_sm;
-use FS::svc_domain;
-
-adminsuidsetup;
-
-#my($spooldir)="/var/spool/freeside/export";
-my($spooldir)="unix";
-
-my(%mta) = (
- 1 => "qmail",
- 2 => "sendmail",
-);
-
-###
-
-%d_part_svc =
- map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_domain'});
-%m_part_svc =
- map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct_sm'});
-
-print "\n\n",
- ( join "\n", map "$_: ".$d_part_svc{$_}->svc, sort keys %d_part_svc ),
- "\n\nEnter part number for domains: ";
-my($domain_svcpart)=&getvalue;
-
-print "\n\n",
- ( join "\n", map "$_: ".$m_part_svc{$_}->svc, sort keys %m_part_svc ),
- "\n\nEnter part number for mail aliases: ";
-my($mailalias_svcpart)=&getvalue;
-
-print "\n\n", <<END;
-Select your MTA from the following list.
-END
-print join "\n", map "$_: $mta{$_}", sort keys %mta;
-print "\n\n:";
-my($mta)=&getvalue;
-
-if ( $mta{$mta} eq "qmail" ) {
-
- print "\n\n", <<END;
-Enter the location and name of your qmail control directory, for example
-"mail.isp.com:/var/qmail/control"
-END
- print ":";
- my($control)=&getvalue;
- iscp("root\@$control/rcpthosts","$spooldir/rcpthosts.import");
-# iscp("root\@$control/recipientmap","$spooldir/recipientmap.import");
- iscp("root\@$control/virtualdomains","$spooldir/virtualdomains.import");
-
-# print "\n\n", <<END;
-#Enter the name of the machine with your user .qmail files, for example
-#"mail.isp.com"
-#END
-# print ":";
-# my($shellmachine)=&getvalue;
-
-} elsif ( $mta{$mta} eq "sendmail" ) {
-
- print "\n\n", <<END;
-Enter the location and name of your sendmail virtual user table, for example
-"mail.isp.com:/etc/virtusertable"
-END
- print ":";
- my($virtusertable)=&getvalue;
- iscp("root\@$virtusertable","$spooldir/virtusertable.import");
-
- print "\n\n", <<END;
-Enter the location and name of your sendmail.cw file, for example
-"mail.isp.com:/etc/sendmail.cw"
-END
- print ":";
- my($sendmail_cw)=&getvalue;
- iscp("root\@$sendmail_cw","$spooldir/sendmail.cw.import");
-
-} else {
- die "Unknown MTA!\n";
-}
-
-sub getvalue {
- my($x)=scalar(<STDIN>);
- chop $x;
- $x;
-}
-
-print "\n\n";
-
-###
-
-$FS::svc_domain::whois_hack=1;
-$FS::svc_acct_sm::nossh_hack=1;
-
-if ( $mta{$mta} eq "qmail" ) {
- open(RCPTHOSTS,"<$spooldir/rcpthosts.import")
- or die "Can't open $spooldir/rcpthosts.import: $!";
-} elsif ( $mta{$mta} eq "sendmail" ) {
- open(RCPTHOSTS,"<$spooldir/sendmail.cw.import")
- or die "Can't open $spooldir/sendmail.cw.import: $!";
-} else {
- die "Unknown MTA!\n";
-}
-
-my(%svcnum);
-
-while (<RCPTHOSTS>) {
- next if /^(#|$)/;
- /^\.?([\w\-\.]+)$/
- #or do { warn "Strange rcpthosts/sendmail.cw line: $_"; next; };
- or die "Strange rcpthosts/sendmail.cw line: $_";
- my $domain = $1;
- my($svc_domain);
- unless ( $svc_domain = qsearchs('svc_domain', {'domain'=>$domain} ) ) {
- $svc_domain = create FS::svc_domain ({
- 'domain' => $domain,
- 'svcpart' => $domain_svcpart,
- 'action' => 'N',
- });
- my $error = $svc_domain->insert;
- #warn $error if $error;
- die $error if $error;
- }
- $svcnum{$domain}=$svc_domain->svcnum;
-}
-close RCPTHOSTS;
-
-#these two loops have enough similar parts they should probably be merged
-if ( $mta{$mta} eq "qmail" ) {
-
- open(VD_FIX,">$spooldir/virtualdomains.FIX");
- print VD_FIX "#!/usr/bin/perl\n";
-
- open(VIRTUALDOMAINS,"<$spooldir/virtualdomains.import")
- or die "Can't open $spooldir/virtualdomains.import: $!";
- while (<VIRTUALDOMAINS>) {
- next if /^#/;
- /^\.?([\w\-\.]+):(\w+)(\-([\w\-\.]+))?$/
- #or do { warn "Strange virtualdomains line: $_"; next; };
- or die "Strange virtualdomains line: $_";
- my($domain,$username,$dash_ext,$extension)=($1,$2,$3,$4);
- $dash_ext ||= '';
- $extension ||= '';
- my($svc_acct)=qsearchs('svc_acct',{'username'=>$username});
- unless ( $svc_acct ) {
- #warn "Unknown user $username in virtualdomains; skipping\n";
- #die "Unknown user $username in virtualdomains; skipping\n";
- next;
- }
- if ( $domain ne $extension ) {
- #warn "virtualdomains line $domain:$username$dash_ext changed to $domain:$username-$domain\n";
- my($dir)=$svc_acct->dir;
- my($qdomain)=$domain;
- $qdomain =~ s/\./:/g; #see manpage for 'dot-qmail': EXTENSION ADDRESSES
- #example to move .qmail files for virtual domains to their new location
- #dry run
- #issh("root\@$shellmachine",'perl -e \'foreach $a (<'. $dir. '/.qmail'. $dash_ext. '-*>) { $old=$a; $a =~ s/\\.qmail'. $dash_ext. '\\-/\\.qmail\\-'. $qdomain. '\\-/; print " $old -> $a\n"; }\'');
- #the real thing
- #issh("root\@$shellmachine",'perl -e \'foreach $a (<'. $dir. '/.qmail'. $dash_ext. '-*>) { $old=$a; $a =~ s/\\.qmail'. $dash_ext. '\\-/\\.qmail\\-'. $qdomain. '\\-/; rename $old, $a; }\'');
- print VD_FIX <<END;
-foreach \$file (<$dir/.qmail$dash_ext-*>) {
- \$old = \$file;
- \$file =~ s/\.qmail$dash_ext\-/\.qmail\-$qdomain\-/;
- rename \$old, \$file;
-}
-END
- }
-
- unless ( exists $svcnum{$domain} ) {
- my($svc_domain) = create FS::svc_domain ({
- 'domain' => $domain,
- 'svcpart' => $domain_svcpart,
- 'action' => 'N',
- });
- my $error = $svc_domain->insert;
- #warn $error if $error;
- die $error if $error;
- $svcnum{$domain}=$svc_domain->svcnum;
- }
-
- my($svc_acct_sm)=create FS::svc_acct_sm ({
- 'domsvc' => $svcnum{$domain},
- 'domuid' => $svc_acct->uid,
- 'domuser' => '*',
- 'svcpart' => $mailalias_svcpart,
- });
- my($error)='';
- $error=$svc_acct_sm->insert;
- #warn $error if $error;
- die $error, ", domain $domain" if $error;
- }
- close VIRTUALDOMAINS;
- close VD_FIX;
-
-} elsif ( $mta{$mta} eq "sendmail" ) {
-
- open(VIRTUSERTABLE,"<$spooldir/virtusertable.import")
- or die "Can't open $spooldir/virtusertable.import: $!";
- while (<VIRTUSERTABLE>) {
- next if /^#/; #comments?
- /^([\w\-\.]+)?\@([\w\-\.]+)\t([\w\-\.]+)$/
- #or do { warn "Strange virtusertable line: $_"; next; };
- or die "Strange virtusertable line: $_";
- my($domuser,$domain,$username)=($1,$2,$3);
- my($svc_acct)=qsearchs('svc_acct',{'username'=>$username});
- unless ( $svc_acct ) {
- #warn "Unknown user $username in virtusertable";
- die "Unknown user $username in virtusertable";
- next;
- }
- my($svc_acct_sm)=create FS::svc_acct_sm ({
- 'domsvc' => $svcnum{$domain},
- 'domuid' => $svc_acct->uid,
- 'domuser' => $domuser || '*',
- 'svcpart' => $mailalias_svcpart,
- });
- my($error)='';
- $error=$svc_acct_sm->insert;
- #warn $error if $error;
- die $error if $error;
- }
- close VIRTUSERTABLE;
-
-} else {
- die "Unknown MTA!\n";
-}
-
-#open(RECIPIENTMAP,"<$spooldir/recipientmap.import");
-#close RECIPIENTMAP;
-
-print "\n\n", <<END if $mta{$mta} eq "qmail";
-Don\'t forget to run $spooldir/virtualdomains.FIX before using
-$spooldir/virtualdomains !
-END
-
diff --git a/bin/svc_broadband.renumber b/bin/svc_broadband.renumber
new file mode 100755
index 000000000..980fa0099
--- /dev/null
+++ b/bin/svc_broadband.renumber
@@ -0,0 +1,84 @@
+#!/usr/bin/perl
+
+use strict;
+
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch qsearchs);
+use FS::svc_Common;
+use FS::part_svc_router;
+use FS::svc_broadband;
+use FS::router;
+use FS::addr_block;
+
+$FS::svc_Common::noexport_hack = 1; #Disable exports!
+
+my $user = shift if $ARGV[0] or die &usage;
+adminsuidsetup($user);
+
+my $remapfile = shift if $ARGV[0] or die &usage;
+my $old_blocknum = shift if $ARGV[0] or die &usage;
+my $new_blocknum = shift if $ARGV[0] or die &usage;
+my $old_svcnum = shift if $ARGV[0];
+
+my %ipmap;
+
+open(REMAP, "<$remapfile") or die $!;
+while (<REMAP>) {
+ next unless (/^([0-9\.]+)\s+([0-9\.]+)$/);
+ my ($old_ip, $new_ip) = ($1, $2);
+ $ipmap{$old_ip} = $new_ip;
+}
+close(REMAP);
+
+my @svcs;
+if ($old_svcnum) {
+ @svcs = ( qsearchs('svc_broadband', { svcnum => $old_svcnum,
+ blocknum => $old_blocknum }) );
+} else {
+ @svcs = qsearch('svc_broadband', { blocknum => $old_blocknum });
+}
+
+foreach my $old_sb (@svcs) {
+
+ my $old_ip = $old_sb->ip_addr;
+ my $new_ip = $ipmap{$old_ip};
+ print "Renumbering ${old_ip} (${old_blocknum}) => ${new_ip} (${new_blocknum})...\n";
+
+
+ my $new_sb = new FS::svc_broadband
+ { $old_sb->hash,
+ ip_addr => $new_ip,
+ blocknum => $new_blocknum,
+ svcpart => $old_sb->cust_svc->svcpart,
+ };
+
+ my $error = $new_sb->replace($old_sb);
+ die $error if $error;
+
+}
+
+
+
+exit(0);
+
+sub usage {
+
+ my $usage = <<EOT;
+Usage:
+ svc_broadband.renumber user remapfile old_blocknum new_blocknum [ svcnum ]
+
+remapfile format:
+old_ip_address new_ip_address
+...
+
+Example remapfile:
+10.0.0.5 192.168.0.5
+10.0.0.20 192.168.0.20
+10.0.0.32 192.168.0.3
+
+Warning: This assumes your routers have already been reconfigured with the
+ new addresses. Exports will not be run!
+
+EOT
+
+}
diff --git a/bin/svc_domain.erase b/bin/svc_domain.erase
new file mode 100755
index 000000000..435dd5fdd
--- /dev/null
+++ b/bin/svc_domain.erase
@@ -0,0 +1,15 @@
+#!/usr/bin/perl -w
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch);
+
+use FS::domain_record;
+use FS::svc_domain;
+
+adminsuidsetup(shift @ARGV) or die "Usage: svc_domain.erase user\n";
+
+foreach my $record ( qsearch('domain_record',{}), qsearch('svc_domain', {} ) ) {
+ my $error = $record->delete;
+ die $error if $error;
+}
diff --git a/bin/sysvshell.export b/bin/sysvshell.export
new file mode 100755
index 000000000..c13912c3f
--- /dev/null
+++ b/bin/sysvshell.export
@@ -0,0 +1,112 @@
+#!/usr/bin/perl -w
+
+# sysvshell export
+
+use strict;
+use File::Rsync;
+use Net::SSH qw(ssh);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch qsearchs);
+use FS::part_export;
+use FS::cust_svc;
+use FS::svc_acct;
+
+my @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my $spooldir = "/usr/local/etc/freeside/export.". datasrc;
+#my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/shell";
+
+my @sysv_exports = qsearch('part_export', { 'exporttype' => 'sysvshell' } );
+
+my $rsync = File::Rsync->new({
+ rsh => 'ssh',
+# dry_run => 1,
+});
+
+foreach my $export ( @sysv_exports ) {
+ my $machine = $export->machine;
+ my $prefix = "$spooldir/$machine";
+ mkdir $prefix, 0700 unless -d $prefix;
+
+ #LOCKING!!!
+
+ ( open(SHADOW,">$prefix/shadow")
+ #!!! and flock(SHADOW,LOCK_EX|LOCK_NB)
+ ) or die "Can't open $prefix/shadow: $!";
+ ( open(PASSWD,">$prefix/passwd")
+ #!!! and flock(PASSWD,LOCK_EX|LOCK_NB)
+ ) or die "Can't open $prefix/passwd: $!";
+
+ chmod 0644, "$prefix/passwd";
+ chmod 0600, "$prefix/shadow";
+
+ my @svc_acct = $export->svc_x;
+
+ next unless @svc_acct;
+
+ foreach my $svc_acct ( sort { $a->uid <=> $b->uid } @svc_acct ) {
+
+ my $password = $svc_acct->_password;
+ my $cpassword;
+ #if ( ( length($password) <= 8 )
+ if ( ( length($password) <= 12 )
+ && ( $password ne '*' )
+ && ( $password ne '!!' )
+ && ( $password ne '' )
+ ) {
+ $cpassword=crypt($password,
+ $saltset[int(rand(64))].$saltset[int(rand(64))]
+ );
+ # MD5 !!!!
+ } else {
+ $cpassword=$password;
+ }
+
+ ###
+ # FORMAT OF THE PASSWD FILE HERE
+ print PASSWD join(":",
+ $svc_acct->username,
+ 'x', # "##". $username,
+ $svc_acct->uid,
+ $svc_acct->gid,
+ $svc_acct->finger,
+ $svc_acct->dir,
+ $svc_acct->shell,
+ ), "\n";
+
+ ###
+ # FORMAT OF THE SHADOW FILE HERE
+ print SHADOW join(":",
+ $svc_acct->username,
+ $cpassword,
+ '',
+ '',
+ '',
+ '',
+ '',
+ '',
+ '',
+ ), "\n";
+
+ }
+
+ #!!! flock(SHADOW,LOCK_UN);
+ #!!! flock(PASSWD,LOCK_UN);
+ close SHADOW;
+ close PASSWD;
+
+ $rsync->exec( {
+ src => "$prefix/shadow",
+ dest => "root\@$machine:/etc/shadow"
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+
+ $rsync->exec( {
+ src => "$prefix/passwd",
+ dest => "root\@$machine:/etc/passwd"
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+
+ # UNLOCK!!
+}
diff --git a/bin/test_scrub b/bin/test_scrub
new file mode 100644
index 000000000..5766925a6
--- /dev/null
+++ b/bin/test_scrub
@@ -0,0 +1,48 @@
+#!/usr/bin/perl -w
+
+#This drops anything from the database that could cause live things to happen.
+#You'd want to do this on a test copy of your live database but NEVER on the
+#live database itself.
+
+#-all exports (all records in part_export, part_export_option export_svc)
+#-all non-POST invoice destinations (cust_main_invoice)
+#-all payment gateways and agent payment gw overrides (payment_gateway,
+# payment_gateway_option, agent_payment_gateway)
+#-everything in the job queue (queue and queue_arg)
+#-business-onlinepayment and business-onlinepayment-ach config
+
+use strict;
+use FS::UID qw(adminsuidsetup dbh);
+use FS::Conf;
+
+adminsuidsetup shift;
+
+foreach my $table (qw(
+ part_export
+ part_export_option
+ export_svc
+ payment_gateway
+ payment_gateway_option
+ agent_payment_gateway
+ queue
+ queue_arg
+)) {
+
+ my $sth = dbh->prepare("DELETE FROM $table") or die dbh->errstr;
+ $sth->execute or die $sth->errstr;
+
+}
+
+my $dsth = dbh->prepare("DELETE FROM cust_main_invoice WHERE dest != 'POST'")
+ or die dbh->errstr;
+$dsth->execute or die $dsth->errstr;
+
+my $conf = new FS::Conf;
+foreach my $item (qw(
+ business-onlinepayment
+ business-onlinepayment-ach
+)) {
+ $conf->delete($item);
+}
+
+dbh->commit or die dbh->errstr;
diff --git a/bin/tron-scan b/bin/tron-scan
new file mode 100755
index 000000000..914d6d407
--- /dev/null
+++ b/bin/tron-scan
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+
+use FS::UID qw(adminsuidsetup);
+use FS::Conf;
+use FS::Record qw(qsearch);
+use FS::Tron qw(tron_scan tron_lint);
+use FS::cust_svc;
+
+adminsuidsetup shift;
+
+my $conf = new FS::Conf;
+my $mcp_svcpart = $conf->config('mcp_svcpart') or die "no mcp_svcpart";
+
+#tron_scan($_) foreach qsearch('cust_svc', { 'svcpart' => $mcp_svcpart } );
+foreach my $svc ( qsearch('cust_svc', { 'svcpart' => $mcp_svcpart } ) ) {
+ my $error = tron_scan($svc);
+ warn $error if $error;
+
+ my @lint = tron_lint($svc);
+ print $svc->svc_x->title. "\n". join('', map " $_\n", @lint )
+ if @lint;
+}
+
+1;