diff options
Diffstat (limited to 'bin')
128 files changed, 0 insertions, 12856 deletions
diff --git a/bin/19add b/bin/19add deleted file mode 100755 index 726cd66..0000000 --- a/bin/19add +++ /dev/null @@ -1,20 +0,0 @@ -#!/usr/bin/perl - -use Cwd; -use String::ShellQuote; - -my $USER = $ENV{USER}; - -my $dir = getcwd; -( my $prefix = $dir ) =~ s(^/home/$USER/freeside/?)() or die $dir; #eventually from anywhere - -system join('', - #"cvs add @ARGV && ", - "cvs add @ARGV ; ", - "( for file in @ARGV; do ", - "cp -i \$file /home/$USER/freeside1.9/$prefix/`dirname \$file`;", - "done ) && ", - "cd /home/$USER/freeside1.9/$prefix/ && ", - "cvs add @ARGV" -); - diff --git a/bin/19commit b/bin/19commit deleted file mode 100755 index 0b4cd05..0000000 --- a/bin/19commit +++ /dev/null @@ -1,26 +0,0 @@ -#!/usr/bin/perl - -# usage: 19commit 'log message' filename filename ... - -use Cwd; -use String::ShellQuote; - -my $USER = $ENV{USER}; - -my $dir = getcwd; -( my $prefix = $dir ) =~ s(^/home/$USER/freeside/?)() or die $dir; #eventually from anywhere - -my $desc = shell_quote(shift @ARGV); # -m - -die "no files!" unless @ARGV; - -#warn "$prefix"; - -#print <<END; -system join('', - "( cd /home/$USER/freeside1.9/$prefix; cvs update @ARGV ) && ", - "cvs diff -u @ARGV | ( cd /home/$USER/freeside1.9/$prefix; patch -p0 ) ", - " && ( ( cvs commit -m $desc @ARGV & ); ", - "( sleep 1;cd /home/$USER/freeside1.9/$prefix; cvs commit -m $desc @ARGV & ) )" -); - diff --git a/bin/19diff b/bin/19diff deleted file mode 100755 index dcc5165..0000000 --- a/bin/19diff +++ /dev/null @@ -1,12 +0,0 @@ -#!/usr/bin/perl - -my $file = shift; - -chomp(my $dir = `pwd`); -$dir =~ s/freeside\//freeside1.9\//; - -#$cmd = "diff -u $file $dir/$file"; -$cmd = "diff -u $dir/$file $file"; -print "$cmd\n"; -system($cmd); - diff --git a/bin/21add b/bin/21add deleted file mode 100755 index e7a77da..0000000 --- a/bin/21add +++ /dev/null @@ -1,20 +0,0 @@ -#!/usr/bin/perl - -use Cwd; -use String::ShellQuote; - -my $USER = $ENV{USER}; - -my $dir = getcwd; -( my $prefix = $dir ) =~ s(^/home/$USER/freeside/?)() or die $dir; #eventually from anywhere - -system join('', - #"cvs add @ARGV && ", - "cvs add @ARGV ; ", - "( for file in @ARGV; do ", - "cp -i \$file /home/$USER/freeside2.1/$prefix/`dirname \$file`;", - "done ) && ", - "cd /home/$USER/freeside2.1/$prefix/ && ", - "cvs add @ARGV" -); - diff --git a/bin/21commit b/bin/21commit deleted file mode 100755 index 211c0ed..0000000 --- a/bin/21commit +++ /dev/null @@ -1,26 +0,0 @@ -#!/usr/bin/perl - -# usage: 19commit 'log message' filename filename ... - -use Cwd; -use String::ShellQuote; - -my $USER = $ENV{USER}; - -my $dir = getcwd; -( my $prefix = $dir ) =~ s(^/home/$USER/freeside/?)() or die $dir; #eventually from anywhere - -my $desc = shell_quote(shift @ARGV); # -m - -die "no files!" unless @ARGV; - -#warn "$prefix"; - -#print <<END; -system join('', - "( cd /home/$USER/freeside2.1/$prefix; cvs update @ARGV ) && ", - "cvs diff -u @ARGV | ( cd /home/$USER/freeside2.1/$prefix; patch -p0 ) ", - " && ( ( cvs commit -m $desc @ARGV & ); ", - "( sleep 1;cd /home/$USER/freeside2.1/$prefix; cvs commit -m $desc @ARGV & ) )" -); - diff --git a/bin/21diff b/bin/21diff deleted file mode 100755 index a217103..0000000 --- a/bin/21diff +++ /dev/null @@ -1,12 +0,0 @@ -#!/usr/bin/perl - -my $file = shift; - -chomp(my $dir = `pwd`); -$dir =~ s/freeside\//freeside2.1\//; - -#$cmd = "diff -u $file $dir/$file"; -$cmd = "diff -u $dir/$file $file"; -print "$cmd\n"; -system($cmd); - diff --git a/bin/add-history-records.pl b/bin/add-history-records.pl deleted file mode 100755 index fbf9d09..0000000 --- a/bin/add-history-records.pl +++ /dev/null @@ -1,139 +0,0 @@ -#!/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 deleted file mode 100755 index ef5dff6..0000000 --- a/bin/all-postal-no-email +++ /dev/null @@ -1,22 +0,0 @@ -#!/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 deleted file mode 100755 index 82eb6d6..0000000 --- a/bin/apache.export +++ /dev/null @@ -1,94 +0,0 @@ -#!/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 deleted file mode 100644 index 716ddda..0000000 --- a/bin/artera.import +++ /dev/null @@ -1,75 +0,0 @@ -#!/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 deleted file mode 100644 index d0314b4..0000000 --- a/bin/backup-dvd +++ /dev/null @@ -1,45 +0,0 @@ -#!/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-as-nextmonth b/bin/bill-as-nextmonth deleted file mode 100755 index 813e841..0000000 --- a/bin/bill-as-nextmonth +++ /dev/null @@ -1,5 +0,0 @@ -#!/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 deleted file mode 100755 index 91e9431..0000000 --- a/bin/bill-as-nextmonth-BILL +++ /dev/null @@ -1,5 +0,0 @@ -#!/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 deleted file mode 100755 index 63c4ad2..0000000 --- a/bin/bill-as-nextyear +++ /dev/null @@ -1,5 +0,0 @@ -#!/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 deleted file mode 100755 index 0d77dd0..0000000 --- a/bin/bill-as-nextyear-BILL +++ /dev/null @@ -1,5 +0,0 @@ -#!/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 deleted file mode 100755 index e1a3376..0000000 --- a/bin/bill-for-nextmonth +++ /dev/null @@ -1,5 +0,0 @@ -#!/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 deleted file mode 100755 index 1430a58..0000000 --- a/bin/bill-for-nextyear +++ /dev/null @@ -1,5 +0,0 @@ -#!/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 deleted file mode 100755 index 813e841..0000000 --- a/bin/bill-nextmonth +++ /dev/null @@ -1,5 +0,0 @@ -#!/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 deleted file mode 100755 index 63c4ad2..0000000 --- a/bin/bill-nextyear +++ /dev/null @@ -1,5 +0,0 @@ -#!/bin/sh - -year=`date +%Y` -nextyear=`expr $year + 1` -/usr/local/bin/freeside-daily -d 1/1/$nextyear fs_daily diff --git a/bin/bind.export b/bin/bind.export deleted file mode 100755 index 286e43a..0000000 --- a/bin/bind.export +++ /dev/null @@ -1,195 +0,0 @@ -#!/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 deleted file mode 100755 index 45db2e2..0000000 --- a/bin/bind.import +++ /dev/null @@ -1,235 +0,0 @@ -#!/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 deleted file mode 100644 index 44c3e36..0000000 --- a/bin/breakdown-bill-applications +++ /dev/null @@ -1,25 +0,0 @@ -#!/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 deleted file mode 100755 index 6e0d103..0000000 --- a/bin/bsdshell.export +++ /dev/null @@ -1,114 +0,0 @@ -#!/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/build_exten.php b/bin/build_exten.php deleted file mode 100755 index e55df4b..0000000 --- a/bin/build_exten.php +++ /dev/null @@ -1,790 +0,0 @@ -#!/usr/bin/php -q -<?php /* $Id: build_exten.php,v 1.1 2010-03-26 02:19:16 ivan Exp $ */ -//Copyright (C) 2008 Astrogen LLC -// -//This program is free software; you can redistribute it and/or -//modify it under the terms of the GNU General Public License -//as published by the Free Software Foundation; either version 2 -//of the License, or (at your option) any later version. -// -//This program is distributed in the hope that it will be useful, -//but WITHOUT ANY WARRANTY; without even the implied warranty of -//MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -//GNU General Public License for more details. - -function out($text) { - echo $text."\n"; -} - -function outn($text) { - echo $text; -} - -function error($text) { - echo "[ERROR] ".$text."\n"; -} - -function warning($text) { - echo "[WARNING] ".$text."\n"; -} - -function fatal($text) { - echo "[FATAL] ".$text."\n"; - exit(1); -} - -function debug($text) { - global $param_debug; - - if ($param_debug) echo "[DEBUG] ".$text."\n"; -} - -if (! @ include("Console/Getopt.php")) { - fatal("PEAR must be installed (requires Console/Getopt.php). Include path: ".ini_get("include_path")); - exit(12); -} - -ini_set('error_reporting', E_ALL & ~E_NOTICE); - -function showHelp() { - global $argv; - out("USAGE:"); - out(" ".$argv[0]." --create|delete --exten <extension> [optional parameters]"); - out(""); - - out("OPERATIONS (exactly one must be specified):"); - out(" --create, -c"); - out(" Create a new extension"); - out(" --modify, -m"); - out(" Modify an existing extension, the extension must exist and all values execept"); - out(" those specified will remain the same"); - out(" --delete, -d"); - out(" Delete an extension"); - - out("PARAMETERS:"); - out(" --exten extension_number"); - out(" Extension number to create or delete. Must be specified."); - - out("OPTIONAL PARAMETERS:"); - out(" --name name"); - out(" Display Name, defaults to specified extension number."); - out(" --outboundcid cid_number"); - out(" Outbound CID Number, defaults to specified extension number."); - out(" --directdid did_number"); - out(" Direct DID Number, defaults to extension number."); - out(" --vm-password password"); - out(" Voicemail Password, defaults to specified extension number."); - out(" --sip-secret secret"); - out(" SIP Secret, defaults to md5 hash of specified extension number."); - out(" --debug"); - out(" Display debug messages."); - out(" --no-warnings"); - out(" Do Not display warning messages."); - - out(" --help, -h, -? Show this help"); -} - -// **** Parse out command-line options -$shortopts = "cmdh?"; -$longopts = array( - "help", - "debug", - "no-warnings", - "create", - "modify", - "delete", - "exten=", - "outboundcid=", - "directdid=", - "name=", - "sip-secret=", - "vm-password=", -); - -$args = Console_Getopt::getopt(Console_Getopt::readPHPArgv(), $shortopts, $longopts); -if (is_object($args)) { - // assume it's PEAR_ERROR - fatal($args->message); - exit(255); -} - -$no_params = true; - -$param_debug = false; -$param_warnings = true; -$param_create = false; -$param_modify = false; -$param_delete = false; -$param_exten = false; -$param_name = false; -$param_outboundcid = false; -$param_directdid = false; -$param_sip_secret = false; -$param_vm_password = false; - -foreach ($args[0] as $arg) { - $no_params = false; - switch ($arg[0]) { - - case "--help": - case "h": - case "?": - showHelp(); - exit(10); - break; - - case "--debug": - $param_debug = true; - debug("debug mode is enabled"); - break; - - case "--no-warnings": - $param_warnings = false; - break; - - case "--create": - case "c": - $param_create = true; - break; - - case "--modify": - case "m": - $param_modify = true; - break; - - case "--delete": - case "d": - $param_delete = true; - break; - - case "--exten": - $param_exten = true; - $new_exten = $arg[1]; - break; - - case "--outboundcid": - $param_outboundcid = true; - $new_outboundcid = $arg[1]; - break; - - case "--directdid": - $param_directdid = true; - $new_directdid = $arg[1]; - break; - - case "--name": - $param_name = true; - $new_name = $arg[1]; - break; - - case "--sip-secret": - $param_sip_secret = true; - $new_sip_secret = $arg[1]; - break; - - case "--vm-password": - $param_vm_password = true; - $new_vm_password = $arg[1]; - break; - - default: - error("unhandled argument supplied: ".$arg[0].", aborting"); - exit (1); - } -} - -if ($no_params) { - showHelp(); - exit(10); -} -if ($param_create && $param_modify) { - error("Incompatible combination of options, create and modify"); - exit (1); -} -if (!(($param_create || $param_modify) XOR $param_delete)) { - error("Invalid Parameter combination, you must include create or delete and can not do both in one call"); - exit (1); -} -if (!$param_exten) { - error("You must provide an extension number to create or delete an extension"); - exit (1); -} - -if ($param_warnings && $param_create) { - if (!$param_outboundcid) { - $new_outboundcid = $new_exten; - warning("WARNING: No outboundcid specified for extenion, using $new_outboundcid as outboundcid"); - } - if (!$param_directdid) { - $new_directdid = $new_exten; - warning("WARNING: No outboundcid specified for extenion, using $new_outboundcid as outboundcid"); - } - if (!$param_name) { - $new_name = $new_exten; - warning("WARNING: No name specified for extenion, using $new_name as name"); - } - if (!$param_sip_secret) { - $new_sip_secret = md5($new_exten); - warning("WARNING: No sip-secret specified for extenion, using $new_sip_secret as secret"); - } - if (!$param_vm_password) { - $new_vm_password = $new_exten; - warning("WARNING: No vm-password specified for extenion, using $new_vm_password as password"); - } -} - -// Now setup actions and exten how leveraged code expected it -// -$exten = $new_exten; -if ($param_create) { - $actions = "addext/addvm"; -} else if ($param_modify) { - $actions = "modext"; -} else if ($param_delete) { - $actions = "remext"; -} - -/* I don't think I need these but ??? -*/ -$type = 'setup'; -$display = ''; -$extdisplay = null; - -// determine module type to show, default to 'setup' -$type_names = array( - 'tool'=>'Tools', - 'setup'=>'Setup', - 'cdrcost'=>'Call Cost', -); - -define("AMP_CONF", "/etc/amportal.conf"); -$amportalconf = AMP_CONF; - -// bootstrap retrieve_conf by getting the AMPWEBROOT since that is currently where the necessary -// functions.inc.php resides, and then use that parser to properly parse the file and get all -// the defaults as needed. -// -function parse_amportal_conf_bootstrap($filename) { - $file = file($filename); - foreach ($file as $line) { - if (preg_match("/^\s*([\w]+)\s*=\s*\"?([\w\/\:\.\*\%-]*)\"?\s*([;#].*)?/",$line,$matches)) { - $conf[ $matches[1] ] = $matches[2]; - } - } - if ( !isset($conf["AMPWEBROOT"]) || ($conf["AMPWEBROOT"] == "")) { - $conf["AMPWEBROOT"] = "/var/www/html"; - } else { - $conf["AMPWEBROOT"] = rtrim($conf["AMPWEBROOT"],'/'); - } - - return $conf; -} - -$amp_conf = parse_amportal_conf_bootstrap($amportalconf); -if (count($amp_conf) == 0) { - exit (1); -} - - -// Emulate gettext extension functions if gettext is not available -if (!function_exists('_')) { - function _($str) { - return $str; - } -} -if (!function_exists('gettext')) { - function gettext($message) { - return $message; - } -} -if (!function_exists('dgettext')) { - function dgettext($domain, $message) { - return $message; - } -} - -// setup locale -function set_language() { - if (extension_loaded('gettext')) { - if (isset($_COOKIE['lang'])) { - setlocale(LC_ALL, $_COOKIE['lang']); - putenv("LANGUAGE=".$_COOKIE['lang']); - } else { - setlocale(LC_ALL, 'en_US'); - } - bindtextdomain('amp','./i18n'); - bind_textdomain_codeset('amp', 'utf8'); - textdomain('amp'); - } -} -set_language(); - -// systems running on sqlite3 (or pgsql) this function is not available -// instead of changing the whole code, lets hack our own version of this function. -// according to the documentation found here: http://il2.php.net/mysql_real_escape_string -// this shold be enough. -// Fixes ticket: http://freepbx.org/trac/ticket/1963 -if (!function_exists('mysql_real_escape_string')) { - function mysql_real_escape_string($str) { - $str = str_replace( "\x00", "\\" . "\x00", $str ); - $str = str_replace( "\x1a", "\\" . "\x1a", $str ); - $str = str_replace( "\n" , "\\". "\n" , $str ); - $str = str_replace( "\r" , "\\". "\r" , $str ); - $str = str_replace( "\\" , "\\". "\\" , $str ); - $str = str_replace( "'" , "''" , $str ); - $str = str_replace( '"' , '""' , $str ); - return $str; - } -} - -// include base functions - -require_once($amp_conf['AMPWEBROOT']."/admin/functions.inc.php"); -require_once($amp_conf['AMPWEBROOT']."/admin/common/php-asmanager.php"); -$amp_conf = parse_amportal_conf($amportalconf); -if (count($amp_conf) == 0) { - exit (1); -} -$asterisk_conf_file = $amp_conf["ASTETCDIR"]."/asterisk.conf"; -$asterisk_conf = parse_asterisk_conf($asterisk_conf_file); - -ini_set('include_path',ini_get('include_path').':'.$amp_conf['AMPWEBROOT'].'/admin/:'); - -$astman = new AGI_AsteriskManager(); - -// attempt to connect to asterisk manager proxy -if (!isset($amp_conf["ASTMANAGERPROXYPORT"]) || !$res = $astman->connect("127.0.0.1:".$amp_conf["ASTMANAGERPROXYPORT"], $amp_conf["AMPMGRUSER"] , $amp_conf["AMPMGRPASS"])) { - // attempt to connect directly to asterisk, if no proxy or if proxy failed - if (!$res = $astman->connect("127.0.0.1:".$amp_conf["ASTMANAGERPORT"], $amp_conf["AMPMGRUSER"] , $amp_conf["AMPMGRPASS"])) { - // couldn't connect at all - unset( $astman ); - } -} -// connect to database -require_once($amp_conf['AMPWEBROOT']."/admin/common/db_connect.php"); - -$nt = notifications::create($db); - -$framework_asterisk_running = checkAstMan(); - -// get all enabled modules -// active_modules array used below and in drawselects function and genConf function -$active_modules = module_getinfo(false, MODULE_STATUS_ENABLED); - -$fpbx_menu = array(); - -// pointer to current item in $fpbx_menu, if applicable -$cur_menuitem = null; - -// add module sections to $fpbx_menu -$types = array(); -if(is_array($active_modules)){ - foreach($active_modules as $key => $module) { - //include module functions - if (is_file($amp_conf['AMPWEBROOT']."/admin/modules/{$key}/functions.inc.php")) { - require_once($amp_conf['AMPWEBROOT']."/admin/modules/{$key}/functions.inc.php"); - } - - // create an array of module sections to display - // stored as [items][$type][$category][$name] = $displayvalue - if (isset($module['items']) && is_array($module['items'])) { - // loop through the types - foreach($module['items'] as $itemKey => $item) { - - if (!$framework_asterisk_running && - ((isset($item['needsenginedb']) && strtolower($item['needsenginedb'] == 'yes')) || - (isset($item['needsenginerunning']) && strtolower($item['needsenginerunning'] == 'yes'))) - ) - { - $item['disabled'] = true; - } else { - $item['disabled'] = false; - } - - if (!in_array($item['type'], $types)) { - $types[] = $item['type']; - } - - if (!isset($item['display'])) { - $item['display'] = $itemKey; - } - - // reference to the actual module - $item['module'] =& $active_modules[$key]; - - // item is an assoc array, with at least array(module=> name=>, category=>, type=>, display=>) - $fpbx_menu[$itemKey] = $item; - - // allow a module to replace our main index page - if (($item['display'] == 'index') && ($display == '')) { - $display = 'index'; - } - - // check current item - if ($display == $item['display']) { - // found current menuitem, make a reference to it - $cur_menuitem =& $fpbx_menu[$itemKey]; - } - } - } - } -} -sort($types); - -// new gui hooks -if(is_array($active_modules)){ - foreach($active_modules as $key => $module) { - if (isset($module['items']) && is_array($module['items'])) { - foreach($module['items'] as $itemKey => $itemName) { - //list of potential _configpageinit functions - $initfuncname = $key . '_' . $itemKey . '_configpageinit'; - if ( function_exists($initfuncname) ) { - $configpageinits[] = $initfuncname; - } - } - } - //check for module level (rather than item as above) _configpageinit function - $initfuncname = $key . '_configpageinit'; - if ( function_exists($initfuncname) ) { - $configpageinits[] = $initfuncname; - } - } -} - -// extensions vs device/users ... this is a bad design, but hey, it works -if (isset($amp_conf["AMPEXTENSIONS"]) && ($amp_conf["AMPEXTENSIONS"] == "deviceanduser")) { - unset($fpbx_menu["extensions"]); -} else { - unset($fpbx_menu["devices"]); - unset($fpbx_menu["users"]); -} - - -// Here we process the action and create the exten, mailbox or delete it. -// - -$EXTEN_REQUEST = array ( - 'actions' => $actions, - 'ext' => $exten, - 'displayname' => $new_name, - 'emergencycid' => '', - 'outboundcid' => $new_outboundcid, - 'accountcode' => '', - 'dtmfmode' => 'auto', - 'devicesecret' => $new_sip_secret, - 'directdid' => $new_directdid, - ); - -$actions = explode('/',$EXTEN_REQUEST['actions']); - - $actions_taken = false; - - $ext = ''; - $pass = ''; - $displayname = ''; - $emergencycid = ''; - $outboundcid = ''; - $directdid = ''; - $mailbox = ''; - $tech = 'sip'; - $dcontext = 'from-internal'; - $dtmfmode = 'auto'; - - foreach ($EXTEN_REQUEST as $key => $value) { - switch ($key) { - case 'ext': - case 'displayname': - case 'emergencycid': - case 'outboundcid': - case 'accountcode': - case 'dtmfmode': - case 'devicesecret': - case 'directdid': - case 'mailbox': - case 'dcontext': - $$key = $value; - break; - - default: - break; - } - } - - /* - echo "\nDumping core_users_get:"; - $user_list = core_users_get($ext); - var_dump($user_list); - - echo "\nDumping core_devices_get:"; - $device_list = core_devices_get($ext); - var_dump($device_list); - - echo "\nDumping voicemail_mailbox_get:"; - $vm_list = voicemail_mailbox_get($ext); - var_dump($vm_list); - - exit; - */ - - if ($ext == '') { - fatal("No Extension provided (this should have been caught above, may be a bug"); - exit (10); - } - - /* DEFAULTS: - displayname: ext - devicesecret: ext - */ - - if (in_array('addext', $actions) || in_array('addvm',$actions)) { - if ($displayname == '') { - $displayname = $ext; - } - if (isset($accountcode)) { - $_REQUEST['devinfo_accountcode'] = $accountcode; - } - if (!isset($devicesecret)) { - $devicesecret = $ext; - } - if ($mailbox == '') { - $mailbox = $ext.'@default'; - } - $user_add_arr = array( - 'extension' => $ext, - 'device' => $ext, - 'name' => $displayname, - 'directdid' => $directdid, - 'outboundcid' => $outboundcid, - 'sipname' => '', - 'record_out' => 'Never', - 'record_in' => 'Never', - 'callwaiting' => 'enabled', - - 'vm' => 'enabled', - 'vmcontext' => 'default', - 'options' => '', - 'vmpwd' => $new_vm_password, - 'email' => '', - 'pager' => '', - 'attach' => 'attach=no', - 'saycid' => 'saycid=no', - 'envelope' => 'envelope=no', - 'delete' => 'delete=no', - ); - - // archaic code expects these in the REQUEST array ... - // - $_REQUEST['devinfo_secret'] = $devicesecret; - $_REQUEST['devinfo_dtmfmode'] = $dtmfmode; - $_REQUEST['devinfo_canreinvite'] = 'no'; - $_REQUEST['devinfo_context'] = $dcontext; - $_REQUEST['devinfo_host'] = 'dynamic'; - $_REQUEST['devinfo_type'] = 'friend'; - $_REQUEST['devinfo_nat'] = 'yes'; - $_REQUEST['devinfo_port'] = '5060'; - $_REQUEST['devinfo_dial'] = 'SIP/'.$ext; - $_REQUEST['devinfo_mailbox'] = $mailbox; - - } else if (in_array('modext', $actions)) { - $user_list = core_users_get($ext); - //var_dump($user_list); - if (!isset($user_list['extension'])) { - error("No such extension found: $ext"); - exit (10); - } - $device_list = core_devices_get($ext); - //var_dump($device_list); - if (count($device_list) == 0) { - error("No such device found: $ext"); - exit (10); - } - $vm_list = voicemail_mailbox_get($ext); - //var_dump($vm_list); - if (count($vm_list) == 0) { - error("No voicemail found for: $ext"); - exit (10); - } - - if ($param_name) { - $user_list['name'] = $new_name; - $device_list['description'] = $new_name; - $vm_list['name'] = $new_name; - } - if ($param_sip_secret) { - $device_list['secret'] = $new_sip_secret; - } - if ($param_vm_password) { - $vm_list['pwd'] = $new_vm_password; - } - if ($param_directdid) { - $user_list['directdid'] = $new_directdid; - } - if ($param_outboundcid) { - $user_list['outboundcid'] = $new_outboundcid; - } - $user_mod_arr = array( - 'extension' => $ext, - 'device' => $ext, - 'name' => $user_list['name'], - 'directdid' => $user_list['directdid'], - 'outboundcid' => $user_list['outboundcid'], - 'sipname' => $user_list['sipname'], - 'record_out' => $user_list['record_out'], - 'record_in' => $user_list['record_in'], - 'callwaiting' => $user_list['callwaiting'], - - 'vm' => 'enabled', - 'vmcontext' => $vm_list['vmcontext'], - 'vmpwd' => $vm_list['pwd'], - 'email' => $vm_list['email'], - 'pager' => $vm_list['pager'], - 'options' => '', - 'attach' => $vm_list['options']['attach'], - 'saycid' => $vm_list['options']['saycid'], - 'envelope' => $vm_list['options']['envelope'], - 'delete' => $vm_list['options']['delete'], - ); - - // archaic code expects these in the REQUEST array ... - // - $_REQUEST['devinfo_secret'] = $device_list['secret']; - $_REQUEST['devinfo_dtmfmode'] = $device_list['dtmfmode']; - $_REQUEST['devinfo_canreinvite'] = $device_list['canreinvite']; - $_REQUEST['devinfo_context'] = $device_list['context']; - $_REQUEST['devinfo_host'] = $device_list['host']; - $_REQUEST['devinfo_type'] = $device_list['type']; - $_REQUEST['devinfo_nat'] = $device_list['nat']; - $_REQUEST['devinfo_port'] = $device_list['port']; - $_REQUEST['devinfo_dial'] = $device_list['dial']; - $_REQUEST['devinfo_mailbox'] = $device_list['mailbox']; - $_REQUEST['devinfo_accountcode'] = $device_list['accountcode']; - $_REQUEST['devinfo_username'] = $ext; - //$_REQUEST['devinfo_callerid'] = $device_list['callerid']; - //$_REQUEST['devinfo_record_in'] = $device_list['record_in']; - //$_REQUEST['devinfo_record_out'] = $device_list['record_out']; - - if (isset($device_list['qualify'])) { - $_REQUEST['devinfo_qualify'] = $device_list['qualify']; - } - if (isset($device_list['callgroup'])) { - $_REQUEST['devinfo_callgroup'] = $device_list['callgroup']; - } - if (isset($device_list['pickupgroup'])) { - $_REQUEST['devinfo_pickupgroup'] = $device_list['pickupgroup']; - } - if (isset($device_list['allow'])) { - $_REQUEST['devinfo_allow'] = $device_list['allow']; - } - if (isset($device_list['disallow'])) { - $_REQUEST['devinfo_disallow'] = $device_list['disallow']; - } - - $actions_taken = true; - debug("core_users_edit($ext, $user_add_arr)"); - core_users_edit($ext, $user_mod_arr); - // doesn't return a return code, so hope it worked:-) - - debug("core_devices_del($ext, true)"); - debug("core_devices_add($ext,'sip',".$device_list['dial'].",'fixed',$ext,".$device_list['description'].",".$device_list['emergency_cid'].",true)"); - core_devices_del($ext,true); - core_devices_add($ext,'sip',$device_list['dial'],'fixed',$ext,$device_list['description'],$device_list['emergency_cid'],true); - // doesn't return a return code, so hope it worked:-) - - debug("voicemail_mailbox_del($ext)"); - debug("voicemail_mailbox_add($ext, $user_mod_arr)"); - voicemail_mailbox_del($ext); - voicemail_mailbox_add($ext, $user_mod_arr); - } - - if (in_array('addvm', $actions)) { - $actions_taken = true; - if (($existing_vmbox = voicemail_mailbox_get($ext)) == null ) { - debug("voicemail_mailbox_add($ext, $user_add_arr)"); - voicemail_mailbox_add($ext, $user_add_arr); - } else { - debug(print_r($existing_vmbox,true)); - fatal("voicemail_mailbox_get($ext) indicates the box already exists, aborting"); - exit (1); - } - - // check if we need to create symlink if if addext is not being called - if (!in_array('addext', $actions)) { - - $thisUser = core_users_get($ext); - - // This is a bit kludgey, the other way is to reformat the core_users_get() info and do a core_users_add() in edit mode - // - if (!empty($thisUser)) { - $this_vmcontext = $user_add_arr['vmcontext']; - sql("UPDATE `users` SET `voicemail` = '$this_vmcontext' WHERE `extension` = '$ext'"); - - if ($astman) { - $astman->database_put("AMPUSER",$ext."/voicemail","\"".isset($this_vmcontext)?$this_vmcontext:''."\""); - } - } - - if(isset($this_vmcontext) && $this_vmcontext != "novm") { - if(empty($this_vmcontext)) { - $vmcontext = "default"; - } else { - $vmcontext = $this_vmcontext; - } - //voicemail symlink - // - exec("rm -f /var/spool/asterisk/voicemail/device/".$ext,$output,$return_val); - exec("/bin/ln -s /var/spool/asterisk/voicemail/".$vmcontext."/".$ext."/ /var/spool/asterisk/voicemail/device/".$ext,$output,$return_val); - if ($return_val != 0) { - error("Error code $return_val when sym-linking vmail context $vmcontext to device directory for $ext. Trying to carry on but you should investigate."); - } - } - } - } - - if (in_array('addext', $actions)) { - $actions_taken = true; - $any_users = core_users_get($ext); - debug("core_users_add($user_add_arr)"); - if (isset($any_users['extension']) || !core_users_add($user_add_arr)) { - var_dump($any_users); - fatal("Attempt to add user failed, aborting"); - exit (1); - } - } - - if (in_array('addext', $actions)) { - $actions_taken = true; - debug("core_devices_add($ext, $tech, '', 'fixed', $ext, $displayname, $emergencycid)"); - $any_devices = core_devices_get($ext); - if (count($any_devices) > 0 || !core_devices_add($ext, $tech, '', 'fixed', $ext, $displayname, $emergencycid)) { - var_dump($any_devices); - fatal("Attempt to add device failed, aborting"); - exit (1); - } - } - - if (in_array('remext', $actions)) { - $actions_taken = true; - if (core_users_get($ext) != null) { - debug("removing user $ext"); - core_users_del($ext); - core_devices_del($ext); - } else { - debug("not removing user $ext"); - } - if (voicemail_mailbox_get($ext) != null) { - debug("removing vm $ext"); - voicemail_mailbox_del($ext); - } else { - debug("not removing vm $ext"); - } - } - - if ($actions_taken) { - debug("Request completed successfully"); - exit (0); - } else { - warning("No actions were performed"); - exit (10); - } - exit; -?> diff --git a/bin/cch_tax_tool b/bin/cch_tax_tool deleted file mode 100755 index 6261363..0000000 --- a/bin/cch_tax_tool +++ /dev/null @@ -1,59 +0,0 @@ -#!/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-mysql.import b/bin/cdr-mysql.import deleted file mode 100755 index 608a8dc..0000000 --- a/bin/cdr-mysql.import +++ /dev/null @@ -1,88 +0,0 @@ -#!/usr/bin/perl - -use strict; -use vars qw( $DEBUG ); -use Date::Parse 'str2time'; -use Date::Format 'time2str'; -use FS::UID qw(adminsuidsetup dbh); -use FS::cdr; -use DBI; -use Getopt::Std; - -my %opt; -getopts('H:U:P:D:T:', \%opt); -my $user = shift or die &usage; - -my $dsn = 'dbi:mysql'; -$dsn .= ":database=$opt{D}" if $opt{D}; -$dsn .= ":host=$opt{H}" if $opt{H}; - -my $mysql = DBI->connect($dsn, $opt{U}, $opt{P}) - or die $DBI::errstr; - -adminsuidsetup $user; - -my $fsdbh = FS::UID::dbh; - -# check for existence of freesidestatus -my $table = $opt{T} || 'cdr'; -my $status = $mysql->selectall_arrayref("SHOW COLUMNS FROM $table WHERE Field = 'freesidestatus'"); -if( ! @$status ) { - print "Adding freesidestatus column...\n"; - $mysql->do("ALTER TABLE $table ADD COLUMN freesidestatus varchar(32)") - or die $mysql->errstr; -} -else { - print "freesidestatus column present\n"; -} - -my @cols = ( qw( -calldate clid src dst dcontext channel lastapp lastdata duration - billsec disposition amaflags accountcode uniqueid userfield) ); -my $sql = 'SELECT '.join(',', @cols). " FROM $table WHERE freesidestatus IS NULL"; -my $sth = $mysql->prepare($sql); -$sth->execute; -print "Importing ".$sth->rows." records...\n"; - -my $cdr_batch = new FS::cdr_batch({ - 'cdrbatch' => 'mysql-import-'. time2str('%Y/%m/%d-%T',time), - }); -my $error = $cdr_batch->insert; -die $error if $error; -my $cdrbatchnum = $cdr_batch->cdrbatchnum; -my $imports = 0; -my $updates = 0; - -my $row; -while ( $row = $sth->fetchrow_hashref ) { - my $cdr = FS::cdr->new($row); - $cdr->startdate(str2time($cdr->calldate)); - $cdr->cdrbatchnum($cdrbatchnum); - my $error = $cdr->insert; - if($error) { - print "failed import: $error\n"; - } - else { - $imports++; - if( $mysql->do("UPDATE cdr SET freesidestatus = 'done' - WHERE calldate = ? AND src = ? AND dst = ?", - undef, - $row->{'calldate'}, - $row->{'src'}, - $row->{'dst'}, - - ) ) { - $updates++; - } - else { - print "failed to set status: ".$mysql->errstr."\n"; - } - } -} -print "Done.\nImported $imports CDRs, marked $updates CDRs as done.\n"; -$mysql->disconnect; - -sub usage { - "Usage: \n cdr-mysql.import\n\t[ -H host ]\n\t-D database\n\t-U user\n\t-P password\n\tfreesideuser\n"; -} - diff --git a/bin/cdr-netsapiens.import b/bin/cdr-netsapiens.import deleted file mode 100755 index 8aa4ac0..0000000 --- a/bin/cdr-netsapiens.import +++ /dev/null @@ -1,237 +0,0 @@ -#!/usr/bin/perl -# -# */5 * * * /home/ivan/freeside/bin/cdr-netsapiens.import ivan exportnum - -use strict; -use vars qw( $DEBUG ); -use Date::Format; -use REST::Client; -use FS::UID qw(adminsuidsetup dbh); -use FS::Record qw(qsearchs); -use FS::part_export; -use FS::cdr; - -$DEBUG = 1; - -my $user = shift or die &usage; -adminsuidsetup $user; - -my $exportnum = shift or die &usage; -my $part_export = qsearchs('part_export', { 'exportnum' => $exportnum } ) - or die "unknown exportnum $exportnum\n"; - -my $cdrbatch = 'NetSapiens import '. time2str('%Y-%m-%d %x', $^T); - -my $cdrs = 0; - -do { - - #find max time_release - my $sth = dbh->prepare('SELECT MAX(enddate) FROM cdr') #XXX and imported from this netsapens switch - or die dbh->errstr; - - $sth->execute or die $sth->errstr; - my $time_release = time2str('%Y-%m-%d %X', $sth->fetchrow_arrayref->[0]); - #retreive CDRs >= this time - - my $ns = $part_export->ns_command( 'GET', '/cdr/', - 'time_release' => "$time_release,", - '_sort' => '+time_release', - ); - - #loop over them, double check duplicates, insert the rest - - my $content = $ns->responseContent; - - $cdrs = 0; - - #<a href="/tac2/cdr/20090219201719000016%40SkyNet360.Com">20090219201719000016@SkyNet360.Com</a> - # <form method="post" action="/tac2/cdr/20090219201719000016%40SkyNet360.Com"> - while ( $content =~ - s/^.*?<form class="" method="post" action="\/tac2\/cdr\/(\d{4})(\d+)\%40[^"]*">//is ) - { - - my $cdrid = ($1-1900). $2; #2009 -> 109 so we fit in a bigint - - unless ( $cdrs ) { #inefficient - my $dsth = dbh->prepare( - 'SELECT cdrid FROM cdr WHERE cdrid IS NOT NULL AND cdrid = ?' - ) or die dbh->errstr; - $dsth->execute($cdrid) or die $dsth->errstr; - my $row = $dsth->fetchrow_arrayref; - if ( $row && $row->[0] eq $cdrid ) { # == w/ 8 byte int? - warn "$cdrid (dup)\n" if $DEBUG > 1; - next; - } - } - warn "$cdrid\n" if $DEBUG > 1; - - $content =~ s/(.*?)<\/form>//is; - my $cdr_content = $1; - - my %cdr = (); - while ( $cdr_content =~ - s/.*?<input name="(\w+)" type="\w+" value="([^"]+)" \/>//is ) - { - warn " $1 => $2\n" if $DEBUG > 2; - $cdr{$1} = $2; - } - - $cdrs++; - - my $cdr = new FS::cdr { - 'src' => $cdr{'orig_from_user'}, #orig_sub - 'dst' => $cdr{'orig_to_user'}, #term_sub? - 'startdate' => FS::cdr::_cdr_date_parse($cdr{'time_start'}), - 'enddate' => FS::cdr::_cdr_date_parse($cdr{'time_release'}), - 'duration' => $cdr{'duration'}, - 'billsec' => $cdr{'time_talking'}, - #'disposition' => - #'accountcode' => - #'charged_party' - 'cdrid' => $cdrid, - 'cdrbatch' => $cdrbatch, - }; - - my $error = $cdr->insert; - die $error if $error; - - } - -} while $cdrs; - -sub usage { - "Usage: \n cdr-netsapiens.import user exportnum\n"; -} - -__END__ - - rly_prt_0 => 23946 - orig_req_host => residential.skynet360.com - batch_dura => 0 - orig_from_host => 63.251.149.5 - batch_tim_beg => 2009-02-19 20:17:19 - term_match => sip:7865457300@residential.skynet360.com - term_domain => residential.skynet360.com - term_sub => 7865457300 - orig_req_user => 7865457300 - orig_callid => 5D1164E6-44E011D6-8C84C368-EA5A0BC4@63.251.149.5 - term_ip => 63.251.148.137:1453 - term_to_uri => sip:7865457300@residential.skynet360.com - release_code => end - time_start => 2009-02-19 20:17:19.0 - batch_hold => 0 - orig_from_user => 9046384544 - time_holding => 0 - term_logi_uri => sip:7865457300@residential.skynet360.com - time_talking => 0 - orig_from_uri => sip:9046384544@63.251.149.5 - duration => 0 - orig_logi_uri => sip:9046384544@63.251.149.5 - rly_cnt_b => 0 - time_insert => 2009-02-19 15:17:38.0 - orig_to_user => 7865457300 - rly_prt_a => 63.251.149.18:21972 - cdr_index => 0 - orig_to_host => 63.251.149.18 - orig_match => sip:*@63.251.149.5 - time_release => 2009-02-19 20:17:37 - codec => G.711 u-law - orig_req_uri => sip:7865457300@residential.skynet360.com - orig_to_uri => sip:7865457300@63.251.149.18 - rly_cnt_a => 13 - orig_ip => 63.251.149.5:57326 - release_text => Orig: Cancel - time_disp => 0 - time_ringing => 2009-02-19 20:17:19 - _method => put -prt_0 => 23946 - orig_req_host => residential.skynet360.com - batch_dura => 0 - orig_from_host => 63.251.149.5 - batch_tim_beg => 2009-02-19 20:17:19 - term_match => sip:7865457300@residential.skynet360.com - term_domain => residential.skynet360.com - time_start => 2009-02-19 20:17:19.0 - term_sub => 7865457300 - orig_req_user => 7865457300 - orig_callid => 5D1164E6-44E011D6-8C84C368-EA5A0BC4@63.251.149.5 - term_ip => 63.251.148.137:1453 - term_to_uri => sip:7865457300@residential.skynet360.com - release_code => end - time_start => 2009-02-19 20:17:19.0 - batch_hold => 0 - orig_from_user => 9046384544 - time_holding => 0 - term_logi_uri => sip:7865457300@residential.skynet360.com - time_talking => 0 - orig_from_uri => sip:9046384544@63.251.149.5 - duration => 0 - orig_logi_uri => sip:9046384544@63.251.149.5 - rly_cnt_b => 0 - time_insert => 2009-02-19 15:17:38.0 - orig_to_user => 7865457300 - rly_prt_a => 63.251.149.18:21972 - cdr_index => 0 - orig_to_host => 63.251.149.18 - orig_match => sip:*@63.251.149.5 - time_release => 2009-02-19 20:17:37 - codec => G.711 u-law - orig_req_uri => sip:7865457300@residential.skynet360.com - orig_to_uri => sip:7865457300@63.251.149.18 - rly_cnt_a => 13 - orig_ip => 63.251.149.5:57326 - release_text => Orig: Cancel - time_disp => 0 - time_ringing => 2009-02-19 20:17:19 - _method => put - -list of freeside CDR fields, useful ones marked with * - - acctid - primary key -*[1] calldate - Call timestamp (SQL timestamp) - clid - Caller*ID with text -* src - Caller*ID number / Source number -* dst - Destination extension - dcontext - Destination context - channel - Channel used - dstchannel - Destination channel if appropriate - lastapp - Last application if appropriate - lastdata - Last application data -* startdate - Start of call (UNIX-style integer timestamp) - answerdate - Answer time of call (UNIX-style integer timestamp) -* enddate - End time of call (UNIX-style integer timestamp) -* duration - Total time in system, in seconds -* billsec - Total time call is up, in seconds -*[2] disposition - What happened to the call: ANSWERED, NO ANSWER, BUSY - amaflags - What flags to use: BILL, IGNORE etc, specified on a per - channel basis like accountcode. -*[3] accountcode - CDR account number to use: account - uniqueid - Unique channel identifier (Unitel/RSLCOM Event ID) - userfield - CDR user-defined field - cdr_type - CDR type - see FS::cdr_type (Usage = 1, S&E = 7, OC&C = 8) -*[4] charged_party - Service number to be billed - upstream_currency - Wholesale currency from upstream -*[5] upstream_price - Wholesale price from upstream - upstream_rateplanid - Upstream rate plan ID - rated_price - Rated (or re-rated) price - distance - km (need units field?) - islocal - Local - 1, Non Local = 0 -*[6] calltypenum - Type of call - see FS::cdr_calltype - description - Description (cdr_type 7&8 only) (used for - cust_bill_pkg.itemdesc) - quantity - Number of items (cdr_type 7&8 only) - carrierid - Upstream Carrier ID (see FS::cdr_carrier) - upstream_rateid - Upstream Rate ID - svcnum - Link to customer service (see FS::cust_svc) - freesidestatus - NULL, done (or something) - -[1] Auto-populated from startdate if not present -[2] Package options available to ignore calls without a specific disposition -[3] When using 'cdr-charged_party-accountcode' config -[4] Auto-populated from src (normal calls) or dst (toll free calls) if not present -[5] When using 'upstream_simple' rating method. -[6] Set to usage class classnum when using pre-rated CDRs and usage class-based - taxation (local/intrastate/interstate/international) - - diff --git a/bin/cdr-transnexus.import b/bin/cdr-transnexus.import deleted file mode 100755 index b9fe41a..0000000 --- a/bin/cdr-transnexus.import +++ /dev/null @@ -1,143 +0,0 @@ -#!/usr/bin/perl - -use strict; -use Getopt::Std; -use Net::SFTP::Foreign; -use FS::UID qw(adminsuidsetup datasrc); -use FS::cdr; - -### -# parse command line -### - -use vars qw( $opt_p $opt_d $opt_v ); -getopts('v'); - -$opt_p = 'last'; -$opt_d = 'done'; - -my $user = shift or die &usage; -adminsuidsetup $user; - -# %%%FREESIDE_CACHE%%% -my $cachedir = '/usr/local/etc/freeside/cache.'. datasrc. '/cdrs'; -mkdir $cachedir unless -d $cachedir; - -#my $format = shift or die &usage; -my $format = 'transnexus'; - -use vars qw( $servername ); -$servername = shift or die &usage; - -my $DIR = '/home/ossadmin/OSS/nexoss/CDR_ARCHIVE_BY_ACCOUNT'; - -### -# get the file list -### - -warn "Retreiving directory listing\n" if $opt_v; - -my $ls_sftp = sftp(); - -my $lsdir = $ls_sftp->ls($DIR); - -### -# import each file in each dir -### - -foreach my $dir ( @$lsdir ) { - - my $dirname = $dir->{filename}; - warn "Scanning dir $dirname\n" if $opt_v; - - #my $ls = $ls_sftp->ls("$DIR/$dirname", wanted => qr/^$opt_p.*-CDRs$/i ); - my $ls = $ls_sftp->ls("$DIR/$dirname", wanted => qr/^$opt_p.*Customer-CDRs$/i ); - - foreach my $file ( @$ls ) { - - my $filename = $file->{filename}; - warn "Downloading $filename\n" if $opt_v; - - #get the file - my $get_sftp = sftp(); - $get_sftp->get("$DIR/$dirname/$filename", "$cachedir/$filename") - or die "Can't get $filename: ". $get_sftp->error; - - warn "Processing $filename\n" if $opt_v; - - my $error = FS::cdr::batch_import( { - 'file' => "$cachedir/$filename", - 'format' => $format, - 'batch_namevalue' => $filename, - 'empty_ok' => 1, - } ); - die $error if $error; - - if ( $opt_d ) { - my $mv_sftp = sftp(); - $mv_sftp->mkdir("$DIR/$dirname/$opt_d"); - $mv_sftp->rename( "$DIR/$dirname/$filename", - "$DIR/$dirname/$opt_d/$filename" ) - or die "can't move $filename to $opt_d: ". $mv_sftp->error; - } - - unlink "$cachedir/$filename"; - - } - -} - -### -# subs -### - -sub usage { - "Usage: \n cdr-transnexus.import [ -v ] user [sftpuser@]servername\n"; -} - -use vars qw( $sftp ); - -sub sftp { - - #reuse connections - return $sftp if $sftp && $sftp->cwd; - - my %sftp = ( host => $servername ); - - $sftp = Net::SFTP::Foreign->new(%sftp); - $sftp->error and die "SFTP connection failed: ". $sftp->error; - - $sftp; -} - -=head1 NAME - -cdr.sftp_and_import - Download CDR files from a remote server via SFTP - -=head1 SYNOPSIS - - cdr-transnexus.import [ -v ] user [sftpuser@]servername - -=head1 DESCRIPTION - -Command line tool to download CDR files from a remote server via SFTP and then -import them into the database. - --v: verbose - -user: freeside username - -[sftpuser@]servername: remote server - -=head1 BUGS - -Hacked up copy of freeside-cdr-sftp_and_import - -=head1 SEE ALSO - -L<FS::cdr> - -=cut - -1; - diff --git a/bin/cdr.http_and_import b/bin/cdr.http_and_import deleted file mode 100755 index 8910eec..0000000 --- a/bin/cdr.http_and_import +++ /dev/null @@ -1,108 +0,0 @@ -#!/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, - 'batch_namevalue' => $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 deleted file mode 100644 index 36266ef..0000000 --- a/bin/cdr.import +++ /dev/null @@ -1,28 +0,0 @@ -#!/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, - 'batch_namevalue' => $file, -} ); -die $error if $error; - -sub usage { - "Usage: \n cdr.import user format filename\n"; -} - diff --git a/bin/cdr_calltype.import b/bin/cdr_calltype.import deleted file mode 100755 index a998284..0000000 --- a/bin/cdr_calltype.import +++ /dev/null @@ -1,41 +0,0 @@ -#!/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 deleted file mode 100755 index fda3883..0000000 --- a/bin/cdr_upstream_rate.import +++ /dev/null @@ -1,142 +0,0 @@ -#!/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/confdiff b/bin/confdiff deleted file mode 100755 index 5b6af85..0000000 --- a/bin/confdiff +++ /dev/null @@ -1,27 +0,0 @@ -#!/usr/bin/perl - -use FS::UID qw(adminsuidsetup); -use FS::Conf; - -adminsuidsetup('ivan'); - -my $conf = new FS::Conf; - -my $file2 = pop @ARGV; -my $file1 = pop @ARGV; - -open(FILE1, ">/tmp/$file1") or die "can't open /tmp/$file1: $!"; -print FILE1 $conf->config($file1); -print FILE1 "\n"; -close FILE1 or die $!; - -open(FILE2, ">/tmp/$file2") or die "can't open /tmp/$file2: $!"; -print FILE2 $conf->config($file2); -print FILE2 "\n"; -close FILE2 or die $!; - -my @opt = @ARGV; - -system('diff', @opt, "/tmp/$file1", "/tmp/$file2"); - -#unlink("/tmp/$file1', "/tmp/$file2"); diff --git a/bin/countdeclines b/bin/countdeclines deleted file mode 100755 index bbc3925..0000000 --- a/bin/countdeclines +++ /dev/null @@ -1,22 +0,0 @@ -#!/usr/bin/perl - -use Date::Parse; - -my $e = 'PlugnPay error: 97: Declined for CVV failure'; -my @y = (2008,2009); - -my $p = 0; - -foreach my $y (@y) { - foreach my $m (1..12) { - my $d = "$m/1/$y"; - my $t = str2time($d); - - #print "$pd-$d: SELECT count(*) from cust_bill_event where statustext = '$e' and _date >= $p and _date < $t;\n" - print "SELECT count(*) from cust_bill_event where statustext = '$e' and _date >= $p and _date < $t;\n" - if $p; - - $p = $t; - $pd = $d; - } -} diff --git a/bin/create-fetchmailrc b/bin/create-fetchmailrc deleted file mode 100644 index 11bde0c..0000000 --- a/bin/create-fetchmailrc +++ /dev/null @@ -1,47 +0,0 @@ -#!/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/cust_main-find_bogus_geocode b/bin/cust_main-find_bogus_geocode deleted file mode 100755 index 04a38a9..0000000 --- a/bin/cust_main-find_bogus_geocode +++ /dev/null @@ -1,36 +0,0 @@ -#!/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: cust_main-find_bogus_geocode username\n"; -adminsuidsetup $user; - -my @cust_main = qsearch({ - 'table' => 'cust_main', - 'extra_sql' => 'WHERE geocode IS NOT NULL', -}); - -foreach my $cust_main ( @cust_main ) { - - my $db_geocode = $cust_main->geocode; - - $cust_main->set('geocode', ''); - - my $calc_geocode = $cust_main->geocode('cch'); - - next unless $calc_geocode; - - my $cust = $cust_main->custnum.': '. $cust_main->name. "\n"; - - if ( $db_geocode eq $calc_geocode ) { - warn "unnecessary geocode override for $cust"; - } else { - warn "bogus geocode override $db_geocode overrides $calc_geocode for $cust"; - } - -} - -1; diff --git a/bin/cust_main_special.pm b/bin/cust_main_special.pm deleted file mode 100644 index 967b6be..0000000 --- a/bin/cust_main_special.pm +++ /dev/null @@ -1,608 +0,0 @@ -package cust_main_special; - -require 5.006; -use strict; -use vars qw( @ISA $DEBUG $me $conf ); -use Safe; -use Carp; -use Data::Dumper; -use Date::Format; -use FS::UID qw( dbh ); -use FS::Record qw( qsearchs qsearch ); -use FS::payby; -use FS::cust_pkg; -use FS::cust_bill; -use FS::cust_bill_pkg; -use FS::cust_bill_pkg_display; -use FS::cust_bill_pkg_tax_location; -use FS::cust_main_county; -use FS::cust_location; -use FS::tax_rate; -use FS::cust_tax_location; -use FS::part_pkg_taxrate; -use FS::queue; -use FS::part_pkg; - -@ISA = qw ( FS::cust_main ); - -$DEBUG = 0; -$me = '[emergency billing program]'; - -$conf = new FS::Conf; - -=head1 METHODS - -=over 4 - -=item bill OPTIONS - -Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in -conjunction with the collect method by calling B<bill_and_collect>. - -If there is an error, returns the error, otherwise returns false. - -Options are passed as name-value pairs. Currently available options are: - -=over 4 - -=item resetup - -If set true, re-charges setup fees. - -=item time - -Bills the customer as if it were that time. Specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions. For example: - - use Date::Parse; - ... - $cust_main->bill( 'time' => str2time('April 20th, 2001') ); - -=item pkg_list - -An array ref of specific packages (objects) to attempt billing, instead trying all of them. - - $cust_main->bill( pkg_list => [$pkg1, $pkg2] ); - -=item invoice_time - -Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices. Other calculations, such as whether or not to generate the invoice in the first place, are not affected. - -=item backbill - -Used to specify the period starting date and preventing normal billing. Instead all outstanding cdrs/usage are processed as if from the unix timestamp in backbill and without changing the dates in the customer packages. Useful in those situations when cdrs were not imported before a billing run - -=back - -=cut - -sub bill { - my( $self, %options ) = @_; - - bless $self, 'cust_main_special'; - return '' if $self->payby eq 'COMP'; - warn "$me backbill usage for customer ". $self->custnum. "\n" - if $DEBUG; - - my $time = $options{'time'} || time; - my $invoice_time = $options{'invoice_time'} || $time; - - #put below somehow? - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - $self->select_for_update; #mutex - - my @cust_bill_pkg = (); - - ### - # find the packages which are due for billing, find out how much they are - # & generate invoice database. - ### - - my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 ); - my %taxlisthash; - my @precommit_hooks = (); - - my @cust_pkgs = qsearch('cust_pkg', { 'custnum' => $self->custnum } ); - foreach my $cust_pkg (@cust_pkgs) { - - #NO!! next if $cust_pkg->cancel; - next if $cust_pkg->getfield('cancel'); - - warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1; - - #? to avoid use of uninitialized value errors... ? - $cust_pkg->setfield('bill', '') - unless defined($cust_pkg->bill); - - #my $part_pkg = $cust_pkg->part_pkg; - - my $real_pkgpart = $cust_pkg->pkgpart; - my %hash = $cust_pkg->hash; - - foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) { - - $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill ); - - my $error = - $self->_make_lines( 'part_pkg' => $part_pkg, - 'cust_pkg' => $cust_pkg, - 'precommit_hooks' => \@precommit_hooks, - 'line_items' => \@cust_bill_pkg, - 'setup' => \$total_setup, - 'recur' => \$total_recur, - 'tax_matrix' => \%taxlisthash, - 'time' => $time, - 'options' => \%options, - ); - if ($error) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - } #foreach my $part_pkg - - } #foreach my $cust_pkg - - unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items - unless ( $options{backbill} ) { - #but do commit any package date cycling that happened - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - } else { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - } - return ''; - } - - my $postal_pkg = $self->charge_postal_fee(); - if ( $postal_pkg && !ref( $postal_pkg ) ) { - $dbh->rollback if $oldAutoCommit; - return "can't charge postal invoice fee for customer ". - $self->custnum. ": $postal_pkg"; - } - if ( !$options{backbill} && $postal_pkg && - ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) || - !$conf->exists('postal_invoice-recurring_only') - ) - ) - { - foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) { - my $error = - $self->_make_lines( 'part_pkg' => $part_pkg, - 'cust_pkg' => $postal_pkg, - 'precommit_hooks' => \@precommit_hooks, - 'line_items' => \@cust_bill_pkg, - 'setup' => \$total_setup, - 'recur' => \$total_recur, - 'tax_matrix' => \%taxlisthash, - 'time' => $time, - 'options' => \%options, - ); - if ($error) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - - warn "having a look at the taxes we found...\n" if $DEBUG > 2; - - # keys are tax names (as printed on invoices / itemdesc ) - # values are listrefs of taxlisthash keys (internal identifiers) - my %taxname = (); - - # keys are taxlisthash keys (internal identifiers) - # values are (cumulative) amounts - my %tax = (); - - # keys are taxlisthash keys (internal identifiers) - # values are listrefs of cust_bill_pkg_tax_location hashrefs - my %tax_location = (); - - foreach my $tax ( keys %taxlisthash ) { - my $tax_object = shift @{ $taxlisthash{$tax} }; - warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2; - warn " ". join('/', @{ $taxlisthash{$tax} } ). "\n" if $DEBUG > 2; - my $hashref_or_error = - $tax_object->taxline( $taxlisthash{$tax}, - 'custnum' => $self->custnum, - 'invoice_time' => $invoice_time - ); - unless ( ref($hashref_or_error) ) { - $dbh->rollback if $oldAutoCommit; - return $hashref_or_error; - } - unshift @{ $taxlisthash{$tax} }, $tax_object; - - my $name = $hashref_or_error->{'name'}; - my $amount = $hashref_or_error->{'amount'}; - - #warn "adding $amount as $name\n"; - $taxname{ $name } ||= []; - push @{ $taxname{ $name } }, $tax; - - $tax{ $tax } += $amount; - - $tax_location{ $tax } ||= []; - if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) { - push @{ $tax_location{ $tax } }, - { - 'taxnum' => $tax_object->taxnum, - 'taxtype' => ref($tax_object), - 'pkgnum' => $tax_object->get('pkgnum'), - 'locationnum' => $tax_object->get('locationnum'), - 'amount' => sprintf('%.2f', $amount ), - }; - } - - } - - #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit - my %packagemap = map { $_->pkgnum => $_ } @cust_bill_pkg; - foreach my $tax ( keys %taxlisthash ) { - foreach ( @{ $taxlisthash{$tax} }[1 ... scalar(@{ $taxlisthash{$tax} })] ) { - next unless ref($_) eq 'FS::cust_bill_pkg'; - - push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg }, - splice( @{ $_->_cust_tax_exempt_pkg } ); - } - } - - #consolidate and create tax line items - warn "consolidating and generating...\n" if $DEBUG > 2; - foreach my $taxname ( keys %taxname ) { - my $tax = 0; - my %seen = (); - my @cust_bill_pkg_tax_location = (); - warn "adding $taxname\n" if $DEBUG > 1; - foreach my $taxitem ( @{ $taxname{$taxname} } ) { - next if $seen{$taxitem}++; - warn "adding $tax{$taxitem}\n" if $DEBUG > 1; - $tax += $tax{$taxitem}; - push @cust_bill_pkg_tax_location, - map { new FS::cust_bill_pkg_tax_location $_ } - @{ $tax_location{ $taxitem } }; - } - next unless $tax; - - $tax = sprintf('%.2f', $tax ); - $total_setup = sprintf('%.2f', $total_setup+$tax ); - - push @cust_bill_pkg, new FS::cust_bill_pkg { - 'pkgnum' => 0, - 'setup' => $tax, - 'recur' => 0, - 'sdate' => '', - 'edate' => '', - 'itemdesc' => $taxname, - 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location, - }; - - } - - my $charged = sprintf('%.2f', $total_setup + $total_recur ); - - #create the new invoice - my $cust_bill = new FS::cust_bill ( { - 'custnum' => $self->custnum, - '_date' => ( $invoice_time ), - 'charged' => $charged, - } ); - my $error = $cust_bill->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't create invoice for customer #". $self->custnum. ": $error"; - } - - foreach my $cust_bill_pkg ( @cust_bill_pkg ) { - $cust_bill_pkg->invnum($cust_bill->invnum); - my $error = $cust_bill_pkg->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't create invoice line item: $error"; - } - } - - - #foreach my $hook ( @precommit_hooks ) { - # eval { - # &{$hook}; #($self) ? - # }; - # if ( $@ ) { - # $dbh->rollback if $oldAutoCommit; - # return "$@ running precommit hook $hook\n"; - # } - #} - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; #no error -} - - -sub _make_lines { - my ($self, %params) = @_; - - warn " making lines\n" if $DEBUG > 1; - my $part_pkg = $params{part_pkg} or die "no part_pkg specified"; - my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified"; - my $precommit_hooks = $params{precommit_hooks} or die "no package specified"; - my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified"; - my $total_setup = $params{setup} or die "no setup accumulator specified"; - my $total_recur = $params{recur} or die "no recur accumulator specified"; - my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified"; - my $time = $params{'time'} or die "no time specified"; - my (%options) = %{$params{options}}; - - my $dbh = dbh; - my $real_pkgpart = $cust_pkg->pkgpart; - my %hash = $cust_pkg->hash; - my $old_cust_pkg = new FS::cust_pkg \%hash; - my $backbill = $options{backbill} || 0; - - my @details = (); - - my $lineitems = 0; - - $cust_pkg->pkgpart($part_pkg->pkgpart); - - ### - # bill setup - ### - - my $setup = 0; - my $unitsetup = 0; - if ( ! $cust_pkg->setup && - ( - ( $conf->exists('disable_setup_suspended_pkgs') && - ! $cust_pkg->getfield('susp') - ) || ! $conf->exists('disable_setup_suspended_pkgs') - ) - || $options{'resetup'} - ) { - - warn " bill setup\n" if $DEBUG > 1; - $lineitems++; - - $setup = eval { $cust_pkg->calc_setup( $time, \@details ) }; - return "$@ running calc_setup for $cust_pkg\n" - if $@; - - $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh - - $cust_pkg->setfield('setup', $time) - unless $cust_pkg->setup; - #do need it, but it won't get written to the db - #|| $cust_pkg->pkgpart != $real_pkgpart; - - } - - ### - # bill recurring fee - ### - - #XXX unit stuff here too - my $recur = 0; - my $unitrecur = 0; - my $sdate; - if ( ! $cust_pkg->getfield('susp') and - ( $part_pkg->getfield('freq') ne '0' && - ( $cust_pkg->getfield('bill') || 0 ) <= $time - ) - || ( $part_pkg->plan eq 'voip_cdr' - && $part_pkg->option('bill_every_call') - ) - || $backbill - ) { - - # XXX should this be a package event? probably. events are called - # at collection time at the moment, though... - $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG) - if $part_pkg->can('reset_usage'); - #don't want to reset usage just cause we want a line item?? - #&& $part_pkg->pkgpart == $real_pkgpart; - - warn " bill recur\n" if $DEBUG > 1; - $lineitems++; - - # XXX shared with $recur_prog - $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; - $sdate = $cust_pkg->lastbill || $backbill if $backbill; - - #over two params! lets at least switch to a hashref for the rest... - my $increment_next_bill = ( $part_pkg->freq ne '0' - && ( $cust_pkg->getfield('bill') || 0 ) <= $time - ); - my %param = ( 'precommit_hooks' => $precommit_hooks, - 'increment_next_bill' => $increment_next_bill, - ); - - $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) }; - return "$@ running calc_recur for $cust_pkg\n" - if ( $@ ); - - - warn "details is now: \n" if $DEBUG > 2; - warn Dumper(\@details) if $DEBUG > 2; - - if ( $increment_next_bill ) { - - my $next_bill = $part_pkg->add_freq($sdate); - return "unparsable frequency: ". $part_pkg->freq - if $next_bill == -1; - - #pro-rating magic - if $recur_prog fiddled $sdate, want to use that - # only for figuring next bill date, nothing else, so, reset $sdate again - # here - $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; - $sdate = $cust_pkg->lastbill || $backbill if $backbill; - #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill; - $cust_pkg->last_bill($sdate); - - $cust_pkg->setfield('bill', $next_bill ); - - } - - } - - warn "\$setup is undefined" unless defined($setup); - warn "\$recur is undefined" unless defined($recur); - warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill); - - ### - # If there's line items, create em cust_bill_pkg records - # If $cust_pkg has been modified, update it (if we're a real pkgpart) - ### - - if ( $lineitems ) { - - if ( !$backbill && $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) { - # hmm.. and if just the options are modified in some weird price plan? - - warn " package ". $cust_pkg->pkgnum. " modified; updating\n" - if $DEBUG >1; - - my $error = $cust_pkg->replace( $old_cust_pkg, - 'options' => { $cust_pkg->options }, - ); - return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error" - if $error; #just in case - } - - my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I'); - if ( $DEBUG > 1 ) { - warn " tentatively adding customer package invoice detail: $_\n" - foreach @cust_pkg_detail; - } - push @details, @cust_pkg_detail; - - $setup = sprintf( "%.2f", $setup ); - $recur = sprintf( "%.2f", $recur ); - my $cust_bill_pkg = new FS::cust_bill_pkg { - 'pkgnum' => $cust_pkg->pkgnum, - 'setup' => $setup, - 'unitsetup' => $unitsetup, - 'recur' => $recur, - 'unitrecur' => $unitrecur, - 'quantity' => $cust_pkg->quantity, - 'details' => \@details, - }; - - warn "created cust_bill_pkg which looks like:\n" if $DEBUG > 2; - warn Dumper($cust_bill_pkg) if $DEBUG > 2; - if ($backbill) { - my %usage_cust_bill_pkg = $cust_bill_pkg->disintegrate; - $recur = 0; - foreach my $key (keys %usage_cust_bill_pkg) { - next if ($key eq 'setup' || $key eq 'recur'); - $recur += $usage_cust_bill_pkg{$key}->recur; - } - $setup = 0; - } - - $setup = sprintf( "%.2f", $setup ); - $recur = sprintf( "%.2f", $recur ); - if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) { - return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum; - } - if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) { - return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum; - } - - - if ( $setup != 0 || $recur != 0 ) { - - warn " charges (setup=$setup, recur=$recur); adding line items\n" - if $DEBUG > 1; - - $cust_bill_pkg->setup($setup); - $cust_bill_pkg->recur($recur); - - warn "cust_bill_pkg now looks like:\n" if $DEBUG > 2; - warn Dumper($cust_bill_pkg) if $DEBUG > 2; - - if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) { - $cust_bill_pkg->sdate( $hash{last_bill} ); - $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1 - } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) { - $cust_bill_pkg->sdate( $sdate ); - $cust_bill_pkg->edate( $cust_pkg->bill ); - } - - $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart) - unless $part_pkg->pkgpart == $real_pkgpart; - - $$total_setup += $setup; - $$total_recur += $recur; - - ### - # handle taxes - ### - - my $error = - $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}); - return $error if $error; - - push @$cust_bill_pkgs, $cust_bill_pkg; - - } #if $setup != 0 || $recur != 0 - - } #if $line_items - - ''; - -} - - -sub _gather_taxes { - my $self = shift; - my $part_pkg = shift; - my $class = shift; - - my @taxes = (); - my $geocode = $self->geocode('cch'); - - my @taxclassnums = map { $_->taxclassnum } - $part_pkg->part_pkg_taxoverride($class); - - unless (@taxclassnums) { - @taxclassnums = map { $_->taxclassnum } - $part_pkg->part_pkg_taxrate('cch', $geocode, $class); - } - warn "Found taxclassnum values of ". join(',', @taxclassnums) - if $DEBUG; - - my $extra_sql = - "AND (". - join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")"; - - @taxes = grep { ($_->fee || 0 ) == 0 } #ignore unit based taxes - qsearch({ 'table' => 'tax_rate', - 'hashref' => { 'geocode' => $geocode, }, - 'extra_sql' => $extra_sql, - }) - if scalar(@taxclassnums); - - warn "Found taxes ". - join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n" - if $DEBUG; - - [ @taxes ]; - -} - - -=back - - -=cut - -1; - diff --git a/bin/cust_pay_histogram b/bin/cust_pay_histogram deleted file mode 100755 index 714b321..0000000 --- a/bin/cust_pay_histogram +++ /dev/null @@ -1,115 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Getopt::Std; -use Date::Parse; -use FS::UID qw(adminsuidsetup); -use FS::Record qw( qsearch ); -use FS::cust_pay; - -&untaint_argv; #what it sounds like (eww) -use vars qw(%opt); -getopts("p:a:b:e:", \%opt); - -my $user = shift or die &usage; -my $dbh = adminsuidsetup $user; - -my @where = (); - -push @where, 'agentnum = '. $dbh->quote($opt{a}) if $opt{a}; -push @where, 'cust_pay.payby = '. $dbh->quote($opt{p}) if $opt{p}; -push @where, 'cust_pay._date > '. $dbh->quote(str2time($opt{b})) if $opt{b}; -push @where, 'cust_pay._date < '. $dbh->quote(str2time($opt{e})) if $opt{e}; - -my $extra_sql = scalar(@where) ? 'WHERE '. join(' AND ', @where) : ''; -my $addl_from = 'LEFT JOIN cust_main USING( custnum )'; - -my @payrow = qsearch( { table => 'cust_pay', - hashref => {}, - select => 'count(*) AS quantity, paid', - addl_from => $addl_from, - extra_sql => $extra_sql, - order_by => 'GROUP BY paid', - } - ); - -my $max = 0; -my $sum = 0; -foreach (@payrow) { - $sum += $_->quantity; - $max = $_->quantity if $_->quantity > $max; -} -my $scale = int($max/60) + 1; - -print "\n PAYMENTS RECEIVED"; -print " AFTER $opt{b}" if $opt{b}; -print " UNTIL $opt{e}" if $opt{e}; -print " VIA $opt{p}" if $opt{p}; -print " BY AGENT $opt{a}" if $opt{a}; -print "\n\n"; -print "Total number of payments: $sum\n\n"; -print "(each * represents $scale)\n\n" if $scale > 1; - -foreach my $payrow ( @payrow ) { - print sprintf("%10.2f", $payrow->paid), - ": ", - sprintf("%6d", $payrow->quantity), - "| ", - '*' x($payrow->quantity/$scale), - "\n"; -} - -print "\n"; - - -### -# subroutines -### - -sub untaint_argv { - foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; - # Date::Parse - $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; - $ARGV[$_]=$1; - } -} - -sub usage { - die "Usage:\n\n cust_pay_histogram [ -b 'begin_date' ] [ -e 'end_date' ] [ -p 'payby' ] [ -a agentnum ] user\n"; -} - -### -# documentation -### - -=head1 NAME - -cust_pay_histogram - Show a histogram of payments made for a date range. - -=head1 SYNOPSIS - - freeside-daily [ -b 'begin_date' ] [ -e 'end_date'] [ -p 'payby' ] [ -a agentnum ] user - -=head1 DESCRIPTION - -Displays a histogram of cust_pay records in the database. - - -b: Include only payments since 'begin_date'. Date is in any format Date::Parse is happy with, but be careful. - - -e: Include only payments before 'end_date'. Date is in any format Date::Parse is happy with, but be careful. - - -p: Only process payments with the specified payby (I<CARD>, I<DCRD>, I<CHEK>, I<DCHK>, I<BILL>, I<COMP>, I<LECB>) - - -a: Only process payments of customers with the specified agentnum - -user: From the mapsecrets file - see config.html from the base documentation - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::cust_pay> - -=cut - diff --git a/bin/customer-faker b/bin/customer-faker deleted file mode 100755 index 236a412..0000000 --- a/bin/customer-faker +++ /dev/null @@ -1,124 +0,0 @@ -#!/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/cvs2cl b/bin/cvs2cl deleted file mode 100755 index 1c1bfb0..0000000 --- a/bin/cvs2cl +++ /dev/null @@ -1,2 +0,0 @@ -#!/bin/sh -cvs2cl -F trunk diff --git a/bin/del-old-history b/bin/del-old-history deleted file mode 100755 index 5c9412a..0000000 --- a/bin/del-old-history +++ /dev/null @@ -1,30 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use FS::UID qw(adminsuidsetup dbh); -use FS::Record; #why is this necessary - -#WARNING: not all tables are safe to remove history! -# these are, and seem to take the most space in a typical install with queued -# exports -my @tables = qw( h_queue h_queue_arg ); - -my $years = 2; -my $seconds = $years * 31556926; #60*60*24*365.2422 is close enough -my $before = int( time - $seconds ); - -adminsuidsetup shift or die "usage: del-old-history user\n"; - -foreach my $table ( @tables ) { - - unless ( $table =~ /^h_/ ) { - warn "$table is not a history table, skipping\n"; - next; - } - - my $sql = "DELETE FROM $table WHERE history_date < $before"; - warn "$sql\n"; - my $sth = dbh->prepare($sql) or die dbh->errstr; - $sth->execute or die $sth->errstr; - -} diff --git a/bin/drop_slony.slonik b/bin/drop_slony.slonik deleted file mode 100644 index 04ffaca..0000000 --- a/bin/drop_slony.slonik +++ /dev/null @@ -1,9 +0,0 @@ -cluster name = freeside; - -node 1 admin conninfo = 'dbname=freeside host=XXX user=postgres'; -node 2 admin conninfo = 'dbname=freeside host=XXX user=postgres'; - -drop set (id=1, origin=1); - -uninstall node ( id=1 ); - diff --git a/bin/expand-country b/bin/expand-country deleted file mode 100755 index c6f2a1f..0000000 --- a/bin/expand-country +++ /dev/null @@ -1,29 +0,0 @@ -#!/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 deleted file mode 100644 index f154430..0000000 --- a/bin/explain-ar-total.sql +++ /dev/null @@ -1,976 +0,0 @@ -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/explain-bill-query b/bin/explain-bill-query deleted file mode 100644 index e3f6978..0000000 --- a/bin/explain-bill-query +++ /dev/null @@ -1,34 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Getopt::Std; -use FS::UID qw(adminsuidsetup dbh); -use FS::Cron::bill qw(bill_where); - -my $user = 'fs_daily'; - -#&untaint_argv; #what it sounds like (eww) -use vars qw(%opt); -getopts("p:a:d:vl:sy:nmrk", \%opt); - -adminsuidsetup $user; - - #we're at now now (and later). - $opt{'time'} = $opt{'d'} ? str2time($opt{'d'}) : $^T; - $opt{'time'} += $opt{'y'} * 86400 if $opt{'y'}; - - $opt{'invoice_time'} = $opt{'n'} ? $^T : $opt{'time'}; - - -my $sql = 'EXPLAIN SELECT custnum FROM cust_main WHERE '. bill_where(%opt); - -my $sth = dbh->prepare($sql) or die dbh->errstr; - -$sth->execute or die $sth->errstr; - -while ( my $row = $sth->fetchrow_arrayref ) { - - print join(' / ', @$row ). "\n"; - -} - diff --git a/bin/fetch_and_expand_taxes b/bin/fetch_and_expand_taxes deleted file mode 100755 index 186d6df..0000000 --- a/bin/fetch_and_expand_taxes +++ /dev/null @@ -1,55 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use LWP::UserAgent; -use HTTP::Request; -use HTTP::Response; -use FS::UID qw(adminsuidsetup); -use FS::Conf; - -my $user = shift or die &usage; -my $dir = shift or die &usage; - - -adminsuidsetup $user; - -my $conf = new FS::Conf; - -chdir $dir or die "can't change to $dir: $!\n"; - -die "direct download of tax data not enabled\n" - unless $conf->exists('taxdatadirectdownload'); -my ( $urls, $username, $secret, $states ) = - $conf->config('taxdatadirectdownload'); -die "No tax download URL provided. ". - "Did you set the taxdatadirectdownload configuration value?\n" - unless $urls; - -my $ua = new LWP::UserAgent; - foreach my $url (split ',', $urls) { - my @name = split '/', $url; #somewhat restrictive - my $name = pop @name; - $name =~ /(.*)/; # untaint that which we trust; - $name = $1; - - open my $taxfh, ">$name" or die "Can't open $name: $!\n"; - - my $res = $ua->request( - new HTTP::Request( GET => $url), - sub { #my ($data, $response_object) = @_; - print $taxfh $_[0] or die "Can't write to $dir.new/$name: $!\n"; - }, - ); - die "download of $url failed: ". $res->status_line - unless $res->is_success; - close $taxfh; - $secret =~ /(.*)/; # untaint that which we trust; - $secret = $1; - system('unzip', "-P", $secret, $name) == 0 - or die "unzip -P $secret $name failed"; -} - -sub usage { - die "Usage:\n\n fetch_and_expand_taxes user dir\n"; -} - diff --git a/bin/find-overapplied b/bin/find-overapplied deleted file mode 100644 index 7973cef..0000000 --- a/bin/find-overapplied +++ /dev/null @@ -1,27 +0,0 @@ -#!/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 deleted file mode 100755 index dc4abd7..0000000 --- a/bin/fix-sequences +++ /dev/null @@ -1,69 +0,0 @@ -#!/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 deleted file mode 100644 index b7536e8..0000000 --- a/bin/follow-tax-rename +++ /dev/null @@ -1,52 +0,0 @@ -#!/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-backup b/bin/freeside-backup deleted file mode 100644 index 97a4899..0000000 --- a/bin/freeside-backup +++ /dev/null @@ -1,42 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Getopt::Std; -use FS::UID qw(adminsuidsetup); -use FS::Conf; - -my $user = shift or die &usage; -adminsuidsetup $user; - -#you can skip this just by not having the config -use FS::Cron::backup qw(backup_scp); -backup_scp(); - -sub usage { - die "Usage:\n\n freeside-backup user\n"; -} - -### -# documentation -### - -=head1 NAME - -freeside-backup - Runs a backup - -=head1 SYNOPSIS - - freeside-backup user - -=head1 DESCRIPTION - -Runs a backup. See the dump-scpdest configuration option. - -=head1 BUGS - -=head1 SEE ALSO - -=cut - -1; - diff --git a/bin/freeside-create-initial-data b/bin/freeside-create-initial-data deleted file mode 100755 index 4102089..0000000 --- a/bin/freeside-create-initial-data +++ /dev/null @@ -1,31 +0,0 @@ -#!/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 deleted file mode 100755 index fe12931..0000000 --- a/bin/freeside-init +++ /dev/null @@ -1,60 +0,0 @@ -#! /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 deleted file mode 100644 index 3e8a6b2..0000000 --- a/bin/freeside-migrate-events +++ /dev/null @@ -1,266 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -#use Getopt::Std; -use FS::UID qw( adminsuidsetup dbh ); -use FS::Record qw( qsearch ); -use FS::part_bill_event; -use FS::part_event; -use FS::cust_bill_event; -use FS::cust_event; - -#use vars qw( $opt_m ); -#getopts('m'); - -my $user = shift or die &usage; -adminsuidsetup($user); - -my %plan2action = ( - 'fee' => 'fee', - 'fee_percent' => 'NOTYET', #XXX need fee_percent action - 'suspend' => 'suspend', - 'suspend-if-balance' => 'suspend', #"if balance" becomes the balance cond - 'suspend-if-pkgpart' => 'suspend_if_pkgpart', - 'suspend-unless-pkgpart' => 'suspend_unless_pkgpart', - 'cancel' => 'cancel', - 'addpost' => 'addpost', - 'comp' => 'NOTYET', #XXX or N/A or something - 'credit' => 'writeoff', - 'realtime-card' => 'cust_bill_realtime_card', - 'realtime-check' => 'cust_bill_realtime_check', - 'realtime-lec' => 'cust_bill_realtime_lec', - 'batch-card' => 'cust_bill_batch', - #?'retriable' => - 'send' => 'cust_bill_send', - 'send_email' => 'cust_bill_email', - '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 other plandata2option names - - my $balanceover = 0; - my $honor_dundate = 0; - - if ( $part_bill_event->plan eq 'suspend-if-balance' ) { - $balanceover = delete $plandata{'balanceover'}; - $honor_dundate = ( (delete $plandata{'balance_honor_dundate'}) =~ /1/ ); - } - - my $part_event = new FS::part_event { - 'event' => $part_bill_event->event, - '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' => $balanceover ); - 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; - - } - - if ( $honor_dundate ) { - my $dundate = new FS::part_event_condition { - 'eventpart' => $part_event->eventpart, - 'conditionname' => 'dundate' - }; - $error = $dundate->insert(); - die $error if $error; - } - - #my $derror = $part_bill_event->delete; - #die "error removing part_bill_event: $derror\n" if $derror; - -# if ( $opt_m ) { - - my $sth = dbh->prepare(' - INSERT INTO cust_event ( eventpart, tablenum, _date, status, statustext ) - SELECT ? , invnum , _date, status, statustext - FROM cust_bill_event WHERE eventpart = ? - ') or die dbh->errstr; - - $sth->execute( $part_event->eventpart, $part_bill_event->eventpart ) - or die $sth->errstr; - -# } else { -# -# foreach my $cust_bill_event ( -# qsearch({ -# 'table' => 'cust_bill_event', -# 'hashref' => { 'eventpart' => $part_bill_event->eventpart, }, -# }) -# ) { -# -# my $cust_event = new FS::cust_event { -# 'eventpart' => $part_event->eventpart, -# 'tablenum' => $cust_bill_event->invnum, -# '_date' => $cust_bill_event->_date, -# 'status' => $cust_bill_event->status, -# 'statustext' => $cust_bill_event->statustext, -# }; -# -# my $cerror = $cust_event->insert; -# #die "error inserting cust_event: $cerror\n" if $cerror; -# warn "error inserting cust_event: $cerror\n" if $cerror; -# -# #my $dcerror = $cust_bill_event->delete; -# #die "error removing cust_bill_event: $dcerror\n" if $dcerror; -# -# print "."; -# -# } -# -# } - - print "\n"; - -} - -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...) - -Can take lots of memory for large databases. - -=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 deleted file mode 100755 index d5fd703..0000000 --- a/bin/freeside-session-kill +++ /dev/null @@ -1,103 +0,0 @@ -#!/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 deleted file mode 100755 index c603365..0000000 --- a/bin/freeside-upgrade-unicode +++ /dev/null @@ -1,72 +0,0 @@ -#!/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 deleted file mode 100644 index fdfcc08..0000000 --- a/bin/freeside.import +++ /dev/null @@ -1,146 +0,0 @@ -#!/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 deleted file mode 100755 index 35c74ff..0000000 --- a/bin/fs-migrate-cust_tax_exempt +++ /dev/null @@ -1,323 +0,0 @@ -#!/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 deleted file mode 100755 index b0f3ac5..0000000 --- a/bin/fs-migrate-part_svc +++ /dev/null @@ -1,41 +0,0 @@ -#!/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 deleted file mode 100755 index 1584197..0000000 --- a/bin/fs-migrate-payref +++ /dev/null @@ -1,31 +0,0 @@ -#!/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 deleted file mode 100755 index 07f7b61..0000000 --- a/bin/fs-migrate-svc_acct_sm +++ /dev/null @@ -1,227 +0,0 @@ -#!/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 deleted file mode 100755 index 4e4769e..0000000 --- a/bin/fs-radius-add-check +++ /dev/null @@ -1,68 +0,0 @@ -#!/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 deleted file mode 100755 index 3de0137..0000000 --- a/bin/fs-radius-add-reply +++ /dev/null @@ -1,69 +0,0 @@ -#!/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/generate-prepay b/bin/generate-prepay deleted file mode 100755 index cb4ba7f..0000000 --- a/bin/generate-prepay +++ /dev/null @@ -1,35 +0,0 @@ -#!/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 deleted file mode 100755 index af21c05..0000000 --- a/bin/generate-raddb +++ /dev/null @@ -1,53 +0,0 @@ -#!/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 deleted file mode 100755 index e7fc992..0000000 --- a/bin/generate-table-module +++ /dev/null @@ -1,104 +0,0 @@ -#!/usr/bin/perl - -use strict; -use vars qw( $opt_n ); -use FS::Schema qw( dbdef_dist ); -use Getopt::Std; - -getopts('n'); -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 to FS/FS/Mason.pm -### - -my $magic = '# Sammath Naur'; -system("perl -pi -e 's/$magic/use FS::$table;\n $magic/' FS/FS/Mason.pm") - unless $opt_n; - -### -# 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 deleted file mode 100755 index 73fd29e..0000000 --- a/bin/generate-tests +++ /dev/null @@ -1,21 +0,0 @@ -#!/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/h_cust_main-wipe_paycvv b/bin/h_cust_main-wipe_paycvv deleted file mode 100755 index d34c15f..0000000 --- a/bin/h_cust_main-wipe_paycvv +++ /dev/null @@ -1,30 +0,0 @@ -#!/usr/bin/perl - -use strict; -use FS::UID qw(adminsuidsetup dbh); -use FS::Record; #buh? - -my $user = shift or die 'usage'; -adminsuidsetup $user; - -while (1) { - - my $sql = ' UPDATE h_cust_main SET paycvv = NULL - WHERE historynum IN ( SELECT historynum FROM h_cust_main - WHERE paycvv IS NOT NULL LIMIT 8192 )'; -# WHERE paycvv IS NOT NULL LIMIT 1 )'; - - my $sth = dbh->prepare($sql) or die dbh->errstr; - - print '.'; $|=1; - - my $rv = $sth->execute; - - dbh->commit or die dbh->errstr; - - last if $rv == 0; - -} - -print "\n"; - diff --git a/bin/import-county-tax-rates b/bin/import-county-tax-rates deleted file mode 100755 index 05798c9..0000000 --- a/bin/import-county-tax-rates +++ /dev/null @@ -1,30 +0,0 @@ -#!/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 deleted file mode 100755 index d32a2a1..0000000 --- a/bin/import-optigold.pl +++ /dev/null @@ -1,1077 +0,0 @@ -#!/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 deleted file mode 100755 index 1cb76e0..0000000 --- a/bin/import-tax-rates +++ /dev/null @@ -1,56 +0,0 @@ -#!/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 deleted file mode 100755 index 7495f47..0000000 --- a/bin/ispman.ldap.import +++ /dev/null @@ -1,114 +0,0 @@ -#!/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 deleted file mode 100755 index 14e44e4..0000000 --- a/bin/japan.pl +++ /dev/null @@ -1,32 +0,0 @@ -#!/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/make-pkg-fruit b/bin/make-pkg-fruit deleted file mode 100755 index 61d707f..0000000 --- a/bin/make-pkg-fruit +++ /dev/null @@ -1,172 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use FS::UID qw( adminsuidsetup ); -use FS::Record qw( qsearch qsearchs ); -use FS::part_export; -use FS::export_svc; -use FS::pkg_svc; -use FS::part_svc; -use FS::part_pkg; -use FS::cust_svc; -use FS::svc_Common; -use FS::svc_broadband; -use FS::part_svc_router; - -my $exporttype = 'prizm'; -my $pkg_property = 'pkg'; -my $svc_property = 'performance_profile'; - -my $user = shift or die &usage; - -$FS::svc_Common::noexport_hack = 1; -$FS::cust_svc::ignore_quantity = 1; -$FS::UID::AutoCommit = 0; - -my $DEBUG = 0; - -my $dbh = adminsuidsetup($user); - -my @exportnum = map { $_->exportnum } - qsearch( 'part_export', { 'exporttype' => $exporttype } ); - -die "no $exporttype exports found\n" unless scalar(@exportnum); - -my %pkg_svc_map = (); - -my @old_svcpart = (); -push @old_svcpart, map { $_->svcpart } - qsearch ( 'export_svc', { 'exportnum' => $_ } ) - foreach @exportnum; - -die "no svcparts found\n" unless scalar(@old_svcpart); - -foreach (@old_svcpart) { - foreach my $pkg_svc ( qsearch( 'pkg_svc', - { 'svcpart' => $_, - 'quantity' => { 'op' => '>', - 'value' => '0', - }, - } - ) - ) - { - warn "updating package ". $pkg_svc->pkgpart. "\n" if $DEBUG; - my $pkg_from = $pkg_svc->part_pkg->$pkg_property; - unless ( $pkg_svc_map{ $pkg_from }{ $pkg_svc->svcpart } ) { - my $old_part_svc = $pkg_svc->part_svc; - my $part_svc = new FS::part_svc( { $old_part_svc->hash } ); - $part_svc->svcpart(''); - - my $svcdb = $part_svc->svcdb; - foreach ( $old_part_svc->all_part_svc_column ) { - my $formatter = FS::part_svc->svc_table_fields($svcdb)->{$_}->{format} - || sub { shift }; - - $part_svc->setfield( $svcdb.'__'.$_->columnname.'_flag', $_->columnflag); - $part_svc->setfield( $svcdb.'__'.$_->columnname, - &$formatter($_->columnvalue) - ); - } - - my $formatter = - FS::part_svc->svc_table_fields($svcdb)->{$svc_property}->{format} - || sub { shift }; - $part_svc->setfield( $svcdb.'__'.$svc_property.'_flag', 'F'); - $part_svc->setfield( $svcdb.'__'.$svc_property, - &$formatter($pkg_svc->part_pkg->$pkg_property) - ); - my $error = $part_svc->insert( [], - { map { $_->exportnum => 1 } - $old_part_svc->part_export - }, - ); - die "error inserting service: $error\n" if $error; - - # this part is specific to svc_broadband - foreach (qsearch( 'part_svc_router', { 'svcpart' => $pkg_svc->svcpart } )) - { - my $part_svc_router = new FS::part_svc_router( { $_->hash } ); - $part_svc_router->svcrouternum( '' ); - $part_svc_router->svcpart( $part_svc->svcpart ); - my $error = $part_svc_router->insert; - die "error associating service with router: $error\n" if $error; - } - - $pkg_svc_map{ $pkg_from }{ $pkg_svc->svcpart } = $part_svc->svcpart; - - } - - my $new_pkg_svc = new FS::pkg_svc( { $pkg_svc->hash } ); - $new_pkg_svc->svcpart( $pkg_svc_map{ $pkg_from }{ $pkg_svc->svcpart } ); - my $error = $pkg_svc->delete; - die "error removing old service from package: $error\n" if $error; - $error = $new_pkg_svc->insert; - die "error adding new service to package: $error\n" if $error; - - } -} -warn "done with packages\n" if $DEBUG; - -foreach my $svcpart ( @old_svcpart ) { - foreach my $cust_svc ( qsearch( 'cust_svc', { 'svcpart' => $svcpart } ) ) { - my $svc_x = $cust_svc->svc_x; - my $cust_pkg = $cust_svc->cust_pkg; - die "can't handle unattached service ". $cust_svc->svcnum unless $cust_pkg; - my $pkg_from = $cust_pkg->part_pkg->$pkg_property; - $svc_x->setfield( $svc_property, $pkg_from ); - $svc_x->setfield( 'svcpart', $pkg_svc_map{ $pkg_from }{ $svcpart } ); - my $error = $svc_x->replace; - die "error replacing service ". $svc_x->svcnum. ": $error\n" if $error; - - $cust_svc->svcpart( $pkg_svc_map{ $pkg_from }{ $svcpart } ); - $error = $cust_svc->replace; - die "error replacing customer service ". $cust_svc->svcnum. ": $error\n" - if $error; - } - - my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $svcpart } ); - die "can't find old part_svc!" unless $part_svc; - - my $new_part_svc = new FS::part_svc( { $part_svc->hash } ); - $new_part_svc->disabled('Y'); - my $svcdb = $part_svc->svcdb; - foreach ( $part_svc->all_part_svc_column ) { - my $formatter = FS::part_svc->svc_table_fields($svcdb)->{$_}->{format} - || sub { shift }; - - $part_svc->setfield( $svcdb.'__'.$_->columnname.'_flag', $_->columnflag); - $part_svc->setfield( $svcdb.'__'.$_->columnname, - &$formatter($_->columnvalue) - ); - } - my $error = $new_part_svc->replace($part_svc, '1.3-COMPAT'); - die "error disabling service: $error\n" if $error; -} - -$dbh->commit or die $dbh->errstr; -$dbh->disconnect or die $dbh->errstr; - - -sub usage { - die "Usage:\n\n make-pkg-fruit user\n"; -} - -=head1 NAME - -make-pkg-fruit - Tool to migrate package properties to services - -=head1 SYNOPSIS - - make-pkg-fruit - -=head1 DESCRIPTION - -Multiplies out services with package properties and migrates package -definitions and customer services to the new services. Read the source. - -=head1 SEE ALSO - -=cut - -1; diff --git a/bin/mapsecrets2access_user b/bin/mapsecrets2access_user deleted file mode 100755 index d632360..0000000 --- a/bin/mapsecrets2access_user +++ /dev/null @@ -1,87 +0,0 @@ -#!/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->default_superuser_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 deleted file mode 100755 index 509ef3e..0000000 --- a/bin/masonize +++ /dev/null @@ -1,80 +0,0 @@ -#!/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/merge-referrals b/bin/merge-referrals deleted file mode 100644 index e39f053..0000000 --- a/bin/merge-referrals +++ /dev/null @@ -1,20 +0,0 @@ -#!/usr/bin/perl - -use strict; -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearch); -use FS::cust_main; - -my $user = shift or die "usage: merge-customers username custnum\n"; -adminsuidsetup $user; - -my $custnum = shift or die "usage: merge-customers username custnum\n"; - -foreach my $cust_main ( - qsearch('cust_main', { 'referral_custnum' => $custnum }) -) { - my $error = $cust_main->merge($custnum); - die $error if $error; -} - -1; diff --git a/bin/merge-user b/bin/merge-user deleted file mode 100755 index e783359..0000000 --- a/bin/merge-user +++ /dev/null @@ -1,71 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use FS::UID qw(adminsuidsetup dbh); -use FS::Schema; -use FS::Record qw(qsearch qsearchs); - -my $DRY_RUN = 1; -$FS::UID::AutoCommit = 0; - -my ($user, $from_usernum, $to_usernum, $go) = @ARGV; -die usage() if not ($user and $from_usernum and $to_usernum); -$DRY_RUN = 0 if defined($go) and $go eq 'go'; - -my $dbh = adminsuidsetup($user); - -# Sanity checks. -die "Can't merge a user to itself." if $from_usernum == $to_usernum; -my $from_user = FS::access_user->by_key($from_usernum) or - die "Usernum '$from_usernum' not found.\n"; -my $to_user = FS::access_user->by_key($to_usernum) or - die "Usernum '$to_usernum' not found.\n"; - -my $tables = FS::Schema::tables_hashref; -foreach my $table (keys %$tables) { - if( grep /^usernum$/, FS::Record::real_fields($table) ) { - next if $table eq 'access_user'; - foreach ($table, "h_$table") { - print "$_: "; - my $sql; - if( $table =~ /^access_(.*)$/ ) { - print "deleting "; - $sql = "DELETE FROM $_ WHERE usernum = $from_usernum"; - } - else { - print "updating "; - $sql = "UPDATE $_ SET usernum = $to_usernum WHERE usernum = $from_usernum"; - } - #print $sql; - my $sth = $dbh->prepare($sql); - $sth->execute; - if($dbh->err) { - print $dbh->errstr."\n"; - $dbh->rollback; - exit(1); - } - print $sth->rows, "\n"; - } - } -} - -if($DRY_RUN) { - warn "Dry run complete. Reverting all changes.\n"; - $dbh->rollback; -} -else { -# Warning: access_user->delete does not transactionize because of -# htpasswd issues. - print "Deleting merged user.\n"; - my $error = $from_user->delete; - die $error if $error; - - warn "Committing changes.\n"; - $dbh->commit; -} -exit(0); - -sub usage { - "Usage:\n merge-user admin_user from_usernum to_usernum [ 'go' ]\n - (Specify 'go' to actually apply changes.)\n\n"; -} diff --git a/bin/monitor b/bin/monitor deleted file mode 100755 index 8dac700..0000000 --- a/bin/monitor +++ /dev/null @@ -1,127 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use vars qw( $DEBUG ); -use Getopt::Std; -use FS::Daemon qw(daemonize1 daemonize2 logfile sigint sigterm); -use FS::Yori qw(report); -use Email::Send; - -$DEBUG = 0; - -&untaint_argv; #what it sounds like (eww) - -use vars qw(%opt); -getopts('m:p:', \%opt ); - -my ($machine, @emails) = @ARGV; -die &usage unless @emails; - -warn "starting daemonization (forking)\n" if $DEBUG; -daemonize1('freeside-monitor'); -#logfile( "%%%FREESIDE_LOG%%%/monitorlog.$machine" ); -logfile( "/usr/local/etc/freeside/monitorlog.$machine" ); - -warn "completing daemonization (detaching))\n" if $DEBUG; -daemonize2(); - -my $wantfree = $opt{m} || 1048576; -my $wantload = $opt{p} || 5; - -die 'bogus memory requirement: $wantfree' - unless $wantfree && $wantfree =~ /^\d+$/; - -die 'bogus load requirement: $wantload' - unless $wantload && $wantload =~ /^[\d.]+$/; - -my $alerts = 0; -my $last = time(); -while (1) { - - my(undef, $load, undef) = report('load'); - my($free) = report('freememory'); - - warn "free is $free and wantfree is $wantfree\n" if $DEBUG > 1; - warn "load is $load and wantload is $wantload\n" if $DEBUG > 1; - warn "last is $last\n" if $DEBUG > 1; - - unless( defined($load) && $load < $wantload - && defined($free) && $free > $wantfree - || ( time() < $last + 1800 && $alerts > 2 ) ) - { - warn localtime(). ": $machine has load of $load and $free kB free memory\n"; - $alerts++; - $alerts = 0 if time() > $last + 1800; - $last = time(); - foreach my $email ( @emails ) { - - my $message = <<"__MESSAGE__"; -From: support\@freeside.biz -To: $email -Subject: ALERT - $machine - -ALERT: $machine has a load of $load and only $free kB free.. - -__MESSAGE__ - - my $sender = Email::Send->new({mailer => 'SMTP'}); - $sender->mailer_args([Host => 'mail.freeside.biz']); - $sender->send($message); - - } - - } - - - - if ( sigterm() ) { - warn "received TERM signal; exiting\n"; - exit; - } - if ( sigint() ) { - warn "received INT signal; exiting\n"; - exit; - } - - sleep 30; #too long? too short? - -} - -sub untaint_argv { - foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - $ARGV[$_] =~ /^([\w\-\/\@\.]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; - $ARGV[$_]=$1; - } -} - -sub usage { - die "Usage:\n\n freeside-monitor [ -pm ] machine email\n"; -} - -=head1 NAME - -freeside-monitor - Perform some basic load monitoring - -=head1 SYNOPSIS - - freeside-monitor [ -p MAXLOAD ] [ -m REQUIRED_FRERMEM ] machine email [ ... ] - -=head1 DESCRIPTION - -Load monitoring daemon. Should be running at all times. - --p: maximum permitted 5 minute load - --m: minimum free vmem in kB - -machine: a unique name to be used in alert messages -email: address(es) to which alerts should be sent - -=head1 VERSION - -=head1 BUGS - -=head1 SEE ALSO - -=cut - diff --git a/bin/move-customers b/bin/move-customers deleted file mode 100755 index a7ea197..0000000 --- a/bin/move-customers +++ /dev/null @@ -1,678 +0,0 @@ -#!/usr/bin/perl -w - -#script to move customers from one installation to another -# source is remote, destination is local -# script is kinda-specific to a somewhat old source installation (1.7? older?) -# target installation has to be 1.9 (after 9/2009) - -use strict; -use vars qw( $sdbh ); -use DBI; -use FS::UID qw( adminsuidsetup dbh ); -use FS::Schema qw( dbdef ); -use FS::Record qw( qsearchs ); -use FS::agent; -use FS::cust_main; -use FS::part_pkg; -use FS::part_svc; -use FS::cust_bill_ApplicationCommon; -use FS::svc_Common; -use FS::cust_event; -use FS::svc_domain; -use FS::cust_pkg; - -my $DANGEROUS = 0; -my $DRY = 0; - -#ssh -p 2222 -L 1080:66.209.32.4:7219 -L 5454:localhost:5432 66.209.32.4 - -#my $source_datasrc = 'DBI:Pg:host=66.209.32.4;dbname=freeside;sslmode=require'; -my $source_datasrc = 'DBI:Pg:host=localhost;port=5454;dbname=freeside'; -my $source_user = 'readonly'; -my $source_pw = ''; - -#my @source_agents = ( 2, 7, 3, 4, 5, 1 ); -my @source_agents = ( 1, 2, 3, 4, 5, 7 ); - -my $dest_agent_typenum = 12; - -my $dest_refnum = 60; - -my $dest_legacy_credit_reasontype = 5; - -my $dest_pkg_classnum = 6; - -my %domsvc_map = ( - 1 => 20450, - 3653 => 20162, - 7634 => 20451, -); - -#testing -#my %eventparts = ( -# 'CARD' => [ 1, ], -# 'CHEK' => [], -# 'BILL' => [], -# 'DCHK' => [], -# 'DCRD' => [], -# 'COMP' => [], -#); -#production -my %eventparts = ( - 'CARD' => [ 1, ], - 'CHEK' => [ 2, ], - 'BILL' => [ 5, ], - 'DCHK' => [ 12, ], - 'DCRD' => [ 15, ], - 'COMP' => [], -); - -#-- - -# target(local) setup - -my $user = shift - or die "Usage:\n (edit variables at top of script and then)\n". - " move-customers user\n"; -adminsuidsetup $user; - -$FS::cust_main::ignore_expired_card = 1; -$FS::cust_main::ignore_expired_card = 1; -$FS::part_pkg::skip_pkg_svc_hack = 1; -$FS::part_pkg::skip_pkg_svc_hack = 1; -$FS::cust_bill_ApplicationCommon::skip_apply_to_lineitems_hack = 1; -$FS::cust_bill_ApplicationCommon::skip_apply_to_lineitems_hack = 1; -$FS::svc_Common::noexport_hack = 1; -$FS::svc_Common::noexport_hack = 1; -$FS::svc_domain::whois_hack = 1; -$FS::svc_domain::whois_hack = 1; -$FS::cust_pkg::disable_agentcheck = 1; -$FS::cust_pkg::disable_agentcheck = 1; - -my $void_paynum = 2147483646; #top of int range - -# -- - -# source(remote) setup - -$sdbh = DBI->connect($source_datasrc, $source_user, $source_pw) - or die $DBI::errstr; - -$sdbh->{ChopBlanks} = 1; - -# -- - -my %map = (); -$map{'_DOMSVC'} = \%domsvc_map; - -import_table('pkg_class', 'nomap' => 1); -import_table('svc_acct_pop', 'nomap' => 1); - -#XXX -#import_table('reason_type', 'nomap' => 1); -#foreach my $src_typenum ( keys %{ $map{'reason_type'} } ) { -# import_table('reason', 'reason_type' => $src_typenum, -# 'search' => 'reason_type', -# 'map' => 'reason_type', -# ); -#} - -my $agent_sth = $sdbh->prepare( - 'SELECT * FROM agent WHERE agentnum IN ( '. join(',', @source_agents ). ')' -) or die $sdbh->errstr; - -$agent_sth->execute or die $agent_sth->errstr; - - -while ( my $agentrow = $agent_sth->fetchrow_hashref ) { - - my $src_agent = $agentrow->{'agent'}; - - warn "importing customers for $src_agent\n"; - - my $agent = qsearchs('agent', { 'agent' => $src_agent, 'disabled' => '' } ); - - if ( $agent ) { - - warn " using existing agentnum ". $agent->agentnum. "\n"; - - if ( $DANGEROUS ) { - warn "DELETING ALL CUSTOMERS OF $src_agent locally \n"; - - foreach my $statement ( - 'DELETE FROM cust_main WHERE agentnum = '. $agent->agentnum, - ( map { "DELETE FROM $_ - WHERE 0 = ( SELECT COUNT(*) FROM cust_main - WHERE cust_main.custnum = $_.custnum ) - " - } - qw( - cust_credit - cust_main_invoice - cust_main_note - cust_pay - cust_refund - ) - ) - #pkg_class, part_pkg_pop - #part_pkg, pkg_svc, part_svc, part_svc_column - #XXX more... does it matter? - ) { - - #warn $statement; - my $sth = dbh->prepare($statement) or die dbh->errstr; - $sth->execute or die $sth->errstr; - - } - - dbh->commit or die dbh->errstr; - - } - - } else { - - warn " creating new agent...\n"; - - $agent = new FS::agent { 'agent' => $src_agent, - 'typenum' => $dest_agent_typenum }; - my $error = $agent->insert; - die $error if $error; - - warn " agentnum ". $agent->agentnum. "\n"; - - } - - $map{'agent'}->{ $agentrow->{'agentnum'} } = $agent->agentnum; - -} - - #my $customer_sth = $sdbh->prepare( - # 'SELECT * FROM cust_main WHERE agentnum = '. $agentrow->{'agentnum'} - #) or die $sdbh->errstr; -my $customer_sth = $sdbh->prepare( - 'SELECT * FROM cust_main WHERE agentnum IN ( '. join(',', @source_agents ). ') - ORDER BY custnum' -) or die $sdbh->errstr; - -$customer_sth->execute or die $customer_sth->errstr; - -while ( my $customerrow = $customer_sth->fetchrow_hashref ) { - - #use Data::Dumper; - # warn Dumper($customerrow); - my $src_custnum = $customerrow->{'custnum'}; - - warn " $src_custnum has referral_custnum ". $customerrow->{'referral_custnum'} - if $customerrow->{'referral_custnum'}; - - my $cust_main = new FS::cust_main { - %{ $customerrow }, - 'custnum' => '', - 'referral_custnum' => '', #restore afterwords? - 'refnum' => $dest_refnum, - 'agentnum' => $map{'agent'}->{ $customerrow->{'agentnum'} }, - 'agent_custid' => $src_custnum, - }; - - #$cust_main->ship_country('') if $cust_main->ship_country eq ' '; - #$cust_main->tax('') if $cust_main->tax =~ /^\s+$/; - - my $error = $cust_main->insert; - if ( $error ) { - warn "*** WARNING: error importing customer src custnum $src_custnum: $error"; - use Data::Dumper; - warn Dumper($cust_main) if $src_custnum == 6854; - next; - } - - warn "inserting dest customer ". $cust_main->custnum. " for $src_custnum\n"; - - $map{'cust_main'}->{$src_custnum} = $cust_main->custnum; - - #now import the relations, easy and hard: - - import_table( 'cust_main_note', 'custnum' => $src_custnum ); - - import_table( 'cust_pay', 'custnum' => $src_custnum, - #ivan showing up as cust_pay otaker - # old db doesn't have cust_pay.otaker, pull it from history - 'preinsert_callback' => sub { - my($row, $cust_pay) = @_; - - my $sth = $sdbh->prepare( - "SELECT history_user FROM h_cust_pay WHERE history_action = 'insert' - AND paynum = ". $row->{'paynum'} - ) or die $sdbh->errstr; - $sth->execute or die $sth->errstr; - my $otaker = $sth->fetchrow_arrayref->[0]; - - $cust_pay->otaker($otaker); - }, - ); - - # crap, cust_credit.reason is text in old db -#*** WARNING: error importing cust_credit src crednum 2200: failed to set reason for [ FS::cust_credit ]: at ./move-customers line 232. - import_table( 'cust_credit', 'custnum' => $src_custnum, - 'insert_opts' => [ 'reason_type' => $dest_legacy_credit_reasontype ], - 'preinsert_callback' => sub { - my($row, $object) = @_; - $object->set('reason', '(none)') if $object->get('reason') =~ /^\s*$/; - }, - ); - - import_table( 'cust_refund', 'custnum' => $src_custnum, - 'post_callback' => sub { - #my( $src_refundnum, $dst_refundnum ) = @_; - my $src_refundnum = shift; - - # cust_credit_refund (map refundnum and crednum...) - import_table( 'cust_credit_refund', - 'refundnum' => $src_refundnum, - 'search' => 'refundnum', - 'map' => 'cust_refund', - 'map2' => 'cust_credit', - 'map2key' => 'crednum', - ); - - # cust_pay_refund (map refundnum and paynum...) - import_table( 'cust_pay_refund', - 'refundnum' => $src_refundnum, - 'search' => 'refundnum', - 'map' => 'cust_refund', - 'map2' => 'cust_pay', - 'map2key' => 'paynum', - ); - - }, - ); - - # dunno what's up with this (ship_country ' ', fixed) -#*** WARNING: error importing customer src custnum 6854: Illegal (name) (error code illegal_name) ship_last: at ./move-customers line 129. - - # cust_pay_void - import_table( 'cust_pay_void', 'custnum' => $src_custnum, - 'preinsert_callback' => sub { - my($row, $object) = @_; - $object->paynum( $void_paynum-- ); - }, - ); - - # (not in old db: cust_attachment, cust_statement, cust_location, - # cust_main_exemption, cust_pay_pending ) - # (not used in old db: cust_pay_batch, cust_tax_exempt) - # (not useful to migrate: queue) - - #werid direct cust_main relations: - - # cust_pkg (part_pkg, part_svc, etc.) - import_table( 'cust_pkg', 'custnum' => $src_custnum, - 'preinsert_callback' => sub { - my($row, $object) = @_; - my $src_pkgpart = $row->{'pkgpart'} or die "wtf"; - my $dest_pkgpart = $map{'part_pkg'}->{$src_pkgpart}; - if ( $dest_pkgpart ) { - $object->pkgpart($dest_pkgpart); - return; - } - - my $sth = $sdbh->prepare( - "SELECT * FROM part_pkg WHERE pkgpart = $src_pkgpart" - ) or die $sdbh->errstr; - - $sth->execute or die $sth->errstr; - - my $part_pkg_row = $sth->fetchrow_hashref - or die "cust_pkg.pkgpart missing in part_pkg?!"; - - my $hashref = { - %{ $part_pkg_row }, - 'pkgpart' => '', - }; - my $src_classnum = $part_pkg_row->{'classnum'}; - $hashref->{'classnum'} = $map{'pkg_class'}->{ $src_classnum } - if $src_classnum; - - my $part_pkg = new FS::part_pkg $hashref; - - #$part_pkg->setuptax('') if $part_pkg->setuptax =~ /^\s+$/; - #$part_pkg->recurtax('') if $part_pkg->recurtax =~ /^\s+$/; - - my $error = $part_pkg->insert( 'options' => {} ); - die "*** FATAL: error importing part_pkg src pkgpart $src_pkgpart ". - ": $error" - if $error; - - $map{ 'part_pkg' }->{ $part_pkg_row->{'pkgpart'} } = $part_pkg->pkgpart; - - # part_pkg_option - import_table( 'part_pkg_option', - 'pkgpart' => $src_pkgpart, - 'search' => 'pkgpart', - 'map' => 'part_pkg', - ); - - my $osth = $sdbh->prepare( - "SELECT * FROM part_pkg_option WHERE pkgpart = $src_pkgpart" - ) or die $sdbh->errstr; - - # pkg_svc, part_svc, part_svc_column - import_table( 'pkg_svc', - 'pkgpart' => $src_pkgpart, - 'search' => 'pkgpart', - 'map' => 'part_pkg', - 'preinsert_callback' => sub { - - my($row, $object) = @_; - my $src_svcpart = $row->{'svcpart'} or die "wtf2"; - my $dest_svcpart = $map{'part_svc'}->{$src_svcpart}; - if ( $dest_svcpart ) { - $object->svcpart($dest_svcpart); - return; - } - - my $sth = $sdbh->prepare( - "SELECT * FROM part_svc WHERE svcpart = $src_svcpart" - ) or die $sdbh->errstr; - - $sth->execute or die $sth->errstr; - - my $part_svc_row = $sth->fetchrow_hashref - or die "svcpart missing in part_svc?!"; - - my $hashref = { - %{ $part_svc_row }, - 'svcpart' => '', - }; - - my $part_svc = new FS::part_svc $hashref; - $part_svc->disabled('') if $part_svc->disabled =~ /^\s+$/; - my $error = $part_svc->insert; - die "*** FATAL: error importing part_svc src svcpart $src_svcpart ". - ": $error" - if $error; - - $map{ 'part_svc' }->{ $part_svc_row->{'svcpart'} } = $part_svc->svcpart; - - # part_svc_column - import_table( 'part_svc_column', - 'svcpart' => $src_svcpart, - 'search' => 'svcpart', - 'map' => 'part_svc', - 'preinsert_callback' => sub { - my($row, $object) = @_; - if ( $object->columnname eq 'domsvc' ) { - $object->columnvalue( $map{'_DOMSVC'}->{ $object->columnvalue } ); - } - }, - ); - - #what we came here for in the first place - $object->svcpart( $part_svc->svcpart ); - - } - ); - - #what we came here for in the first place - $object->pkgpart( $part_pkg->pkgpart ); - - }, - - 'post_callback' => sub { - #my( $src_pkgnum, $dst_pkgnum ) = @_; - my $src_pkgnum = shift; - - #XXX grr... action makes this very hard... - ## cust_pkg_reason (shit, and bring in/remap reasons) - #import_table( 'cust_pkg_reason', - # 'pkgnum' => $src_pkgnum, - # 'search' => 'pkgnum', - # 'map' => 'cust_pkg', - # 'map2' => 'reason', - # 'map2key' => 'reasonnum', - # ); - - #cust_svc - import_table( 'cust_svc', - 'pkgnum' => $src_pkgnum, - 'search' => 'pkgnum', - 'map' => 'cust_pkg', - 'map2' => 'part_svc', - 'map2key' => 'svcpart', - 'post_callback' => sub { - #my( $src_svcnum, $dst_svcnum ) = @_; - my $src_svcnum = shift; - - #svc_domain - import_table( 'svc_domain', - 'svcnum' => $src_svcnum, - 'search' => 'svcnum', - 'map' => 'cust_svc', - 'noblank_primary' => 1, - ); - - #svc_acct - import_table( 'svc_acct', - 'svcnum' => $src_svcnum, - 'search' => 'svcnum', - 'map' => 'cust_svc', - 'noblank_primary' => 1, - 'map2' => 'svc_acct_pop', - 'map2key' => 'popnum', - #'map3' => 'svc_domain', - 'map3' => '_DOMSVC', - 'map3key' => 'domsvc', - ); - - #radius_usergroup - import_table( 'radius_usergroup', - 'svcnum' => $src_svcnum, - 'search' => 'svcnum', - 'map' => 'cust_svc', - ); - - #other svc_ tables not in old db - - }, - ); - - }, - - - - - ); - # end of cust_pkg (part_pkg, part_svc, etc.) - - # cust_bill (invnum move) - import_table( 'cust_bill', 'custnum' => $src_custnum, - 'preinsert_callback' => sub { - my($row, $object) = @_; - $object->agent_invid( $row->{'invnum'} ); - }, - 'post_callback' => sub { - my( $src_invnum, $dst_invnum ) = @_; - #my $src_invnum = shift; - - # cust_bill_pkg ( map invnum and pkgnum... ) - import_table( 'cust_bill_pkg', - 'invnum' => $src_invnum, - 'search' => 'invnum', - 'map' => 'cust_bill', - 'map2' => 'cust_pkg', - 'map2key' => 'pkgnum', - 'post_callback' => sub { - my $src_billpkgnum = shift; - - import_table( 'cust_bill_pkg_detail', - 'billpkgnum' => $src_billpkgnum, - 'search' => 'billpkgnum', - 'map' => 'cust_bill_pkg', - 'addl_from' => 'left join cust_bill_pkg using ( invnum, pkgnum )', - ); - - }, - ); - - # cust_credit_bill (map invnum and crednum... ) - import_table( 'cust_credit_bill', - 'invnum' => $src_invnum, - 'search' => 'invnum', - 'map' => 'cust_bill', - 'map2' => 'cust_credit', - 'map2key' => 'crednum', - 'post_callback' => sub { - my $src_creditbillnum = shift; - #map creditbillnum and billpkgnum - import_table( 'cust_credit_bill_pkg', - 'creditbillnum' => $src_creditbillnum, - 'search' => 'creditbillnum', - 'map' => 'cust_credit_bill', - 'map2' => 'cust_bill_pkg', - 'map2key' => 'billpkgnum', - ); - - }, - ); - - # cust_bill_pay (map invnum and paynum...) - import_table( 'cust_bill_pay', - 'invnum' => $src_invnum, - 'search' => 'invnum', - 'map' => 'cust_bill', - 'map2' => 'cust_pay', - 'map2key' => 'paynum', - 'post_callback' => sub { - my $src_billpaynum = shift; - #map billpaynum and billpkgnum - import_table( 'cust_bill_pay_pkg', - 'billpaynum' => $src_billpaynum, - 'search' => 'billpaynum', - 'map' => 'cust_bill_pay', - 'map2' => 'cust_bill_pkg', - 'map2key' => 'billpkgnum', - ); - }, - ); - - #need to do something about events. mark initial stuff as done - foreach my $eventpart ( @{ $eventparts{$cust_main->payby} } ) { - - my $cust_event = new FS::cust_event { - 'eventpart' => $eventpart, - 'tablenum' => $dst_invnum, - '_date' => time, # XXX something? probably not - 'status' => 'done', - }; - - my $error = $cust_event->insert; - die "*** FATAL: error inserting cust_event for eventpart $eventpart,". - " tablenum (invnum) $dst_invnum: $error" - if $error; - - } - - }, - ); - - # --- - - # (not in old db: cust_pkg_detail) - # (not used in old db: cust_bill_pay_batch, cust_pkg_option) - - # --- - - # (not in old db: cust_bill_pkg_display, cust_bill_pkg_tax_location, - # cust_bill_pkg_tax_rate_location, cust_tax_adjustment, cust_svc_option, ) - # (not used in old db: cust_tax_exempt_pkg) - - #do this last, so no notices go out - import_table( 'cust_main_invoice', 'custnum' => $src_custnum ); - - #dbh->commit or die dbh->errstr; - warn "customer ". $cust_main->custnum. " inserted\n"; - #exit; - -} - - -warn "import successful!\n"; -if ( $DRY ) { - warn "rolling back (dry run)\n"; - dbh->rollback or die dbh->errstr; - warn "rolled back\n" -} else { - warn "commiting\n"; - dbh->commit or die dbh->errstr; - warn "committed\n"; -} - -sub import_table { - my( $table, %opt ) = @_; - - eval "use FS::$table;"; - die $@ if $@; - - my $map = $opt{'map'} || 'cust_main'; - my $search = $opt{'search'} || 'custnum'; - - $opt{'insert_opts'} ||= []; - - my $primary_key = dbdef->table($table)->primary_key; - - my $addl_from = defined($opt{'addl_from'}) ? $opt{'addl_from'} : ''; - - my $sth = $sdbh->prepare( - "SELECT * FROM $table $addl_from ". - ( $opt{'nomap'} ? '' : " WHERE $search = ". $opt{$search} ) - ) or die $sdbh->errstr; - - $sth->execute or die "(searching $table): ". $sth->errstr; - - while ( my $row = $sth->fetchrow_hashref ) { - #my $src_custnum = $customerrow->{'custnum'}; - - my $hashref = { %$row }; - $hashref->{$primary_key} = '' - unless $opt{'noblank_primary'}; - $hashref->{ $search } = $map{$map}->{ $row->{$search} } - unless $opt{'nomap'}; - - if ( $opt{'map2'} ) { - my $key2 = $opt{'map2key'}; - $hashref->{$key2} = $map{ $opt{'map2'} }->{ $row->{$key2} } - unless $opt{map2key} eq 'pkgnum' && ( $row->{$key2} eq '0' - || $row->{$key2} eq '-1' - ) - or ! defined($row->{$key2}) - or $row->{$key2} eq ''; - #warn "map $opt{map2}.$opt{map2key}: ". $row->{$key2}. " to ". $map{ $opt{'map2'} }->{ $row->{$key2} }; - } - - if ( $opt{'map3'} ) { - my $key3 = $opt{'map3key'}; - $hashref->{$key3} = $map{ $opt{'map3'} }->{ $row->{$key3} }; - } - - my $object = eval "new FS::$table \$hashref;"; - die $@ if $@; - - &{ $opt{preinsert_callback} }( $row, $object ) - if $opt{preinsert_callback}; - - my $error = $object->insert( @{ $opt{'insert_opts'} } ); - if ( $error ) { - warn "*** WARNING: error importing $table src $primary_key ". $row->{$primary_key}. ": $error"; - next; - } - - $map{ $table }->{ $row->{$primary_key} } = $object->get($primary_key); - - &{ $opt{post_callback} }( $row->{$primary_key}, $object->get($primary_key) ) - if $opt{post_callback}; - - } - -} - -1; - diff --git a/bin/move-unlinked b/bin/move-unlinked deleted file mode 100755 index 0d31a49..0000000 --- a/bin/move-unlinked +++ /dev/null @@ -1,99 +0,0 @@ -#!/usr/bin/perl -w - -#script to move unlinked accounts from one installation to another -# source is remote, destination is local - -use strict; -use vars qw( $sdbh ); -use DBI; -use FS::UID qw( adminsuidsetup dbh ); -use FS::Schema qw( dbdef ); -use DBI; -use FS::Record qw( qsearchs ); -use FS::svc_acct; - -#my $DANGEROUS = 0; -#my $DRY = 0; - -#ssh -p 2222 -L 1080:66.209.32.4:7219 -L 5454:localhost:5432 66.209.32.4 - -#my $source_datasrc = 'DBI:Pg:host=66.209.32.4;dbname=freeside;sslmode=require'; -my $source_datasrc = 'DBI:Pg:host=localhost;port=5454;dbname=freeside'; -my $source_user = 'readonly'; -my $source_pw = ''; - - -my %domsvc_map = ( - 1 => 108, #nothinbut.net - 3653 => 109, #ewol.com - #7634 => 20451, -); -#my %domsvc_map = ( -# 1 => 20450, -# 3653 => 20162, -## 7634 => 20451, -#); - -my %svcpart_map = ( - 2 => 23, # NBN-DIALUP - 3 => 29, # NBN-EMAIL - 8 => 30, # EWOL-EMAIL -); -#my %svcpart_map = ( -# 2 => , # NBN-DIALUP -# 3 => , # NBN-EMAIL -# 8 => , # EWOL-EMAIL -#); - - -#-- - -# target(local) setup - -my $user = shift - or die "Usage:\n (edit variables at top of script and then)\n". - " move-customers user\n"; -adminsuidsetup $user; - -$FS::svc_Common::noexport_hack = 1; -$FS::svc_Common::noexport_hack = 1; - -# -- - -# source(remote) setup - -$sdbh = DBI->connect($source_datasrc, $source_user, $source_pw) - or die $DBI::errstr; - -$sdbh->{ChopBlanks} = 1; - -# -- - -my $sth = $sdbh->prepare( - 'select * from svc_acct left join cust_svc using ( svcnum ) where pkgnum is null' -) or die $sdbh->errstr; - -$sth->execute or die $sth->errstr; - -while ( my $hashref = $sth->fetchrow_hashref ) { - - my %hash = %$hashref; - - $hash{'svcnum'} = ''; - - $hash{'domsvc'} = $domsvc_map{ $hash{'domsvc'}}; - $hash{'svcpart'} = $svcpart_map{$hash{'svcpart'}}; - - my $svc_acct = new FS::svc_acct \%hash; - - #my $error = $svc_acct->check; - my $error = $svc_acct->insert; - - if ( $error ) { - use Data::Dumper; - warn Dumper($svc_acct); - die $error; - } -} - -1; diff --git a/bin/opensrs_domain_pkgs b/bin/opensrs_domain_pkgs deleted file mode 100755 index 2420095..0000000 --- a/bin/opensrs_domain_pkgs +++ /dev/null @@ -1,142 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use DateTime; -use Date::Format; -use Date::Parse; -use Net::OpenSRS; -use Net::Whois::Raw; -use Data::Dumper; -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearchs qsearch); -use FS::Conf; -use FS::svc_domain; -use FS::part_pkg; -use FS::part_export; - -my $exportnum = 1; -my $pkgpart = 631; -my $user = 'qis'; - -adminsuidsetup $user; - -my $part_export = qsearchs('part_export' => { exportnum => $exportnum }) - or die "can't find export $exportnum\n"; - -my $srs = $part_export->get_srs; - -my $rv = $srs->make_request( - { - action => 'get_domains_by_expiredate', - object => 'domain', - attributes => { - exp_from => time2str('%Y-%m-%d', time() - 4*24*60*60), - exp_to => time2str('%Y-%m-%d', time() + 10*366*24*60*60), - limit => 10000, - } - } -); - -die $rv->{response_text} unless $rv->{is_success}; - -my %domains = map { $_->{name}, $_ } @{ $rv->{attributes}->{exp_domains} }; - -# each is of form -# { -# 'f_let_expire' => 'N', -# 'name' => 'wolfecpa.com', -# 'f_auto_renew' => 'N', -# 'expiredate' => '2017-09-16 04:00:00' -# }, - -foreach my $svc_domain ( $part_export->svc_x ) { - unless ( exists($domains{$svc_domain->domain}) ) { - warn $svc_domain->domain. " not at registrar. No action taken.\n"; - next; - } - - $domains{$svc_domain->domain}{seen} = 1; - - unless ( $domains{$svc_domain->domain}{expiredate} =~ - /^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})/ ) - { - warn "Can't parse expiration date for ". $svc_domain->domain. " skipping\n"; - next; - } - - my ($year,$month,$day,$hour,$minute,$second) = ($1,$2,$3,$4,$5,$6); - my $exp = DateTime->new( year => $year, - month => $month, - day => $day, - hour => $hour, - minute => $minute, - second => $second, - time_zone => 'America/New_York',#timezone of opensrs - ); - #my $expiretime = $exp->epoch; - - #set the bill date early enough to allow a couple chances to pay - $month--; - if ($month < 1) { - $year--; - $month=12; - } - my $bill = DateTime->new( year => $year, - month => $month, - day => 1, - hour => 0, - minute => 0, - second => 0, - time_zone => 'America/Chicago',#timezone of customer - ); - my $expiretime = $bill->epoch; - - my $error = $part_export->is_supported_domain($svc_domain); - warn $error if $error; - $error = undef; - - my $create = ''; - my $whois = whois($svc_domain->domain); - $whois =~ /Record created on (\d{1,2}-\w{3}-\d{4})\./ && ($create = $1); - my $createtime = str2time($create); - - unless ($createtime) { - $exp->subtract( 'years' => 1 ); - $createtime = $exp->epoch; - } - - my $new; - my $cust_svc = $svc_domain->cust_svc; - my $cust_pkg = $cust_svc->cust_pkg; - unless ($cust_pkg) { - warn $svc_domain->domain. " not linked to package. No action taken.\n"; - next; - } - - foreach my $pkg ( grep { $_->pkgpart == $pkgpart } $cust_pkg->cust_main->ncancelled_pkgs ) { - next if $pkg->cust_svc; # only handles simple 1 domain/package case - $cust_svc->pkgnum($pkg->pkgnum); - $error = $cust_svc->replace; - die "error linking to empty package: $error\n" if $error; - $cust_pkg = $pkg; - last; - } - - unless ($cust_pkg->pkgpart == $pkgpart) { - $new = new FS::cust_pkg - { custnum => $cust_pkg->custnum, pkgpart => $pkgpart }; - my $error = $new->insert; - die "error inserting package: $error\n" if $error; - $cust_svc->pkgnum($new->pkgnum); - $error = $cust_svc->replace; - die "error linking to new package: $error\n" if $error; - $cust_pkg = $new; - } - - # set dates on package if it was empty? - $cust_pkg->bill($expiretime); - $cust_pkg->setup($createtime); - $error = $cust_pkg->replace; - die $error if $error; -} - diff --git a/bin/passwd.import b/bin/passwd.import deleted file mode 100755 index 8ab9e2a..0000000 --- a/bin/passwd.import +++ /dev/null @@ -1,121 +0,0 @@ -#!/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 deleted file mode 100755 index 03316e1..0000000 --- a/bin/payment-faker +++ /dev/null @@ -1,54 +0,0 @@ -#!/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 deleted file mode 100644 index ad69fbd..0000000 --- a/bin/pg-readonly +++ /dev/null @@ -1,24 +0,0 @@ -#!/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-sizer b/bin/pg-sizer deleted file mode 100755 index 3af0286..0000000 --- a/bin/pg-sizer +++ /dev/null @@ -1,36 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use FS::UID qw(adminsuidsetup dbh); -use FS::Schema qw(dbdef); -use FS::Record; #why is this necessary - -adminsuidsetup shift or die "usage: pg-sizer user"; - -my $verbose = 1; - -my %size = (); -my %prettysize = (); - -foreach my $table ( dbdef->tables ) { - warn "sizing $table...\n" if $verbose; - my $sth = dbh->prepare("SELECT pg_total_relation_size('$table')") - or die dbh->errstr; - $sth->execute or die $sth->errstr; - my $size = $sth->fetchrow_arrayref->[0]; - $size{$table} = $size; - - my $psth = dbh->prepare("SELECT pg_size_pretty( $size )") - or die dbh->errstr; - $psth->execute or die $psth->errstr; - my $prettysize = $psth->fetchrow_arrayref->[0]; - $prettysize{$table} = $prettysize; - - warn "$table: $prettysize{$table}\n" if $verbose; -} - -foreach my $table ( reverse sort { $size{$a} <=> $size{$b} } keys %size ) { - #print "$table: $size{$table}\n"; - print "$table: $prettysize{$table}\n"; -} - diff --git a/bin/pg-version b/bin/pg-version deleted file mode 100755 index b6cddb6..0000000 --- a/bin/pg-version +++ /dev/null @@ -1,13 +0,0 @@ -#!/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/ping b/bin/ping deleted file mode 100755 index 605a204..0000000 --- a/bin/ping +++ /dev/null @@ -1,58 +0,0 @@ -#!/usr/bin/perl - -use Net::Ping; -use Net::SSH qw( ssh_cmd ); -use Email::Send; - -my @other_hosts = ( 'freeside.biz', 'saturn5.com' ); - -my( $machine, @emails ) = @ARGV; -die "no notification email given" unless @emails; - -my $ping = new Net::Ping; # 'icmp'; #requires root - -my $pong = ''; -# can't tcp ping... $ping->ping($machine) and -$pong = eval { ssh_cmd('freeside@'.$machine, 'echo pong') }; -#(command ignored if authorized_keys setup w/command=) - -if ( $@ || $pong !~ /pong/ ) { #houston, we may have a problem - - #warn "can't reach $machine, checking @other_hosts\n"; - - #let's do a sanity check, can we see some other hosts? - exit unless grep $ping->ping($_), @other_hosts; - - #uh-oh, this is bad. - - #warn "checking to see if we've alerted on this recently\n"; - - #but we don't want to be too noisy, have we alerted on this in the last 24h? - my $file = "/tmp/alert-$machine"; - exit if -e $file && -M $file < 1; - - open(FILE, ">>$file"); - print FILE "emailing\n"; - close FILE; - - #warn "emailing alerts\n"; - - foreach my $email ( @emails ) { - - my $message = <<"__MESSAGE__"; -From: support\@freeside.biz -To: $email -Subject: ALERT - $machine - -ALERT: $machine appears to be down. - -__MESSAGE__ - - my $sender = Email::Send->new({mailer => 'SMTP'}); - $sender->mailer_args([Host => 'mail.freeside.biz']); - $sender->send($message); - - } - -} - diff --git a/bin/pod2x b/bin/pod2x deleted file mode 100755 index ecb7f91..0000000 --- a/bin/pod2x +++ /dev/null @@ -1,145 +0,0 @@ -#!/usr/bin/perl -w - -use strict; - -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" unless -d $site_perl; -#die "Can't find $catman" unless -d $catman; --d $html or mkdir $html; - -my $count = 0; - -#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 deleted file mode 100755 index 61380da..0000000 --- a/bin/postfix.export +++ /dev/null @@ -1,122 +0,0 @@ -#!/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 deleted file mode 100755 index 12c138b..0000000 --- a/bin/postfix_courierimap.import +++ /dev/null @@ -1,137 +0,0 @@ -#!/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-directory_assist b/bin/print-directory_assist deleted file mode 100755 index 4c5e4a8..0000000 --- a/bin/print-directory_assist +++ /dev/null @@ -1,12 +0,0 @@ -#!/usr/bin/perl -w - -use strict; - -my $acs = `cut -c1-3 ../etc/areacodes.txt`; - -my $plus = ''; -foreach my $npa ( split(/\n/, $acs ) ) { - warn $npa; - $plus .= $npa. '5551212,'; -} -print "$plus\n"; diff --git a/bin/print-schema b/bin/print-schema deleted file mode 100755 index 886e325..0000000 --- a/bin/print-schema +++ /dev/null @@ -1,7 +0,0 @@ -#!/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 deleted file mode 100755 index 66ac5de..0000000 --- a/bin/rate-us.import +++ /dev/null @@ -1,109 +0,0 @@ -#!/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 deleted file mode 100644 index 7b7e4bc..0000000 --- a/bin/rate.delete +++ /dev/null @@ -1,3 +0,0 @@ -#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 deleted file mode 100755 index fdd756d..0000000 --- a/bin/rate.import +++ /dev/null @@ -1,95 +0,0 @@ -#!/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/reassemble_taxes b/bin/reassemble_taxes deleted file mode 100755 index 001240b..0000000 --- a/bin/reassemble_taxes +++ /dev/null @@ -1,35 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use FS::UID qw(adminsuidsetup); -use FS::Conf; - -my $user = shift or die &usage; -my $dir = shift or die &usage; - - -adminsuidsetup $user; - -my $conf = new FS::Conf; - -chdir $dir or die "can't change to $dir: $!\n"; -die "pmzclfull.zip already exists\n" if -f 'pmzclfull.zip'; - -die "direct download of tax data not enabled\n" - unless $conf->exists('taxdatadirectdownload'); -my ( $urls, $username, $secret, $states ) = - $conf->config('taxdatadirectdownload'); -die "No tax download URL provided. ". - "Did you set the taxdatadirectdownload configuration value?\n" - unless $urls; - -my @filelist = qw( code.dbf detail.dbf geocode.dbf npanxx.dbf plus4.dbf - txmatrix.dbf zip.dbf ); - -system('zip', "-P", $secret, 'pmzclfull.zip', @filelist) == 0 - or die "zip failed\n"; - -sub usage { - die "Usage:\n\n reassemble_taxes user dir\n"; -} - diff --git a/bin/rebill b/bin/rebill deleted file mode 100755 index 4f05238..0000000 --- a/bin/rebill +++ /dev/null @@ -1,132 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Getopt::Std; -use Date::Parse; -use FS::UID qw(adminsuidsetup); -use FS::Record qw( qsearch ); -use cust_main_special; - -&untaint_argv; #what it sounds like (eww) -use vars qw(%opt); -getopts("p:a:d:sy:n", \%opt); - -my $user = shift or die &usage; -adminsuidsetup $user; - -my (@custnums) = @ARGV; - -my $time = $opt{d} ? str2time($opt{d}) : $^T; -$time += $opt{y} * 86400 if $opt{y}; -my $invoice_time = $opt{n} ? $^T : $time; - -my %args = ( - 'time' => $time, - 'invoice_time' => $invoice_time, - 'actual_time' => $^T, #when freeside-bill was started - #(not, when using -m, freeside-queued) - 'resetup' => ( $opt{'s'} ? $opt{'s'} : 0 ), - 'backbill' => $time, -); - -my $extra_sql = ( $opt{a} || $opt{p} ) ? ' AND ' : ' WHERE '; -$extra_sql .= "( ". join( ' OR ', map{ "custnum = $_" } @custnums ). " )"; -$extra_sql = '' unless scalar @custnums; - -my @cust = qsearch( { table => 'cust_main', - hashref => { $opt{a} ? ( 'agentnum' => $opt{a} ) : (), - $opt{p} ? ( 'payby' => $opt{p} ) : (), - }, - extra_sql => $extra_sql, - } - ); - -foreach my $cust ( @cust ) { - my $balance = $cust->balance; - cust_main_special::bill($cust, %args); - if ($balance != $cust->balance){ - $cust->apply_payments_and_credits; - my $error = $cust->collect(%args); - warn "Error collecting, custnum ". $cust->custnum. ": $error" if $error; - } -} - - -### -# subroutines -### - -sub untaint_argv { - foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; - # Date::Parse - $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; - $ARGV[$_]=$1; - } -} - -sub usage { - die "Usage:\n\n freeside-daily [ -d 'date' ] [ -y days ] [ -p 'payby' ] [ -a agentnum ] [ -s ] user [ custnum custnum ... ]\n"; -} - -### -# documentation -### - -=head1 NAME - -freeside-daily - Run daily billing and invoice collection events. - -=head1 SYNOPSIS - - freeside-daily [ -d 'date' ] [ -y days ] [ -p 'payby' ] [ -a agentnum ] [ -s ] user [ custnum custnum ... ] - -=head1 DESCRIPTION - -Bills customers and runs invoice collection events. Should be run from -crontab daily. - -Bills customers. Searches for customers who are due for billing and calls -the bill and collect methods of a cust_main object. See L<FS::cust_main>. - - -d: Pretend it's 'date'. Date is in any format Date::Parse is happy with, - but be careful. - - -y: In addition to -d, which specifies an absolute date, the -y switch - specifies an offset, in days. For example, "-y 15" would increment the - "pretend date" 15 days from whatever was specified by the -d switch - (or now, if no -d switch was given). - - -n: When used with "-d" and/or "-y", specifies that invoices should be dated - with today's date, irregardless of the pretend date used to pre-generate - the invoices. - - -p: Only process customers with the specified payby (I<CARD>, I<DCRD>, I<CHEK>, I<DCHK>, I<BILL>, I<COMP>, I<LECB>) - - -a: Only process customers with the specified agentnum - - -s: re-charge setup fees - - -v: enable debugging - - -l: debugging level - - -m: Experimental multi-process mode uses the job queue for multi-process and/or multi-machine billing. - - -r: Multi-process mode dry run option - - -k: skip notify_flat_delay and vacuum - -user: From the mapsecrets file - see config.html from the base documentation - -custnum: if one or more customer numbers are specified, only bills those -customers. Otherwise, bills all customers. - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::cust_main>, config.html from the base documentation - -=cut - diff --git a/bin/reset-cust_credit-otaker b/bin/reset-cust_credit-otaker deleted file mode 100755 index 93002d0..0000000 --- a/bin/reset-cust_credit-otaker +++ /dev/null @@ -1,88 +0,0 @@ -#!/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 deleted file mode 100755 index 7f83ef4..0000000 --- a/bin/rollback +++ /dev/null @@ -1,38 +0,0 @@ -#!/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 deleted file mode 100755 index 7bef0bb..0000000 --- a/bin/rotate-cdrs +++ /dev/null @@ -1,38 +0,0 @@ -#!/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 deleted file mode 100755 index b027542..0000000 --- a/bin/rt-drop-tables +++ /dev/null @@ -1,29 +0,0 @@ -#!/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-trim-whitespace b/bin/rt-trim-whitespace deleted file mode 100755 index 503d9cf..0000000 --- a/bin/rt-trim-whitespace +++ /dev/null @@ -1,38 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; -use FS::Record; -use FS::UID qw(adminsuidsetup dbh driver_name); - -# Remove trailing whitespace from custom field option lists and values. - -my $dbh = adminsuidsetup(shift) or die "Usage: rt-trim-whitespace username\n"; -die "rt-trim-whitespace only works on Pg databases" if driver_name ne 'Pg'; - -my @updates = ( - customfieldvalues => 'name', - objectcustomfieldvalues => 'content', -); - -while(@updates) { - my $table = shift @updates; - my $field = shift @updates; - my $select = -"SELECT $field FROM $table WHERE $field != substring($field from ". - q!E'^(.*\\\\S)\\\\s*$'! . ')'; - - print "$select\n"; - my $rows = $dbh->do($select); - print "$rows rows found.\n"; - - if($rows) { - my $update = -"UPDATE $table SET $field = substring($field from ".q!E'^(.*\\\\S)\\\\s*$'!.')'. -" WHERE $field != substring($field from ".q!E'^(.*\\\\S)\\\\s*$'!.')'; - print "$update\n"; - my $rows = $dbh->do($update); - print "$rows updated.\n"; - } -} -$dbh->commit or die $dbh->errstr; diff --git a/bin/rt-update-customfield-dates b/bin/rt-update-customfield-dates deleted file mode 100755 index 73fbd09..0000000 --- a/bin/rt-update-customfield-dates +++ /dev/null @@ -1,73 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; -use Date::Parse; -use Date::Format; -use FS::UID qw(adminsuidsetup); -use FS::Record; - -my @date_fields = ( - 'Circuit Ordered Date', - 'Circuit Due Date (s)', - 'Install Date', - 'Site Audit Date', - 'LOCAL PORT COMPLETE', - 'TF PORTING COMPLETE', - '411 Submission', - 'Billed in Freeside', - 'Billed in Quickbooks', -); -#@date_fields = ( 'Custom thingie' ); - -my $dbh = adminsuidsetup(shift) or die "Usage: rt-update-customfield-dates username\n"; - -foreach my $date_field ( @date_fields ) { - - my $cf_sql = 'SELECT id FROM CustomFields where name = '. $dbh->quote($date_field); - my $cf_sth = $dbh->prepare($cf_sql) or die $dbh->errstr; - $cf_sth->execute or die $cf_sth->errstr; - my $result = $cf_sth->fetchrow_arrayref - or do { warn "$date_field not found; skipping\n"; next }; - my $customfield_id = $result->[0]; - - my $ocfv_sql = "SELECT id, content FROM ObjectCustomFieldValues WHERE customfield = $customfield_id and content !~ '^[0-9]+\$' "; - my $ocfv_sth = $dbh->prepare($ocfv_sql) or die $dbh->errstr; - $ocfv_sth->execute or die $ocfv_sth->errstr; - - while (my $row = $ocfv_sth->fetchrow_arrayref) { - - my($id, $content) = @$row; - - my $origcontent = $content; - - #April 21 KW / April 21 Mont - $content =~ s/^April (\d\d) [a-zA-Z]+$/April $1/; - - #SAL April 29 / other May 3 - $content =~ s/^[a-zA-Z]+ (April|May) (\d\d?)$/$1 $2/; - - #things like "July 8/2010 and "JUNE 24/10" are not doing what we want - $content =~ s/^(June|July) (\d\d?)\/(20)?10$/$1 $2, 2010/i; - - #28/04/2010 - $content =~ s{^(2\d|1[3-9])/(0\d)/2010$}{$2/$1/2010}; - - my $unixdate = str2time($content); #current timezone is what we want here - - #things like "DONE"/"ORDERED" are returning a 0 here.. should stay blank - my $prettynew = $unixdate ? time2str('%Y-%m-%d %T', $unixdate, 'GMT') : ''; - - print "$id: $origcontent -> $prettynew \n" unless $content =~ qr(^0\d/\d\d/2010$); - - my $update_sql = - "UPDATE ObjectCustomFieldValues SET content = '$prettynew'". - " WHERE id = $id"; - - my $update_sth = $dbh->prepare($update_sql) or die $dbh->errstr; - $update_sth->execute or die $update_sth->errstr; - $dbh->commit or die $dbh->errstr; - - } - -} diff --git a/bin/rt-update-links b/bin/rt-update-links deleted file mode 100644 index 75d554f..0000000 --- a/bin/rt-update-links +++ /dev/null @@ -1,36 +0,0 @@ -#!/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/select-cust-desync_bill_dates.sql b/bin/select-cust-desync_bill_dates.sql deleted file mode 100644 index 5506f90..0000000 --- a/bin/select-cust-desync_bill_dates.sql +++ /dev/null @@ -1,9 +0,0 @@ -SELECT DISTINCT custnum, agent_custid, first, last, company - FROM cust_pkg LEFT JOIN cust_main USING ( custnum ) - WHERE cancel IS NULL AND 0 < ( - SELECT COUNT(*) FROM cust_pkg AS others - WHERE cust_pkg.custnum = others.custnum - AND cust_pkg.pkgnum != others.pkgnum - AND cust_pkg.bill != others.bill - AND others.cancel IS NULL - ); diff --git a/bin/sendmail.import b/bin/sendmail.import deleted file mode 100644 index ef745fc..0000000 --- a/bin/sendmail.import +++ /dev/null @@ -1,178 +0,0 @@ -#!/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 deleted file mode 100644 index 2dc1d3b..0000000 --- a/bin/sequences.reset +++ /dev/null @@ -1,32 +0,0 @@ -#!/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 deleted file mode 100755 index 7957011..0000000 --- a/bin/shadow.reimport +++ /dev/null @@ -1,125 +0,0 @@ -#!/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 deleted file mode 100755 index 0798c1a..0000000 --- a/bin/slony-setup +++ /dev/null @@ -1,109 +0,0 @@ -#!/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 deleted file mode 100755 index b7d0166..0000000 --- a/bin/sqlradius-norealm.reimport +++ /dev/null @@ -1,113 +0,0 @@ -#!/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 deleted file mode 100644 index e75f65b..0000000 --- a/bin/sqlradius.import +++ /dev/null @@ -1,152 +0,0 @@ -#!/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 deleted file mode 100755 index 2218a3f..0000000 --- a/bin/sqlradius.reimport +++ /dev/null @@ -1,160 +0,0 @@ -#!/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 deleted file mode 100755 index 2c2d124..0000000 --- a/bin/strip-eps +++ /dev/null @@ -1,20 +0,0 @@ -#!/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-recalculate_usage b/bin/svc_acct-recalculate_usage deleted file mode 100644 index 1b3955b..0000000 --- a/bin/svc_acct-recalculate_usage +++ /dev/null @@ -1,110 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use vars qw($opt_s $opt_u $opt_p $opt_k); -use Getopt::Std; -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearch qsearchs); -use FS::svc_acct; -use FS::cust_svc; - -my %field2sub = ( - 'seconds' => sub { - my($svc_acct, $cust_pkg) = @_; - $svc_acct->seconds_since_sqlradacct( $cust_pkg->last_bill, time ); - }, - 'upbytes' => sub { - my($svc_acct, $cust_pkg) = @_; - $svc_acct->attribute_since_sqlradacct( - $cust_pkg->last_bill, time, 'AcctInputOctets' ); - }, - 'downbytes' => sub { - my($svc_acct, $cust_pkg) = @_; - $svc_acct->attribute_since_sqlradacct( - $cust_pkg->last_bill, time, 'AcctOutputOctets' ); - }, - 'totalbytes' => sub { - my($svc_acct, $cust_pkg) = @_; - $svc_acct->attribute_since_sqlradacct( - $cust_pkg->last_bill, time, 'AcctInputOctets' ) - + - $svc_acct->attribute_since_sqlradacct( - $cust_pkg->last_bill, time, 'AcctOutputOctets' ) - ; - }, -); - -my $user = shift or die &usage; -adminsuidsetup $user; - -my $field = shift; -die "can only reset seconds, upbytes, downbytes or totalbytes" - unless $field2sub{$field}; - -my $value = shift; - -#false laziness w/freeside-reexport -getopts('s:u:p:k:'); - -my @svc_x = (); -if ( $opt_s ) { - my $cust_svc = qsearchs('cust_svc', { svcnum=>$opt_s } ) - or die "svcnum $opt_s not found\n"; - push @svc_x, $cust_svc->svc_x; -} elsif ( $opt_u ) { - my $svc_x = qsearchs('svc_acct', { username=>$opt_u } ) - or die "username $opt_u not found\n"; - push @svc_x, $svc_x; -} elsif ( $opt_p ) { - push @svc_x, map { $_->svc_x } qsearch('cust_svc', { svcpart=>$opt_p } ); - die "no services with svcpart $opt_p found\n" unless @svc_x; -} elsif ( $opt_k ) { - push @svc_x, - map { $_->svc_x } - qsearch({ - table => 'cust_svc', - addl_from => 'LEFT JOIN cust_pkg USING ( pkgnum )', - extra_sql => "WHERE pkgpart = $opt_k", - }); - die "no services with pkgpart $opt_k found\n" unless @svc_x; -} - -warn "setting $field to $value before usage\n"; -foreach my $svc_x ( @svc_x ) { - my $cust_pkg = $svc_x->cust_svc->cust_pkg; - my $cust_usage = $value - &{ $field2sub{$field} }( $svc_x, $cust_pkg ); -# warn "resetting ". $svc_x->svcnum.':'.$svc_x->username. " to $cust_usage\n"; - warn "$field for ". $svc_x->svcnum.':'.$svc_x->username. " reached limit\n" - if $cust_usage <= 0; - $svc_x->$field($cust_usage); - - my $error = $svc_x->replace; - die $error if $error; -} - -sub usage { - die "Usage:\n\n svc_acct-recalculate_usage user [ -s svcnum | -u username | -p svcpart ]\n"; -} - -=head1 NAME - -svc-acct-recalculate_usage - Command line tool to recalculate usage for existing services - -=head1 SYNOPSIS - - svc_acct-recalculate_usage user usagefield initialvalue [ -s svcnum | -u username | -p svcpart ] - - #recalculate a 1gb totalbytes limit for pkgpart 2 - svc_acct-recalculate_usage ivan totalbytes 1073741824 -k 2 - -=head1 DESCRIPTION - -Re-calculates the specified usage field for the specified service(s) (selected -by svcnum, username or svcpart). - -=head1 SEE ALSO - -L<FS::svc_acct>, L<freeside-reexport>, L<FS::part_export> - -=cut - diff --git a/bin/svc_acct.import b/bin/svc_acct.import deleted file mode 100755 index aff26b9..0000000 --- a/bin/svc_acct.import +++ /dev/null @@ -1,237 +0,0 @@ -#!/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); -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/shuddown /bin/halt); #others? - -my($spooldir)="/usr/local/etc/freeside/export.". datasrc; - -$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). -END -my($ppp_svcpart)=&getpart; - -print "\n\n", &menu_svc, "\n", <<END; -Some accounts have entries in passwd and users, but with Port-Limit 2 (or -more). -END -my($isdn_svcpart)=&getpart; - -print "\n\n", &menu_svc, "\n", <<END; -Some accounts might have entries in users only (Port-Limit 1) -END -my($oppp_svcpart)=&getpart; - -print "\n\n", &menu_svc, "\n", <<END; -Some accounts might have entries in users only (Port-Limit >= 2) -END -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 -my($pop_shell)=&getvalue("Enter that shell:"); -my($popmail_svcpart)=&getpart; - -print "\n\n", &menu_svc, "\n", <<END; -Everything else in passwd is a shell account. -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"); - -print "\n\n", <<END; -Enter the location and name of your radius "users" file, for example -"radius.isp.com:/etc/raddb/users" -END -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 { - $^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"); -open(USERS,"<$spooldir/users.import"); - -my(%upassword,%ip,%allparam); -my(%param,$username); -while (<USERS>) { - chop; - next if /^\s*$/; - next if /^\s*#/; - if ( /^\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),$3,$5); - $password = '' if $password eq 'UNIX'; - $upassword{$username}=$password; - undef %param; - } else { - die "2Unexpected line in users.import: $_"; - } - while (<USERS>) { - chop; - if ( /^\s*$/ ) { - 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*$/ ) { - my($attribute,$value)=($1,$2); - $attribute =~ s/\-/_/g; - $param{'radius_'.$attribute}=$value; - } else { - die "3Unexpected line in users.import: $_"; - } - } -} -#? incase there isn't a terminating blank line ? -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; -} - -while (<PASSWD>) { - chop; - my($username,$x,$uid,$gid,$finger,$dir,$shell)=split(/:/); - my($password)=$upassword{$username} || $password{$username}; - - my($maxb)=${$allparam{$username}}{'radius_Port_Limit'}; - my($svcpart); - if ( exists $upassword{$username} ) { - if ( $maxb >= 2 ) { - $svcpart = $isdn_svcpart - } elsif ( ! $maxb || $maxb == 1 ) { - $svcpart = $ppp_svcpart - } else { - die "Illegal Port-Limit in users ($username)!\n"; - } - } elsif ( $shell eq $pop_shell ) { - $svcpart = $popmail_svcpart; - } else { - $svcpart = $shell_svcpart; - } - - 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); - $error=$svc_acct->insert; - die $error if $error; - - delete $allparam{$username}; - delete $upassword{$username}; -} - -#my($username); -foreach $username ( keys %upassword ) { - my($password)=$upassword{$username}; - - my($maxb)=${$allparam{$username}}{'radius_Port_Limit'} || 0; - my($svcpart); - if ( $maxb == 2 ) { - $svcpart = $oisdn_svcpart - } elsif ( ! $maxb || $maxb == 1 ) { - $svcpart = $oppp_svcpart - } else { - die "Illegal Port-Limit in users!\n"; - } - - my($svc_acct) = new FS::svc_acct ({ - 'svcpart' => $svcpart, - 'username' => $username, - '_password' => $password, - 'slipip' => $ip{$username}, - %{$allparam{$username}}, - }); - my($error); - $error=$svc_acct->insert; - die $error, if $error; - - delete $allparam{$username}; - 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 deleted file mode 100755 index 9e3d38b..0000000 --- a/bin/svc_acct_pop.import +++ /dev/null @@ -1,59 +0,0 @@ -#!/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_broadband.renumber b/bin/svc_broadband.renumber deleted file mode 100755 index 980fa00..0000000 --- a/bin/svc_broadband.renumber +++ /dev/null @@ -1,84 +0,0 @@ -#!/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 deleted file mode 100755 index 435dd5f..0000000 --- a/bin/svc_domain.erase +++ /dev/null @@ -1,15 +0,0 @@ -#!/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 deleted file mode 100755 index c13912c..0000000 --- a/bin/sysvshell.export +++ /dev/null @@ -1,112 +0,0 @@ -#!/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/tax_rate_location.import b/bin/tax_rate_location.import deleted file mode 100755 index 439d27c..0000000 --- a/bin/tax_rate_location.import +++ /dev/null @@ -1,48 +0,0 @@ -#!/usr/bin/perl -Tw - -use strict; -use vars qw($opt_g $opt_f); -use vars qw($DEBUG); -use Getopt::Std; -use FS::UID qw(adminsuidsetup); -use FS::Conf; -use FS::tax_rate_location; - -getopts('f:g:'); - -my $user = shift or die &usage; -my $dbh = adminsuidsetup $user; - -my ($format) = $opt_f =~ /^([-\w]+)$/; - -my @list = ( - 'GEOCODE', $opt_g, \&FS::tax_rate_location::batch_import, -); - -my $oldAutoCommit = $FS::UID::AutoCommit; -local $FS::UID::AutoCommit = 0; - -my $error = ''; - -while(@list) { - my ($name, $file, $method) = splice(@list, 0, 3); - - my $fh; - - $file =~ /^([\s\d\w.]+)$/ or die "Illegal filename: $file\n"; - $file = $1; - - open $fh, '<', $file or die "can't open $name file: $!\n"; - $error ||= &{$method}( { filehandle => $fh, 'format' => $format, } ); - - die "error while processing $file: $error" if $error; - close $fh; -} - -if ($error) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; -}else{ - $dbh->commit or die $dbh->errstr if $oldAutoCommit; -} - -sub usage { die "Usage:\ntax_rates_location.import -f FORMAT -g GEOCODEFILE user\n\n"; } diff --git a/bin/test_scrub b/bin/test_scrub deleted file mode 100644 index 88edc33..0000000 --- a/bin/test_scrub +++ /dev/null @@ -1,60 +0,0 @@ -#!/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 vars qw( $opt_h ); -use Getopt::Std; -use FS::UID qw(adminsuidsetup dbh); -use FS::Conf; -use FS::Schema qw(dbdef); - -getopts('h'); - -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); -} - -if ($opt_h) { # not all history can be safely deleted - foreach my $table (grep { /^h_\w+$/ } dbdef->tables) { - my $sth = dbh->prepare("DELETE FROM $table") or die dbh->errstr; - $sth->execute or die $sth->errstr; - } -} - -dbh->commit or die dbh->errstr; diff --git a/bin/test_scrub_sql b/bin/test_scrub_sql deleted file mode 100755 index fb26fe9..0000000 --- a/bin/test_scrub_sql +++ /dev/null @@ -1,58 +0,0 @@ -#!/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 -#AND -#-masks all payment info - -foreach my $table (qw( - part_export_option - payment_gateway - payment_gateway_option - agent_payment_gateway - queue - queue_arg - cust_pay_batch -)) { - print "DELETE FROM $table;\n"; - print "DELETE FROM h_$table;\n"; -} - -foreach my $table (qw( - part_export - export_svc -)) { - print "DELETE FROM $table;\n"; -} - -print "DELETE FROM cust_main_invoice WHERE dest != 'POST';\n"; - -foreach my $item (qw( - business-onlinepayment - business-onlinepayment-ach -)) { - print "DELETE FROM conf WHERE name = '$item';\n"; - print "DELETE FROM h_conf WHERE name = '$item';\n"; -} - -my @ptables = map { ($_, "h_$_") } qw( - cust_main - cust_pay - cust_pay_pending - cust_pay_void - cust_refund -); -foreach my $table (@ptables) { - print "UPDATE $table SET payinfo = paymask WHERE payby IN ( 'CARD','DCRD','CHEK','DCHK' );\n"; -} - -print "UPDATE cust_main set paycvv = NULL;\n"; -print "UPDATE h_cust_main set paycvv = NULL;\n"; diff --git a/bin/tron-scan b/bin/tron-scan deleted file mode 100755 index 914d6d4..0000000 --- a/bin/tron-scan +++ /dev/null @@ -1,24 +0,0 @@ -#!/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; diff --git a/bin/wipe-agent b/bin/wipe-agent deleted file mode 100644 index 0e1846a..0000000 --- a/bin/wipe-agent +++ /dev/null @@ -1,39 +0,0 @@ -#!/usr/bin/perl - -use strict; -use vars qw( $opt_a $opt_d ); -use Getopt::Std; -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearch); -use FS::cust_main; - -die "i cancel and delete all customers of an agent - use the -d switch first and be careful - remove this line to enable"; - -getopts('a:d'); - -my $user = shift or die "usage: wipe-agent -a agentnum [ -d ] username\n"; -adminsuidsetup $user; - -die "no agentnum specified" unless $opt_a; - -foreach my $cust_main ( - - qsearch('cust_main', { 'agentnum' => $opt_a } ) - -) { - - warn "deleting ". $cust_main->custnum.': '. $cust_main->name. "\n"; - - unless ( $opt_d ) { #dry run - - my @cerrors = $cust_main->cancel( quiet=>1, nobill=>1 ); - if ( @cerrors ) { - die join(' / ', @cerrors); - } - - my $error = $cust_main->delete( 'delete_financials' => 1); - die $error if $error; - - } - -} diff --git a/bin/wipe-customers b/bin/wipe-customers deleted file mode 100644 index e65ed61..0000000 --- a/bin/wipe-customers +++ /dev/null @@ -1,30 +0,0 @@ -#!/usr/bin/perl - -use strict; -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearch); -use FS::cust_main; - -die "this removes all customers in your database except for customer 1 - remove this line to enable"; - -my $user = shift or die "usage: wipe-customers username\n"; -adminsuidsetup $user; - -#this isn't terribly efficient, but the idea was clearing out a test database, -#not actually destroying a large amount of data - -foreach my $cust_main ( - - qsearch('cust_main', { 'custnum' => { op=>'!=', value=>'1' } } ) - -) { - - my @cerrors = $cust_main->cancel( quiet=>1, nobill=>1 ); - if ( @cerrors ) { - die join(' / ', @cerrors); - } - - my $error = $cust_main->delete( 'delete_financials' => 1); - die $error if $error; - -} diff --git a/bin/xmlrpc-agent_new_customer.pl b/bin/xmlrpc-agent_new_customer.pl deleted file mode 100755 index 761fcdf..0000000 --- a/bin/xmlrpc-agent_new_customer.pl +++ /dev/null @@ -1,80 +0,0 @@ -#!/usr/bin/perl -# -# xmlrpc-agent_new_customer.pl username password - -use strict; -use Frontier::Client; -use Data::Dumper; - -my( $username, $password ) = ( @ARGV ); - -my $uri = new URI 'http://localhost/selfservice/xmlrpc.cgi'; - -my $server = new Frontier::Client ( 'url' => $uri ); - - -### -# login -### - -my $login_result = $server->call('FS.SelfService.XMLRPC.agent_login', - { - 'username' => $username, - 'password' => $username, - } -); - -die $login_result->{'error'} if $login_result->{'error'}; - -my $session_id = $login_result->{'session_id'}; -warn "logged in w/session_id $session_id\n"; - - -### -# new_customer -### - -my $result = $server->call('FS.SelfService.XMLRPC.new_customer', - { - 'session_id' => $session_id, - #customer informaiton - 'first' => 'Tofu', - 'last' => 'Beast', - 'address1' => '1234 Soybean Ln.', - 'city' => 'Tofutown', - 'state' => 'CA', - 'zip' => '54321', - 'country' => 'US', - 'invoicing_list' => 'tofu@example.com', - #billing information - 'payby' => 'CARD', - 'payinfo' => '4111111111111111', - 'paycvv' => '123', - 'paydate' => '11/2012', - #package information - 'pkgpart' => '2', - 'username' => 'tofu', - '_password' => 's33kret', - } -); - -die $result->{'error'} if $result->{'error'}; - -my $custnum = $result->{'custnum'}; -warn "added new customer w/custnum $custnum\n"; - - -### -# logout -### - -my $logout_result = $server->call('FS.SelfService.XMLRPC.agent_logout', - { - 'session_id' => $session_id, - } -); - -die $logout_result->{'error'} if $logout_result->{'error'}; -warn "logged out\n"; - -1; diff --git a/bin/xmlrpc-customer_status.pl b/bin/xmlrpc-customer_status.pl deleted file mode 100755 index 3840b20..0000000 --- a/bin/xmlrpc-customer_status.pl +++ /dev/null @@ -1,23 +0,0 @@ -#!/usr/bin/perl -# -# xmlrpc-customer_status.pl username password custnum - -use strict; -use Frontier::Client; -use Data::Dumper; - -my( $u, $p, $custnum ) = ( @ARGV ); -my $userinfo = $u.':'.$p; - -my $uri = new URI 'http://localhost/freeside/misc/xmlrpc.cgi'; -$uri->userinfo( $userinfo ); - -my $server = new Frontier::Client ( 'url' => $uri ); - -my $result = $server->call('Maestro.customer_status', $custnum ); - -#die $result->{'error'} if $result->{'error'}; - -print Dumper($result); - -1; diff --git a/bin/xmlrpc-order_pkg.pl b/bin/xmlrpc-order_pkg.pl deleted file mode 100755 index 90d1ff3..0000000 --- a/bin/xmlrpc-order_pkg.pl +++ /dev/null @@ -1,31 +0,0 @@ -#!/usr/bin/perl -# -# xmlrpc-order_pkg.pl username password - -use strict; -use Frontier::Client; -use Data::Dumper; - -my( $u, $p, $custnum ) = ( @ARGV ); -my $userinfo = $u.':'.$p; - -my $uri = new URI 'http://localhost/freeside/misc/xmlrpc.cgi'; -$uri->userinfo( $userinfo ); - -my $server = new Frontier::Client ( 'url' => $uri ); - -my $result = $server->call('Maestro.order_pkg', - { - 'custnum' => 8, - 'pkgpart' => 3, - 'id' => $$, #unique - 'title' => 'John Q. Public', #'name' also works - #(turn off global_unique-pbx_title) - }, -); - -#die $result->{'error'} if $result->{'error'}; - -print Dumper($result); - -1; |