diff options
Diffstat (limited to 'bin')
100 files changed, 10840 insertions, 0 deletions
diff --git a/bin/add-history-records.pl b/bin/add-history-records.pl new file mode 100755 index 000000000..fbf9d09d9 --- /dev/null +++ b/bin/add-history-records.pl @@ -0,0 +1,139 @@ +#!/usr/bin/perl + +die "This is broken. Don't use it!\n"; + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearchs qsearch); + +use Data::Dumper; + +my @tables = qw(svc_acct svc_broadband svc_domain svc_external svc_forward svc_www cust_svc domain_record); +#my @tables = qw(svc_www); + +my $user = shift or die &usage; +my $dbh = adminsuidsetup($user); + +my $dbdef = FS::Record::dbdef; + +foreach my $table (@tables) { + + my $h_table = 'h_' . $table; + my $cnt = 0; + my $t_cnt = 0; + + eval "use FS::${table}"; + die $@ if $@; + eval "use FS::${h_table}"; + die $@ if $@; + + print "Adding history records for ${table}...\n"; + + my $dbdef_table = $dbdef->table($table); + my $pkey = $dbdef_table->primary_key; + + foreach my $rec (qsearch($table, {})) { + + #my $h_rec = qsearchs( + # $h_table, + # { $pkey => $rec->getfield($pkey) }, + # eval "FS::${h_table}->sql_h_searchs(time)", + #); + + my $h_rec = qsearchs( + $h_table, + { $pkey => $rec->getfield($pkey) }, + "DISTINCT ON ( $pkey ) *", + "AND history_action = 'insert' ORDER BY $pkey ASC, history_date DESC", + '', + 'AS maintable', + ); + + unless ($h_rec) { + my $h_insert_rec = $rec->_h_statement('insert', 1); + #print $h_insert_rec . "\n"; + $dbh->do($h_insert_rec); + die $dbh->errstr if $dbh->err; + $dbh->commit or die $dbh->errstr; + $cnt++; + } + + + $t_cnt++; + + } + + print "History records inserted into $h_table: $cnt\n"; + print " Total records in $table: $t_cnt\n"; + + print "\n"; + +} + +foreach my $table (@tables) { + + my $h_table = 'h_' . $table; + my $cnt = 0; + + eval "use FS::${table}"; + die $@ if $@; + eval "use FS::${h_table}"; + die $@ if $@; + + print "Adding insert records for unmatched delete records on ${table}...\n"; + + my $dbdef_table = $dbdef->table($table); + my $pkey = $dbdef_table->primary_key; + + #SELECT * FROM h_svc_www + #DISTINCT ON ( $pkey ) ? + my $where = " + WHERE ${pkey} in ( + SELECT ${h_table}1.${pkey} + FROM ${h_table} as ${h_table}1 + WHERE ( + SELECT count(${h_table}2.${pkey}) + FROM ${h_table} as ${h_table}2 + WHERE ${h_table}2.${pkey} = ${h_table}1.${pkey} + AND ${h_table}2.history_action = 'delete' + ) > 0 + AND ( + SELECT count(${h_table}3.${pkey}) + FROM ${h_table} as ${h_table}3 + WHERE ${h_table}3.${pkey} = ${h_table}1.${pkey} + AND ( ${h_table}3.history_action = 'insert' + OR ${h_table}3.history_action = 'replace_new' ) + ) = 0 + GROUP BY ${h_table}1.${pkey})"; + + + my @h_recs = qsearch( + $h_table, { }, + "DISTINCT ON ( $pkey ) *", + $where, + '', + '' + ); + + foreach my $h_rec (@h_recs) { + #print "Adding insert record for deleted record with pkey='" . $h_rec->getfield($pkey) . "'...\n"; + my $class = 'FS::' . $table; + my $rec = $class->new({ $h_rec->hash }); + my $h_insert_rec = $rec->_h_statement('insert', 1); + #print $h_insert_rec . "\n"; + $dbh->do($h_insert_rec); + die $dbh->errstr if $dbh->err; + $dbh->commit or die $dbh->errstr; + $cnt++; + } + + print "History records inserted into $h_table: $cnt\n"; + +} + + + +sub usage { + die "Usage:\n add-history-records.pl user\n"; +} + diff --git a/bin/all-postal-no-email b/bin/all-postal-no-email new file mode 100755 index 000000000..ef5dff66b --- /dev/null +++ b/bin/all-postal-no-email @@ -0,0 +1,22 @@ +#!/usr/bin/perl -w + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_main; + +my $user = shift or die &usage; +adminsuidsetup $user; + +foreach my $cust_main ( qsearch( 'cust_main', {} ) ) { + + print $cust_main->custnum. "\n"; + + $cust_main->invoicing_list( [ 'POST' ] ); + +} + +sub usage { + die "Usage:\n\n all-postal-no-email user\n"; +} + diff --git a/bin/apache.export b/bin/apache.export new file mode 100755 index 000000000..82eb6d6b0 --- /dev/null +++ b/bin/apache.export @@ -0,0 +1,94 @@ +#!/usr/bin/perl -w + +use strict; +use Getopt::Std; +#use File::Path; +use File::Rsync; +use Net::SSH qw(ssh); +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(qsearch qsearchs); +use FS::part_export; +use FS::cust_svc; +use FS::svc_www; + +use vars qw(%opt); +getopts("d", \%opt); + +my $user = shift or die &usage; +adminsuidsetup $user; + +#needs the export number in there somewhere too...? +my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/apache"; +mkdir $spooldir, 0700 unless -d $spooldir; + +my @exports = qsearch('part_export', { 'exporttype' => 'apache' } ); + +my $rsync = File::Rsync->new({ + rsh => 'ssh', +# dry_run => 1, +}); + +foreach my $export ( @exports ) { + + my $machine = $export->machine; + my $exportnum = $export->exportnum; + my $file = "$spooldir/$machine.exportnum$exportnum.conf"; + + warn "exporting apache configuration for $machine to $file\n" + if $opt{d}; + + open(HTTPD_CONF,">$file") or die "can't open $file: $!"; + + my $template = $export->option('template'); + + my @svc_www = $export->svc_x; + + foreach my $svc_www ( @svc_www ) { + use vars qw($zone $username $dir $email $config); + $zone = $svc_www->domain_record->zone; + $config = $svc_www->config; + if ( $svc_www->svc_acct ) { + $username = $svc_www->svc_acct->username; + $dir = $svc_www->svc_acct->dir; + $email = $svc_www->svc_acct->email; + } else { + $username = ''; + $dir = ''; + $email = ''; + } + + warn " adding configuration section for $zone\n" + if $opt{d}; + + print HTTPD_CONF eval(qq("$template")). "\n\n"; + } + + my $user = $export->option('user'); + my $httpd_conf = $export->option('httpd_conf'); + + warn "syncing $file to $httpd_conf on $machine\n" + if $opt{d}; + + $rsync->exec( { + src => $file, + dest => "$user\@$machine:$httpd_conf", + } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err); + # warn $rsync->out; + + my $restart = $export->option('restart') || 'apachectl graceful'; + + warn "running restart command $restart on $machine\n" + if $opt{d}; + + ssh("root\@$machine", $restart); + +} + +close HTTPD_CONF; + +# ----- + +sub usage { + die "Usage:\n apache.export [ -d ] user\n"; +} + diff --git a/bin/artera.import b/bin/artera.import new file mode 100644 index 000000000..716dddad0 --- /dev/null +++ b/bin/artera.import @@ -0,0 +1,75 @@ +#!/usr/bin/perl -w + +use strict; + +use Text::CSV_XS; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearchs); +use FS::svc_external; +use FS::svc_domain; +use FS::svc_acct; + +$FS::svc_Common::noexport_hack = 1; + +my $svcpart = 30; + +my $user = shift + or die 'Usage:\n\n artera.import user <artera_active_orders.csv'; +adminsuidsetup $user; + +## + +my $csv = new Text::CSV_XS; + +my $header = scalar(<>); + +my( $num, $linked ) = ( 0, 0 ); + +while (<>) { + my $status = $csv->parse($_) + or die $csv->error_input; + my($serial, $keycode, $name, $ordernum, $email) = $csv->fields(); + #warn join(" - ", $serial, $keycode, $name, $ordernum, $email ). "\n"; + + $email =~ /^([^@]+)\@([^@]+)$/ + or die $email; + my($username, $domain) = ( $1, $2 ); + my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ); + my $cust_svc = ''; + if ( $svc_domain ) { + my $svc_acct = qsearchs('svc_acct', { + 'username' => $username, + 'domsvc' => $svc_domain->svcnum, + } ); + $cust_svc = $svc_acct->cust_svc + if $svc_acct; + #} else { + # warn "can't find domain $domain\n"; + } + + my $exist = qsearchs('svc_external', { 'id' => $serial } ); + next if $exist; + + my $svc_external = new FS::svc_external { + 'svcpart' => $svcpart, + 'pkgnum' => ( $cust_svc ? $cust_svc->pkgnum : '' ), + 'id' => $serial, + 'title' => $keycode, + }; + #my $error = $svc_external->check; + my $error = $svc_external->insert; + if ( $cust_svc && $error =~ /^Already/ ) { + warn $error; + $svc_external->pkgnum(''); + $error = $svc_external->insert; + } + warn $error if $error; + + $num++; + $linked++ if $cust_svc; + #print "$num imported, $linked linked\n"; + +} + +print "$num imported, $linked linked\n"; + diff --git a/bin/backup-dvd b/bin/backup-dvd new file mode 100644 index 000000000..d0314b469 --- /dev/null +++ b/bin/backup-dvd @@ -0,0 +1,45 @@ +#!/bin/bash + +database="freeside" +DEVICE="/dev/hda" + +su freeside -c "pg_dump $database" >/var/backups/$database.sql + +DATE=$(date +%Y-%m-%d) + +#NOTE: These two paths must end in a / in +#order to correctly build up the other paths +#BACKUP_DIR="/backup/directory/" +BACKUP_DIR="/backup/" + #TEMP_BACKUP_FILES_DIR="/backup/temp/" + +BACKUP_FILE=$BACKUP_DIR"backup-"$DATE".tar.bz2" + #DATABASE_FILE=$TEMP_BACKUP_FILES_DIR"foo-"$DATE".sql" + + #These directories shouldn't end in a / although + #I don't think it will cause any problems if + #they do. There should be a space at the end though + #to ensure the database file gets concatenated correctly. + #SOURCE="/a/location /other/locations " $DATABASE_FILE + +#echo Removing old backup directories +rm -rf $BACKUP_DIR + #rm -rf $TEMP_BACKUP_FILES_DIR + +#echo Creating new backup directories +mkdir $BACKUP_DIR + #mkdir $TEMP_BACKUP_FILES_DIR + + #echo Creating database backup + #pg_dump -U username -f $DATABASE_FILE databaseName + +#echo Backing up $SOURCE to file $BACKUP_FILE +#tar -cvpl -f $BACKUP_FILE --anchored --exclude /backup / +tar -cjpl -f $BACKUP_FILE --anchored --exclude /backup / + + ##This is not necessary and possibly harmful for DVD+RW media + #echo Quick blanking media + #dvd+rw-format -blank /dev/hdc + +#echo Burning backup +growisofs -dvd-compat -Z $DEVICE -quiet -r -J $BACKUP_FILE diff --git a/bin/bill-as-nextmonth b/bin/bill-as-nextmonth new file mode 100755 index 000000000..813e84193 --- /dev/null +++ b/bin/bill-as-nextmonth @@ -0,0 +1,5 @@ +#!/bin/sh + +month=`date +%m` +nextmonth=`expr $month + 1` +/usr/local/bin/freeside-daily -d $nextmonth/1/`date +%Y` fs_daily diff --git a/bin/bill-as-nextmonth-BILL b/bin/bill-as-nextmonth-BILL new file mode 100755 index 000000000..91e943110 --- /dev/null +++ b/bin/bill-as-nextmonth-BILL @@ -0,0 +1,5 @@ +#!/bin/sh + +month=`date +%m` +nextmonth=`expr $month + 1` +/usr/local/bin/freeside-daily -d $nextmonth/1/`date +%Y` -p BILL fs_daily diff --git a/bin/bill-as-nextyear b/bin/bill-as-nextyear new file mode 100755 index 000000000..63c4ad2be --- /dev/null +++ b/bin/bill-as-nextyear @@ -0,0 +1,5 @@ +#!/bin/sh + +year=`date +%Y` +nextyear=`expr $year + 1` +/usr/local/bin/freeside-daily -d 1/1/$nextyear fs_daily diff --git a/bin/bill-as-nextyear-BILL b/bin/bill-as-nextyear-BILL new file mode 100755 index 000000000..0d77dd0d6 --- /dev/null +++ b/bin/bill-as-nextyear-BILL @@ -0,0 +1,5 @@ +#!/bin/sh + +year=`date +%Y` +nextyear=`expr $year + 1` +/usr/local/bin/freeside-daily -d 1/1/$nextyear -p BILL fs_daily diff --git a/bin/bill-for-nextmonth b/bin/bill-for-nextmonth new file mode 100755 index 000000000..e1a33764e --- /dev/null +++ b/bin/bill-for-nextmonth @@ -0,0 +1,5 @@ +#!/bin/sh + +month=`date +%m` +nextmonth=`expr $month + 1` +/usr/local/bin/freeside-daily -d $nextmonth/1/`date +%Y` -n fs_daily diff --git a/bin/bill-for-nextyear b/bin/bill-for-nextyear new file mode 100755 index 000000000..1430a5898 --- /dev/null +++ b/bin/bill-for-nextyear @@ -0,0 +1,5 @@ +#!/bin/sh + +year=`date +%Y` +nextyear=`expr $year + 1` +/usr/local/bin/freeside-daily -d 1/1/$nextyear -n fs_daily diff --git a/bin/bill-nextmonth b/bin/bill-nextmonth new file mode 100755 index 000000000..813e84193 --- /dev/null +++ b/bin/bill-nextmonth @@ -0,0 +1,5 @@ +#!/bin/sh + +month=`date +%m` +nextmonth=`expr $month + 1` +/usr/local/bin/freeside-daily -d $nextmonth/1/`date +%Y` fs_daily diff --git a/bin/bill-nextyear b/bin/bill-nextyear new file mode 100755 index 000000000..63c4ad2be --- /dev/null +++ b/bin/bill-nextyear @@ -0,0 +1,5 @@ +#!/bin/sh + +year=`date +%Y` +nextyear=`expr $year + 1` +/usr/local/bin/freeside-daily -d 1/1/$nextyear fs_daily diff --git a/bin/bind.export b/bin/bind.export new file mode 100755 index 000000000..286e43a2d --- /dev/null +++ b/bin/bind.export @@ -0,0 +1,195 @@ +#!/usr/bin/perl -w + +use strict; +use File::Path; +use File::Rsync; +use Net::SSH qw(ssh); +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(qsearch qsearchs); +use FS::part_export; +use FS::cust_pkg; +use FS::cust_svc; +use FS::svc_domain; + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/bind"; +mkdir $spooldir, 0700 unless -d $spooldir; + +my @exports = qsearch('part_export', { 'exporttype' => 'bind' } ); +my @sexports = qsearch('part_export', { 'exporttype' => 'bind_slave' } ); + +my $rsync = File::Rsync->new({ + rsh => 'ssh', +# dry_run => 1, +}); + +foreach my $export ( @exports ) { + + my $machine = $export->machine; + my $prefix = "$spooldir/$machine"; + + my $bind_rel = $export->option('bind_release'); + my $ndc_cmd = $export->option('reload') + || ( ($bind_rel eq 'BIND9') ? 'rndc' : 'ndc' ); + my $minttl = $export->option('bind9_minttl'); + + #prevent old domain files from piling up + #rmtree "$prefix" or die "can't rmtree $prefix.db: $!"; + + mkdir $prefix, 0700 unless -d $prefix; + + open(NAMED_CONF,">$prefix/named.conf") + or die "can't open $prefix/named.conf: $!"; + + if ( -e "$prefix/named.conf.HEADER" ) { + open(CONF_HEADER,"<$prefix/named.conf.HEADER") + or die "can't open $prefix/named.conf.HEADER: $!"; + while (<CONF_HEADER>) { print NAMED_CONF $_; } + close CONF_HEADER; + } + + my $zonepath = $export->option('zonepath'); + $zonepath =~ s/\/$//; + + my @svc_domain = $export->svc_x; + + foreach my $svc_domain ( @svc_domain ) { + my $domain = $svc_domain->domain; + my @masters = qsearch('domain_record', { + 'svcnum' => $svc_domain->svcnum, + 'rectype' => '_mstr', + } ); + if ( @masters ) { + my $masters = join('; ', map { $_->recdata } @masters ); + + print NAMED_CONF <<END; +zone "$domain" { + type slave; + file "db.$domain"; + masters { $masters; }; +}; + +END + + } else { + + print NAMED_CONF <<END; +zone "$domain" { + type master; + file "$zonepath/db.$domain"; +}; + +END + + open (DB_MASTER,">$prefix/db.$domain") + or die "can't open $prefix/db.$domain: $!"; + + if ($bind_rel eq 'BIND9') { + print DB_MASTER "\$TTL $minttl\n\$ORIGIN $domain.\n"; + } + + my @domain_records = + qsearch('domain_record', { 'svcnum' => $svc_domain->svcnum } ); + foreach my $domain_record ( + sort { $b->rectype cmp $a->rectype } @domain_records + ) { + #if ( $domain_record->rectype eq 'SOA' ) { + # print DB_MASTER join("\t", $domain_record-> reczone + #} else { + print DB_MASTER join("\t", + map { $domain_record->getfield($_) } + qw( reczone recaf rectype recdata ) + ), "\n"; + #} + } + + close DB_MASTER; + + } + + } + + $rsync->exec( { + src => "$prefix/", + recursive => 1, + dest => "root\@$machine:$zonepath/", + exclude => [qw( *.import named.conf.HEADER named.conf )], + } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err); + # warn $rsync->out; + + $rsync->exec( { + src => "$prefix/named.conf", + dest => "root\@$machine:". $export->option('named_conf'), + } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err); +# warn $rsync->out; + + ssh("root\@$machine", "$ndc_cmd reload"); + +} + +close NAMED_CONF; + +foreach my $sexport ( @sexports ) { #false laziness with above + + my $machine = $sexport->machine; + my $prefix = "$spooldir/$machine"; + + my $bind_rel = $sexport->option('bind_release'); + my $ndc_cmd = ($bind_rel eq 'BIND9') ? 'rndc' : 'ndc'; + + #prevent old domain files from piling up + #rmtree "$prefix" or die "can't rmtree $prefix.db: $!"; + + mkdir $prefix, 0700 unless -d $prefix; + + open(NAMED_CONF,">$prefix/named.conf") + or die "can't open $prefix/named.conf: $!"; + + if ( -e "$prefix/named.conf.HEADER" ) { + open(CONF_HEADER,"<$prefix/named.conf.HEADER") + or die "can't open $prefix/named.conf.HEADER: $!"; + while (<CONF_HEADER>) { print NAMED_CONF $_; } + close CONF_HEADER; + } + + my $masters = $sexport->option('master'); + + #false laziness with freeside-sqlradius-reset + my @svc_domain = + map { qsearchs('svc_domain', { 'svcnum' => $_->svcnum } ) } + map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } + grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } + $sexport->export_svc; + + foreach my $svc_domain ( @svc_domain ) { + my $domain = $svc_domain->domain; + print NAMED_CONF <<END; +zone "$domain" { + type slave; + file "db.$domain"; + masters { $masters; }; +}; + +END + + } + + $rsync->exec( { + src => "$prefix/named.conf", + dest => "root\@$machine:". $sexport->option('named_conf'), + } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err); +# warn $rsync->out; + + ssh("root\@$machine", "$ndc_cmd reload"); + +} +close NAMED_CONF; + +# ----- + +sub usage { + die "Usage:\n bind.export user\n"; +} + diff --git a/bin/bind.import b/bin/bind.import new file mode 100755 index 000000000..45db2e210 --- /dev/null +++ b/bin/bind.import @@ -0,0 +1,235 @@ +#!/usr/bin/perl -w +# +# REQUIRED: +# -p: part number for domains +# +# -n: named.conf file (or an include file with zones you want to import), +# for example root@ns.isp.com:/var/named/named.conf +# +# OPTIONAL: +# -d: dry-run, debug: don't insert any records, just dump debugging output +# -e: use existing domains records in Freeside +# -s: import slave zones as master. useful if you need to recreate your +# primary nameserver from a secondary +# -c dir: override patch for downloading zone files (for example, when +# downloading zone files from chrooted bind) +# +# need to manually put header in +# /usr/local/etc/freeside/export.<datasrc./bind/<machine>/named.conf.HEADER +# (or, nowadays, better just to include the file freeside exports) + +use strict; + +use vars qw($domain_svcpart); + +use Getopt::Std; +use Data::Dumper; +#use BIND::Conf_Parser; +#use DNS::ZoneParse 0.81; + +use Net::SCP qw(scp iscp); + +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(qsearch); #qsearchs); +#use FS::svc_acct_sm; +use FS::svc_domain; +use FS::domain_record; +#use FS::svc_acct; +#use FS::part_svc; + +use vars qw($opt_p $opt_n $opt_s $opt_c $opt_d $opt_e); +getopts("p:n:sc:de"); + +my $user = shift or die &usage; +adminsuidsetup $user; + +$FS::svc_Common::noexport_hack = 1; +$FS::domain_record::noserial_hack = 1; + +use vars qw($spooldir); +$spooldir = "/usr/local/etc/freeside/export.". datasrc. "/bind"; +mkdir $spooldir unless -d $spooldir; + +$domain_svcpart = $opt_p; + +my $named_conf = $opt_n; + +use vars qw($named_machine $prefix); +$named_machine = (split(/:/, $named_conf))[0]; +my $pnamed_machine = $named_machine; +$pnamed_machine =~ s/^[\w\-]+\@//; +$prefix = "$spooldir/$pnamed_machine"; +mkdir $prefix unless -d $prefix; + +#iscp("$named_conf","$prefix/named.conf.import"); +scp("$named_conf","$prefix/named.conf.import"); + +## + +$FS::svc_domain::whois_hack=1; + +my $p = Parser->new; +$p->parse_file("$prefix/named.conf.import"); + +print "\nBIND import completed.\n"; + +## + +sub usage { + die "Usage:\n\n bind.import -p partnum -n \"user\@machine:/path/to/named.conf\" [ -s ] [ -c chroot_dir ] [ -d ] [ -e ] user\n"; +} + +######## +BEGIN { + + package Parser; + use BIND::Conf_Parser; + use vars qw(@ISA $named_dir); + @ISA = qw(BIND::Conf_Parser); + + $named_dir = 'COULD_NOT_FIND_NAMED_DIRECTORY_TRY_SETTING_-C_OPTION'; + sub handle_option { + my($self, $option, $argument) = @_; + return unless $option eq "directory"; + $named_dir = $argument; + #warn "found named dir: $named_dir\n"; + } + + sub handle_zone { + my($self, $name, $class, $type, $options) = @_; + return unless $class eq 'in'; + return if grep { $name eq $_ } (qw( + . localhost 127.in-addr.arpa 0.in-addr.arpa 255.in-addr.arpa + 0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa + 0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.int + )); + + use FS::Record qw(qsearchs); + use FS::svc_domain; + + my $domain = + qsearchs('svc_domain', { 'domain' => $name } ) + || new FS::svc_domain( { + svcpart => $main::domain_svcpart, + domain => $name, + action => 'N', + } ); + unless ( $domain->svcnum ) { + my $error = $domain->insert; + die $error if $error; + } + + if ( $type eq 'slave' && !$main::opt_s ) { + + if ( $main::opt_d ) { + + use Data::Dumper; + print "$name: ". Dumper($options); + + } else { + + foreach my $master ( @{ $options->{masters} } ) { + my $domain_record = new FS::domain_record( { + 'svcnum' => $domain->svcnum, + 'reczone' => '@', + 'recaf' => 'IN', + 'rectype' => '_mstr', + 'recdata' => $master, + } ); + my $error = $domain_record->insert; + die $error if $error; + } + + } + + } elsif ( $type eq 'master' || ( $type eq 'slave' && $main::opt_s ) ) { + + my $file = $options->{file}; + + use File::Basename; + my $basefile = basename($file); + my $sourcefile = $file; + if ( $main::opt_c ) { + $sourcefile = "$main::opt_c/$sourcefile" if $main::opt_c; + } else { + $sourcefile = "$named_dir/$sourcefile" unless $file =~ /^\//; + } + + use Net::SCP qw(iscp scp); + #iscp("$main::named_machine:$sourcefile", + # "$main::prefix/$basefile.import"); + scp("$main::named_machine:$sourcefile", + "$main::prefix/$basefile.import"); + + use DNS::ZoneParse 0.84; + my $zone = DNS::ZoneParse->new("$main::prefix/$basefile.import"); + + my $dump = $zone->dump; + + if ( $main::opt_d ) { + + use Data::Dumper; + print "$name: ". Dumper($dump); + + } else { + + foreach my $rectype ( keys %$dump ) { + if ( $rectype =~ /^SOA$/i ) { + my $rec = $dump->{$rectype}; + $rec->{email} =~ s/\@/\./; + my $domain_record = new FS::domain_record( { + 'svcnum' => $domain->svcnum, + 'reczone' => $rec->{origin}, + 'recaf' => 'IN', + 'rectype' => $rectype, + 'recdata' => + $rec->{primary}. ' '. $rec->{email}. ' ( '. + join(' ', map $rec->{$_}, + qw( serial refresh retry expire minimumTTL ) ). + ' )', + } ); + my $error = $domain_record->insert; + die $error if $error; + } else { + #die $dump->{$rectype}; + + my $datasub; + if ( $rectype =~ /^MX$/i ) { + $datasub = sub { $_[0]->{priority}. ' '. $_[0]->{host}; }; + } elsif ( $rectype =~ /^TXT$/i ) { + $datasub = sub { $_[0]->{text}; }; + } else { + $datasub = sub { $_[0]->{host}; }; + } + + foreach my $rec ( @{ $dump->{$rectype} } ) { + my $domain_record = new FS::domain_record( { + 'svcnum' => $domain->svcnum, + 'reczone' => $rec->{name}, + 'recaf' => $rec->{class} || 'IN', + 'rectype' => $rectype, + 'recdata' => &{$datasub}($rec), + } ); + my $error = $domain_record->insert; + if ( $error ) { + warn "$error inserting ". + $rec->{name}. ' . '. $domain->domain. "\n"; + warn Dumper($rec); + #system('cat',"$main::prefix/$basefile.import"); + die; + } + } + } + } + + } + + #} else { + # die "unrecognized type $type\n"; + } + + } + +} +######### + diff --git a/bin/breakdown-bill-applications b/bin/breakdown-bill-applications new file mode 100644 index 000000000..44c3e36b0 --- /dev/null +++ b/bin/breakdown-bill-applications @@ -0,0 +1,25 @@ +#!/usr/bin/perl -w + +use strict; +use FS::UID qw(adminsuidsetup dbh); +use FS::Record qw( qsearch ); +use FS::cust_bill_pay; +use FS::cust_credit_bill; + +$FS::CurrentUser::upgrade_hack = 1; +adminsuidsetup(shift) or die "Usage: breakdown-bill-applications username\n"; + +#quick and dirty conversion script if you have enough memory to throw at it + +my @tables = qw( cust_bill_pay cust_credit_bill ); + +my @apps = (); +foreach my $table { + push @apps, qsearch($table, + + +) { + +} + +foreach my $cust_bill_ diff --git a/bin/bsdshell.export b/bin/bsdshell.export new file mode 100755 index 000000000..6e0d1037e --- /dev/null +++ b/bin/bsdshell.export @@ -0,0 +1,114 @@ +#!/usr/bin/perl -w + +# bsdshell export + +use strict; +use File::Rsync; +use Net::SSH qw(ssh); +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(qsearch qsearchs); +use FS::part_export; +use FS::cust_svc; +use FS::svc_acct; + +my @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $spooldir = "/usr/local/etc/freeside/export.". datasrc; +#my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/shell"; + +my @bsd_exports = qsearch('part_export', { 'exporttype' => 'bsdshell' } ); + +my $rsync = File::Rsync->new({ + rsh => 'ssh', +# dry_run => 1, +}); + +foreach my $export ( @bsd_exports ) { + my $machine = $export->machine; + my $prefix = "$spooldir/$machine"; + mkdir $prefix, 0700 unless -d $prefix; + + #LOCKING!!! + + ( open(MASTER,">$prefix/master.passwd") + #!!! and flock(MASTER,LOCK_EX|LOCK_NB) + ) or die "Can't open $prefix/master.passwd: $!"; + ( open(PASSWD,">$prefix/passwd") + #!!! and flock(PASSWD,LOCK_EX|LOCK_NB) + ) or die "Can't open $prefix/passwd: $!"; + + chmod 0644, "$prefix/passwd"; + chmod 0600, "$prefix/master.passwd"; + + my @svc_acct = $export->svc_x; + + next unless @svc_acct; + + foreach my $svc_acct ( sort { $a->uid <=> $b->uid } @svc_acct ) { + + my $password = $svc_acct->_password; + my $cpassword; + #if ( ( length($password) <= 8 ) + if ( ( length($password) <= 12 ) + && ( $password ne '*' ) + && ( $password ne '!!' ) + && ( $password ne '' ) + ) { + $cpassword=crypt($password, + $saltset[int(rand(64))].$saltset[int(rand(64))] + ); + # MD5 !!!! + } else { + $cpassword=$password; + } + + ### + # FORMAT OF THE PASSWD FILE HERE + print PASSWD join(":", + $svc_acct->username, + 'x', # "##". $username, + $svc_acct->uid, + $svc_acct->gid, + $svc_acct->finger, + $svc_acct->dir, + $svc_acct->shell, + ), "\n"; + + ### + # FORMAT OF FreeBSD MASTER PASSWD FILE HERE + print MASTER join(":", + $svc_acct->username, # User name + $cpassword, # Encrypted password + $svc_acct->uid, # User ID + $svc_acct->gid, # Group ID + "", # Login Class + "0", # Password Change Time + "0", # Password Expiration Time + $svc_acct->finger, # Users name + $svc_acct->dir, # Users home directory + $svc_acct->shell, # shell + ), "\n" ; + + } + + #!!! flock(MASTER,LOCK_UN); + #!!! flock(PASSWD,LOCK_UN); + close MASTER; + close PASSWD; + + $rsync->exec( { + src => "$prefix/passwd", + dest => "root\@$machine:/etc/passwd" + } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err); + + $rsync->exec( { + src => "$prefix/master.passwd", + dest => "root\@$machine:/etc/master.passwd.new" + } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err); + ssh("root\@$machine", "pwd_mkdb /etc/master.passwd.new"); + + # UNLOCK!! +} diff --git a/bin/cch_tax_tool b/bin/cch_tax_tool new file mode 100755 index 000000000..6261363d6 --- /dev/null +++ b/bin/cch_tax_tool @@ -0,0 +1,59 @@ +#!/usr/bin/perl -w + +use strict; + +# this tool manipulates fixed length cch tax files by comparing the +# update files in the $update_dir to the initial install files +# in the $init_dir +# +# it produces .DOIT files in $update_dir which are suitable for +# syncing a database initialzed with the files in $init_dir to +# the state represented by the files in $update_dir +# +# how one acquires update files from cch that overlap with initial +# full install remains a mystery + +my $init_dir = "cchinit/"; +my $update_dir = "cchupdate/"; + +foreach my $file (qw (CODE DETAIL PLUS4 GEOCODE TXMATRIX ZIP)) { + my $tfile = $update_dir. $file. "T"; + $tfile = $update_dir. "TXMATRIT" if $tfile =~ /TXMATRIXT$/; + open FILE, "$tfile.TXT" or die "Can't open $tfile.TXT\n"; + open INSERT, ">$tfile.INS" or die "Can't open $tfile.INS\n"; + open DELETE, ">$tfile.DEL" or die "Can't open $tfile.DEL\n"; + while(<FILE>){ + chomp; + print INSERT "$_\n" if s/I$//; + print DELETE "$_\n" if s/D$//; + } + close FILE; + close INSERT; + close DELETE; + system "sort $tfile.INS > $tfile.INSSORT"; + system "sort $tfile.DEL > $tfile.DELSORT"; + system "sort $init_dir$file.txt > $tfile.ORGINSSORT"; + system "comm -12 $tfile.INSSORT $tfile.ORGINSSORT > $tfile.PREINS"; + system "comm -23 $tfile.INSSORT $tfile.ORGINSSORT > $tfile.2BEINS"; + system "comm -23 $tfile.DELSORT $tfile.ORGINSSORT > $tfile.PREDEL"; + system "comm -12 $tfile.DELSORT $tfile.ORGINSSORT > $tfile.2BEDEL"; +} + +foreach my $file (qw (CODET DETAILT PLUS4T GEOCODET TXMATRIT ZIPT)) { + my $tfile = $update_dir. $file; + $tfile = "TXMATRIT" if $tfile eq "TXMATRIXT"; + open INSERT, "$tfile.2BEINS" or die "Can't open $tfile.2BEINS\n"; + open DELETE, "$tfile.2BEDEL" or die "Can't open $tfile.2BEDEL\n"; + open FILE, ">$tfile.DOIT" or die "Can't open $tfile.DOIT\n"; + while(<INSERT>){ + chomp; + print FILE $_, "I\n"; + } + while(<DELETE>){ + chomp; + print FILE $_, "D\n"; + } + close FILE; + close INSERT; + close DELETE; +} diff --git a/bin/cdr-netsapiens.import b/bin/cdr-netsapiens.import new file mode 100755 index 000000000..8aa4ac0b7 --- /dev/null +++ b/bin/cdr-netsapiens.import @@ -0,0 +1,237 @@ +#!/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 new file mode 100755 index 000000000..b9fe41ab1 --- /dev/null +++ b/bin/cdr-transnexus.import @@ -0,0 +1,143 @@ +#!/usr/bin/perl + +use strict; +use Getopt::Std; +use Net::SFTP::Foreign; +use FS::UID qw(adminsuidsetup datasrc); +use FS::cdr; + +### +# parse command line +### + +use vars qw( $opt_p $opt_d $opt_v ); +getopts('v'); + +$opt_p = 'last'; +$opt_d = 'done'; + +my $user = shift or die &usage; +adminsuidsetup $user; + +# %%%FREESIDE_CACHE%%% +my $cachedir = '/usr/local/etc/freeside/cache.'. datasrc. '/cdrs'; +mkdir $cachedir unless -d $cachedir; + +#my $format = shift or die &usage; +my $format = 'transnexus'; + +use vars qw( $servername ); +$servername = shift or die &usage; + +my $DIR = '/home/ossadmin/OSS/nexoss/CDR_ARCHIVE_BY_ACCOUNT'; + +### +# get the file list +### + +warn "Retreiving directory listing\n" if $opt_v; + +my $ls_sftp = sftp(); + +my $lsdir = $ls_sftp->ls($DIR); + +### +# import each file in each dir +### + +foreach my $dir ( @$lsdir ) { + + my $dirname = $dir->{filename}; + warn "Scanning dir $dirname\n" if $opt_v; + + #my $ls = $ls_sftp->ls("$DIR/$dirname", wanted => qr/^$opt_p.*-CDRs$/i ); + my $ls = $ls_sftp->ls("$DIR/$dirname", wanted => qr/^$opt_p.*Customer-CDRs$/i ); + + foreach my $file ( @$ls ) { + + my $filename = $file->{filename}; + warn "Downloading $filename\n" if $opt_v; + + #get the file + my $get_sftp = sftp(); + $get_sftp->get("$DIR/$dirname/$filename", "$cachedir/$filename") + or die "Can't get $filename: ". $get_sftp->error; + + warn "Processing $filename\n" if $opt_v; + + my $error = FS::cdr::batch_import( { + 'file' => "$cachedir/$filename", + 'format' => $format, + '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 new file mode 100755 index 000000000..8910eece6 --- /dev/null +++ b/bin/cdr.http_and_import @@ -0,0 +1,108 @@ +#!/usr/bin/perl +# +# Usage: +# cdr.http_and_import [ -p prefix ] [ -e extension ] [ -v ] user format URL +# +# -e: file extension, defaults to .csv +# -d: if specified, moves files to the specified folder when done + +use strict; +use Getopt::Std; +use WWW::IndexParser; +#use LWP::UserAgent; +use FS::UID qw(adminsuidsetup datasrc dbh); +use FS::cdr; + +### +# parse command line +### + +use vars qw( $opt_p $opt_e $opt_v ); +getopts('p:e:v'); + +$opt_e ||= 'csv'; +#$opt_e = ".$opt_e" unless $opt_e =~ /^\./; +$opt_e =~ s/^\.//; + +my $user = shift or die &usage; +adminsuidsetup $user; + +# %%%FREESIDE_CACHE%%% +my $cachedir = '/usr/local/etc/freeside/cache.'. datasrc. '/cdrs'; +mkdir $cachedir unless -d $cachedir; + +my $format = shift or die &usage; + +use vars qw( $URL ); +$URL = shift or die &usage; + +### +# get the file list +### + +warn "Retreiving directory listing\n" if $opt_v; + +my @files = WWW::IndexParser->new(url => $URL); + +### +# import each file +### + +foreach my $file ( @files ) { + + my $filename = $file->{filename}; + + if ( $opt_p ) { next unless $filename =~ /^$opt_p/ }; + if ( $opt_e ) { next unless $filename =~ /\.$opt_e$/i }; + + #check and see if we've gotten this file already!!! + #just going to cheat with filenames in the cache for now + if ( -e "$cachedir/$filename" ) { + warn "Already have unprocessed $cachedir/$filename; skipping\n"; # if $opt_v; + next; + } + if ( -e "$cachedir/$filename.DONE" ) { + warn "Already processed $cachedir/$filename; skipping\n" if $opt_v; + next; + } + + warn "Downloading $filename\n" if $opt_v; + + #get the file + + my $ua = LWP::UserAgent->new; + my $response = $ua->get("$URL/$filename"); + + unless ( $response->is_success ) { + die "Error retreiving $URL/$filename: ". $response->status_line; + } + + open(FILE, ">$cachedir/$filename") + or die "can't open $cachedir/$filename: $!"; + print FILE $response->content; + close FILE or die "can't close $cachedir/$filename: $!"; + + warn "Processing $filename\n" if $opt_v; + + my $error = FS::cdr::batch_import( { + 'file' => "$cachedir/$filename", + 'format' => $format, + '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 new file mode 100644 index 000000000..36266efbf --- /dev/null +++ b/bin/cdr.import @@ -0,0 +1,28 @@ +#!/usr/bin/perl +# +# Usage: +# cdr.import user format filename +# + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::cdr; + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $format = shift or die &usage; + +my $file = shift; + +my $error = FS::cdr::batch_import( { + 'file' => $file, + 'format' => $format, + '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 new file mode 100755 index 000000000..a998284f6 --- /dev/null +++ b/bin/cdr_calltype.import @@ -0,0 +1,41 @@ +#!/usr/bin/perl -w +# +# bin/cdr_calltype.import ivan ~ivan/convergent/newspecs/fixed_inbound/calltypes.csv + +use strict; +use FS::UID qw(dbh adminsuidsetup); +use FS::cdr_calltype; + +my $user = shift or die &usage; +adminsuidsetup $user; + +while (<>) { + + chomp; + my $line = $_; + + #$line =~ /^(\d+),"([^"]+)"$/ or do { + $line =~ /^(\d+),"([^"]+)"/ or do { + warn "unparsable line: $line\n"; + next; + }; + + my $cdr_calltype = new FS::cdr_calltype { + 'calltypenum' => $1, + 'calltypename' => $2, + }; + + #my $error = $cdr_calltype->check; + my $error = $cdr_calltype->insert; + if ( $error ) { + warn "********** $error FOR LINE: $line\n"; + dbh->commit; + #my $wait = scalar(<STDIN>); + } + +} + +sub usage { + "Usage:\n\ncdr_calltype.import username filename ...\n"; +} + diff --git a/bin/cdr_upstream_rate.import b/bin/cdr_upstream_rate.import new file mode 100755 index 000000000..fda3883b5 --- /dev/null +++ b/bin/cdr_upstream_rate.import @@ -0,0 +1,142 @@ +#!/usr/bin/perl -w +# +# Usage: bin/cdr_upstream_rate.import username ratenum filename +# +# records will be imported into cdr_upstream_rate, rate_detail and rate_region +# +# Example: bin/cdr_upstream_rate.import ivan 1 ~ivan/convergent/sample_rate_table.csv +# +# username: a freeside login (from /usr/local/etc/freeside/mapsecrets) +# ratenum: rate plan (FS::rate) created with the web UI +# filename: CSV file +# +# the following fields are currently used: +# - Class Code => cdr_upstream_rate.rateid +# - Description => rate_region.regionname +# (rate_detail->dest_region) +# - 1_rate => ( * 60 / 1_rate_seconds ) => rate_detail.min_charge +# - 1_rate_seconds => (used above) +# - 1_second_increment => rate_detail.sec_granularity +# +# the following fields are not (yet) used: +# - Flagfall => what's this for? +# +# - 1_cap_time => freeside doesn't have voip time caps yet... +# - 1_cap_cost => freeside doesn't have voip cost caps yet... +# - 1_repeat => not sure what this is for, sample data is all 0 +# +# - 2_rate => \ +# - 2_rate_seconds => | +# - 2_second_increment => | not sure what the second set of rate data +# - 2_cap_time => | is supposed to be for... +# - 2_cap_cost => | +# - 2_repeat => / +# +# - Carrier => probably not needed? +# - Start Date => not necessary? + +use strict; +use vars qw( $DEBUG ); +use Text::CSV_XS; +use FS::UID qw(dbh adminsuidsetup); +use FS::Record qw(qsearchs); +use FS::rate; +use FS::cdr_upstream_rate; +use FS::rate_detail; +use FS::rate_region; + +$DEBUG = 1; + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $ratenum = shift or die &usage; + +my $rate = qsearchs( 'rate', { 'ratenum' => $ratenum } ); +die "rate plan $ratenum not found in rate table\n" + unless $rate; + +my $csv = new Text::CSV_XS; +my $hline = scalar(<>); +chomp($hline); +$csv->parse($hline) or die "can't parse header: $hline\n"; +my @header = $csv->fields(); + +$FS::UID::AutoCommit = 0; + +while (<>) { + + chomp; + my $line = $_; + +# #$line =~ /^(\d+),"([^"]+)"$/ or do { +# #} +# $line =~ /^(\d+),"([^"]+)"/ or do { +# warn "unparsable line: $line\n"; +# next; +# }; + + $csv->parse($line) or die "can't parse line: $line\n"; + my @line = $csv->fields(); + + my %hash = map { $_ => shift(@line) } @header; + + warn join('', map { "$_ => $hash{$_}\n" } keys %hash ) + if $DEBUG > 1; + + my $rate_region = new FS::rate_region { + 'regionname' => $hash{'Description'} + }; + + my $error = $rate_region->insert; + if ( $error ) { + dbh->rollback; + die "error inserting into rate_region: $error\n"; + } + my $dest_regionnum = $rate_region->regionnum; + warn "rate_region $dest_regionnum inserted\n" + if $DEBUG; + + my $rate_detail = new FS::rate_detail { + 'ratenum' => $ratenum, + 'dest_regionnum' => $dest_regionnum, + 'min_included' => 0, + #'min_charge', => sprintf('%.5f', 60 * $hash{'1_rate'} / $hash{'1_rate_seconds'} ), + 'min_charge', => sprintf('%.5f', $hash{'1_rate'} / + ( $hash{'1_rate_seconds'} / 60 ) + ), + 'sec_granularity' => $hash{'1_second_increment'}, + }; + $error = $rate_detail->insert; + if ( $error ) { + dbh->rollback; + die "error inserting into rate_detail: $error\n"; + } + my $ratedetailnum = $rate_detail->ratedetailnum; + warn "rate_detail $ratedetailnum inserted\n" + if $DEBUG; + + my $cdr_upstream_rate = new FS::cdr_upstream_rate { + 'upstream_rateid' => $hash{'Class Code'}, + 'ratedetailnum' => $rate_detail->ratedetailnum, + }; + $error = $cdr_upstream_rate->insert; + if ( $error ) { + dbh->rollback; + die "error inserting into cdr_upstream_rate: $error\n"; + } + warn "cdr_upstream_rate ". $cdr_upstream_rate->upstreamratenum. " inserted\n" + if $DEBUG; + + dbh->commit or die "can't commit: ". dbh->errstr; + + warn "\n" if $DEBUG; + +} + +dbh->commit or die "can't commit: ". dbh->errstr; + +sub usage { + "Usage:\n\ncdr_upstream_rate.import username ratenum filename\n"; +} + diff --git a/bin/confdiff b/bin/confdiff new file mode 100755 index 000000000..5b6af859e --- /dev/null +++ b/bin/confdiff @@ -0,0 +1,27 @@ +#!/usr/bin/perl + +use FS::UID qw(adminsuidsetup); +use FS::Conf; + +adminsuidsetup('ivan'); + +my $conf = new FS::Conf; + +my $file2 = pop @ARGV; +my $file1 = pop @ARGV; + +open(FILE1, ">/tmp/$file1") or die "can't open /tmp/$file1: $!"; +print FILE1 $conf->config($file1); +print FILE1 "\n"; +close FILE1 or die $!; + +open(FILE2, ">/tmp/$file2") or die "can't open /tmp/$file2: $!"; +print FILE2 $conf->config($file2); +print FILE2 "\n"; +close FILE2 or die $!; + +my @opt = @ARGV; + +system('diff', @opt, "/tmp/$file1", "/tmp/$file2"); + +#unlink("/tmp/$file1', "/tmp/$file2"); diff --git a/bin/countdeclines b/bin/countdeclines new file mode 100755 index 000000000..bbc392560 --- /dev/null +++ b/bin/countdeclines @@ -0,0 +1,22 @@ +#!/usr/bin/perl + +use Date::Parse; + +my $e = 'PlugnPay error: 97: Declined for CVV failure'; +my @y = (2008,2009); + +my $p = 0; + +foreach my $y (@y) { + foreach my $m (1..12) { + my $d = "$m/1/$y"; + my $t = str2time($d); + + #print "$pd-$d: SELECT count(*) from cust_bill_event where statustext = '$e' and _date >= $p and _date < $t;\n" + print "SELECT count(*) from cust_bill_event where statustext = '$e' and _date >= $p and _date < $t;\n" + if $p; + + $p = $t; + $pd = $d; + } +} diff --git a/bin/create-fetchmailrc b/bin/create-fetchmailrc new file mode 100644 index 000000000..11bde0ce3 --- /dev/null +++ b/bin/create-fetchmailrc @@ -0,0 +1,47 @@ +#!/usr/bin/perl -w +# this quick hack helps you generate/maintain .fetchmailrc files from +# FS::acct_snarf data. it is run from a shellcommands export as: +# create-fetchmailrc $username $dir $snarf_machine1 $snarf_username1 $snarf__password1 $snarf_machine2 $snarf_username2 $snarf__password2 ... + +use strict; +use POSIX qw( setuid setgid ); + +my $header = <<END; +# Configuration created by create-fetchmailrc +set postmaster "postmaster" +set bouncemail +set no spambounce +set properties "" +set daemon 240 +END + +my $username = shift @ARGV or die "no username specified\n"; +my $homedir = shift @ARGV or die "no homedir specified\n"; +my $filename = "$homedir/.fetchmailrc"; + +my $gid = scalar(getgrnam($username)) or die "can't find $username's gid\n"; +my $uid = scalar(getpwnam($username)) or die "can't find $username's uid\n"; + +exit unless $ARGV[0]; + +open(FETCHMAILRC, ">$filename") or die "can't open $filename: $!\n"; +chown $uid, $gid, $filename or die "can't chown $uid.$gid $filename: $!\n"; +chmod 0600, $filename or die "can't chmod 600 $filename: $!\n"; +print FETCHMAILRC $header; + +while ($ARGV[0]) { + my( $s_machine, $s_username, $s_password ) = splice( @ARGV, 0, 3 ); + print FETCHMAILRC <<END; +poll $s_machine + user '$s_username' there with password '$s_password' is '$username' here +END +} + +close FETCHMAILRC; + +setgid($gid) or die "can't setgid $gid\n"; +setuid($uid) or die "can't setuid $uid\n"; +$ENV{HOME} = $homedir; + +system(qq(fetchmail -a -K --antispam "550,451" -d 180 -f $filename)); + diff --git a/bin/cust_main_special.pm b/bin/cust_main_special.pm new file mode 100644 index 000000000..967b6be19 --- /dev/null +++ b/bin/cust_main_special.pm @@ -0,0 +1,608 @@ +package cust_main_special; + +require 5.006; +use strict; +use vars qw( @ISA $DEBUG $me $conf ); +use Safe; +use Carp; +use Data::Dumper; +use Date::Format; +use FS::UID qw( dbh ); +use FS::Record qw( qsearchs qsearch ); +use FS::payby; +use FS::cust_pkg; +use FS::cust_bill; +use FS::cust_bill_pkg; +use FS::cust_bill_pkg_display; +use FS::cust_bill_pkg_tax_location; +use FS::cust_main_county; +use FS::cust_location; +use FS::tax_rate; +use FS::cust_tax_location; +use FS::part_pkg_taxrate; +use FS::queue; +use FS::part_pkg; + +@ISA = qw ( FS::cust_main ); + +$DEBUG = 0; +$me = '[emergency billing program]'; + +$conf = new FS::Conf; + +=head1 METHODS + +=over 4 + +=item bill OPTIONS + +Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in +conjunction with the collect method by calling B<bill_and_collect>. + +If there is an error, returns the error, otherwise returns false. + +Options are passed as name-value pairs. Currently available options are: + +=over 4 + +=item resetup + +If set true, re-charges setup fees. + +=item time + +Bills the customer as if it were that time. Specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions. For example: + + use Date::Parse; + ... + $cust_main->bill( 'time' => str2time('April 20th, 2001') ); + +=item pkg_list + +An array ref of specific packages (objects) to attempt billing, instead trying all of them. + + $cust_main->bill( pkg_list => [$pkg1, $pkg2] ); + +=item invoice_time + +Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices. Other calculations, such as whether or not to generate the invoice in the first place, are not affected. + +=item backbill + +Used to specify the period starting date and preventing normal billing. Instead all outstanding cdrs/usage are processed as if from the unix timestamp in backbill and without changing the dates in the customer packages. Useful in those situations when cdrs were not imported before a billing run + +=back + +=cut + +sub bill { + my( $self, %options ) = @_; + + bless $self, 'cust_main_special'; + return '' if $self->payby eq 'COMP'; + warn "$me backbill usage for customer ". $self->custnum. "\n" + if $DEBUG; + + my $time = $options{'time'} || time; + my $invoice_time = $options{'invoice_time'} || $time; + + #put below somehow? + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + $self->select_for_update; #mutex + + my @cust_bill_pkg = (); + + ### + # find the packages which are due for billing, find out how much they are + # & generate invoice database. + ### + + my( $total_setup, $total_recur, $postal_charge ) = ( 0, 0, 0 ); + my %taxlisthash; + my @precommit_hooks = (); + + my @cust_pkgs = qsearch('cust_pkg', { 'custnum' => $self->custnum } ); + foreach my $cust_pkg (@cust_pkgs) { + + #NO!! next if $cust_pkg->cancel; + next if $cust_pkg->getfield('cancel'); + + warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1; + + #? to avoid use of uninitialized value errors... ? + $cust_pkg->setfield('bill', '') + unless defined($cust_pkg->bill); + + #my $part_pkg = $cust_pkg->part_pkg; + + my $real_pkgpart = $cust_pkg->pkgpart; + my %hash = $cust_pkg->hash; + + foreach my $part_pkg ( $cust_pkg->part_pkg->self_and_bill_linked ) { + + $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill ); + + my $error = + $self->_make_lines( 'part_pkg' => $part_pkg, + 'cust_pkg' => $cust_pkg, + 'precommit_hooks' => \@precommit_hooks, + 'line_items' => \@cust_bill_pkg, + 'setup' => \$total_setup, + 'recur' => \$total_recur, + 'tax_matrix' => \%taxlisthash, + 'time' => $time, + 'options' => \%options, + ); + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + } #foreach my $part_pkg + + } #foreach my $cust_pkg + + unless ( @cust_bill_pkg ) { #don't create an invoice w/o line items + unless ( $options{backbill} ) { + #but do commit any package date cycling that happened + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + } else { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + } + return ''; + } + + my $postal_pkg = $self->charge_postal_fee(); + if ( $postal_pkg && !ref( $postal_pkg ) ) { + $dbh->rollback if $oldAutoCommit; + return "can't charge postal invoice fee for customer ". + $self->custnum. ": $postal_pkg"; + } + if ( !$options{backbill} && $postal_pkg && + ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) || + !$conf->exists('postal_invoice-recurring_only') + ) + ) + { + foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) { + my $error = + $self->_make_lines( 'part_pkg' => $part_pkg, + 'cust_pkg' => $postal_pkg, + 'precommit_hooks' => \@precommit_hooks, + 'line_items' => \@cust_bill_pkg, + 'setup' => \$total_setup, + 'recur' => \$total_recur, + 'tax_matrix' => \%taxlisthash, + 'time' => $time, + 'options' => \%options, + ); + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + + warn "having a look at the taxes we found...\n" if $DEBUG > 2; + + # keys are tax names (as printed on invoices / itemdesc ) + # values are listrefs of taxlisthash keys (internal identifiers) + my %taxname = (); + + # keys are taxlisthash keys (internal identifiers) + # values are (cumulative) amounts + my %tax = (); + + # keys are taxlisthash keys (internal identifiers) + # values are listrefs of cust_bill_pkg_tax_location hashrefs + my %tax_location = (); + + foreach my $tax ( keys %taxlisthash ) { + my $tax_object = shift @{ $taxlisthash{$tax} }; + warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2; + warn " ". join('/', @{ $taxlisthash{$tax} } ). "\n" if $DEBUG > 2; + my $hashref_or_error = + $tax_object->taxline( $taxlisthash{$tax}, + 'custnum' => $self->custnum, + 'invoice_time' => $invoice_time + ); + unless ( ref($hashref_or_error) ) { + $dbh->rollback if $oldAutoCommit; + return $hashref_or_error; + } + unshift @{ $taxlisthash{$tax} }, $tax_object; + + my $name = $hashref_or_error->{'name'}; + my $amount = $hashref_or_error->{'amount'}; + + #warn "adding $amount as $name\n"; + $taxname{ $name } ||= []; + push @{ $taxname{ $name } }, $tax; + + $tax{ $tax } += $amount; + + $tax_location{ $tax } ||= []; + if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) { + push @{ $tax_location{ $tax } }, + { + 'taxnum' => $tax_object->taxnum, + 'taxtype' => ref($tax_object), + 'pkgnum' => $tax_object->get('pkgnum'), + 'locationnum' => $tax_object->get('locationnum'), + 'amount' => sprintf('%.2f', $amount ), + }; + } + + } + + #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit + my %packagemap = map { $_->pkgnum => $_ } @cust_bill_pkg; + foreach my $tax ( keys %taxlisthash ) { + foreach ( @{ $taxlisthash{$tax} }[1 ... scalar(@{ $taxlisthash{$tax} })] ) { + next unless ref($_) eq 'FS::cust_bill_pkg'; + + push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg }, + splice( @{ $_->_cust_tax_exempt_pkg } ); + } + } + + #consolidate and create tax line items + warn "consolidating and generating...\n" if $DEBUG > 2; + foreach my $taxname ( keys %taxname ) { + my $tax = 0; + my %seen = (); + my @cust_bill_pkg_tax_location = (); + warn "adding $taxname\n" if $DEBUG > 1; + foreach my $taxitem ( @{ $taxname{$taxname} } ) { + next if $seen{$taxitem}++; + warn "adding $tax{$taxitem}\n" if $DEBUG > 1; + $tax += $tax{$taxitem}; + push @cust_bill_pkg_tax_location, + map { new FS::cust_bill_pkg_tax_location $_ } + @{ $tax_location{ $taxitem } }; + } + next unless $tax; + + $tax = sprintf('%.2f', $tax ); + $total_setup = sprintf('%.2f', $total_setup+$tax ); + + push @cust_bill_pkg, new FS::cust_bill_pkg { + 'pkgnum' => 0, + 'setup' => $tax, + 'recur' => 0, + 'sdate' => '', + 'edate' => '', + 'itemdesc' => $taxname, + 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location, + }; + + } + + my $charged = sprintf('%.2f', $total_setup + $total_recur ); + + #create the new invoice + my $cust_bill = new FS::cust_bill ( { + 'custnum' => $self->custnum, + '_date' => ( $invoice_time ), + 'charged' => $charged, + } ); + my $error = $cust_bill->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't create invoice for customer #". $self->custnum. ": $error"; + } + + foreach my $cust_bill_pkg ( @cust_bill_pkg ) { + $cust_bill_pkg->invnum($cust_bill->invnum); + my $error = $cust_bill_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't create invoice line item: $error"; + } + } + + + #foreach my $hook ( @precommit_hooks ) { + # eval { + # &{$hook}; #($self) ? + # }; + # if ( $@ ) { + # $dbh->rollback if $oldAutoCommit; + # return "$@ running precommit hook $hook\n"; + # } + #} + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; #no error +} + + +sub _make_lines { + my ($self, %params) = @_; + + warn " making lines\n" if $DEBUG > 1; + my $part_pkg = $params{part_pkg} or die "no part_pkg specified"; + my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified"; + my $precommit_hooks = $params{precommit_hooks} or die "no package specified"; + my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified"; + my $total_setup = $params{setup} or die "no setup accumulator specified"; + my $total_recur = $params{recur} or die "no recur accumulator specified"; + my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified"; + my $time = $params{'time'} or die "no time specified"; + my (%options) = %{$params{options}}; + + my $dbh = dbh; + my $real_pkgpart = $cust_pkg->pkgpart; + my %hash = $cust_pkg->hash; + my $old_cust_pkg = new FS::cust_pkg \%hash; + my $backbill = $options{backbill} || 0; + + my @details = (); + + my $lineitems = 0; + + $cust_pkg->pkgpart($part_pkg->pkgpart); + + ### + # bill setup + ### + + my $setup = 0; + my $unitsetup = 0; + if ( ! $cust_pkg->setup && + ( + ( $conf->exists('disable_setup_suspended_pkgs') && + ! $cust_pkg->getfield('susp') + ) || ! $conf->exists('disable_setup_suspended_pkgs') + ) + || $options{'resetup'} + ) { + + warn " bill setup\n" if $DEBUG > 1; + $lineitems++; + + $setup = eval { $cust_pkg->calc_setup( $time, \@details ) }; + return "$@ running calc_setup for $cust_pkg\n" + if $@; + + $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh + + $cust_pkg->setfield('setup', $time) + unless $cust_pkg->setup; + #do need it, but it won't get written to the db + #|| $cust_pkg->pkgpart != $real_pkgpart; + + } + + ### + # bill recurring fee + ### + + #XXX unit stuff here too + my $recur = 0; + my $unitrecur = 0; + my $sdate; + if ( ! $cust_pkg->getfield('susp') and + ( $part_pkg->getfield('freq') ne '0' && + ( $cust_pkg->getfield('bill') || 0 ) <= $time + ) + || ( $part_pkg->plan eq 'voip_cdr' + && $part_pkg->option('bill_every_call') + ) + || $backbill + ) { + + # XXX should this be a package event? probably. events are called + # at collection time at the moment, though... + $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG) + if $part_pkg->can('reset_usage'); + #don't want to reset usage just cause we want a line item?? + #&& $part_pkg->pkgpart == $real_pkgpart; + + warn " bill recur\n" if $DEBUG > 1; + $lineitems++; + + # XXX shared with $recur_prog + $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; + $sdate = $cust_pkg->lastbill || $backbill if $backbill; + + #over two params! lets at least switch to a hashref for the rest... + my $increment_next_bill = ( $part_pkg->freq ne '0' + && ( $cust_pkg->getfield('bill') || 0 ) <= $time + ); + my %param = ( 'precommit_hooks' => $precommit_hooks, + 'increment_next_bill' => $increment_next_bill, + ); + + $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) }; + return "$@ running calc_recur for $cust_pkg\n" + if ( $@ ); + + + warn "details is now: \n" if $DEBUG > 2; + warn Dumper(\@details) if $DEBUG > 2; + + if ( $increment_next_bill ) { + + my $next_bill = $part_pkg->add_freq($sdate); + return "unparsable frequency: ". $part_pkg->freq + if $next_bill == -1; + + #pro-rating magic - if $recur_prog fiddled $sdate, want to use that + # only for figuring next bill date, nothing else, so, reset $sdate again + # here + $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; + $sdate = $cust_pkg->lastbill || $backbill if $backbill; + #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill; + $cust_pkg->last_bill($sdate); + + $cust_pkg->setfield('bill', $next_bill ); + + } + + } + + warn "\$setup is undefined" unless defined($setup); + warn "\$recur is undefined" unless defined($recur); + warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill); + + ### + # If there's line items, create em cust_bill_pkg records + # If $cust_pkg has been modified, update it (if we're a real pkgpart) + ### + + if ( $lineitems ) { + + if ( !$backbill && $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) { + # hmm.. and if just the options are modified in some weird price plan? + + warn " package ". $cust_pkg->pkgnum. " modified; updating\n" + if $DEBUG >1; + + my $error = $cust_pkg->replace( $old_cust_pkg, + 'options' => { $cust_pkg->options }, + ); + return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error" + if $error; #just in case + } + + my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I'); + if ( $DEBUG > 1 ) { + warn " tentatively adding customer package invoice detail: $_\n" + foreach @cust_pkg_detail; + } + push @details, @cust_pkg_detail; + + $setup = sprintf( "%.2f", $setup ); + $recur = sprintf( "%.2f", $recur ); + my $cust_bill_pkg = new FS::cust_bill_pkg { + 'pkgnum' => $cust_pkg->pkgnum, + 'setup' => $setup, + 'unitsetup' => $unitsetup, + 'recur' => $recur, + 'unitrecur' => $unitrecur, + 'quantity' => $cust_pkg->quantity, + 'details' => \@details, + }; + + warn "created cust_bill_pkg which looks like:\n" if $DEBUG > 2; + warn Dumper($cust_bill_pkg) if $DEBUG > 2; + if ($backbill) { + my %usage_cust_bill_pkg = $cust_bill_pkg->disintegrate; + $recur = 0; + foreach my $key (keys %usage_cust_bill_pkg) { + next if ($key eq 'setup' || $key eq 'recur'); + $recur += $usage_cust_bill_pkg{$key}->recur; + } + $setup = 0; + } + + $setup = sprintf( "%.2f", $setup ); + $recur = sprintf( "%.2f", $recur ); + if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) { + return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum; + } + if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) { + return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum; + } + + + if ( $setup != 0 || $recur != 0 ) { + + warn " charges (setup=$setup, recur=$recur); adding line items\n" + if $DEBUG > 1; + + $cust_bill_pkg->setup($setup); + $cust_bill_pkg->recur($recur); + + warn "cust_bill_pkg now looks like:\n" if $DEBUG > 2; + warn Dumper($cust_bill_pkg) if $DEBUG > 2; + + if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) { + $cust_bill_pkg->sdate( $hash{last_bill} ); + $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1 + } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) { + $cust_bill_pkg->sdate( $sdate ); + $cust_bill_pkg->edate( $cust_pkg->bill ); + } + + $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart) + unless $part_pkg->pkgpart == $real_pkgpart; + + $$total_setup += $setup; + $$total_recur += $recur; + + ### + # handle taxes + ### + + my $error = + $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}); + return $error if $error; + + push @$cust_bill_pkgs, $cust_bill_pkg; + + } #if $setup != 0 || $recur != 0 + + } #if $line_items + + ''; + +} + + +sub _gather_taxes { + my $self = shift; + my $part_pkg = shift; + my $class = shift; + + my @taxes = (); + my $geocode = $self->geocode('cch'); + + my @taxclassnums = map { $_->taxclassnum } + $part_pkg->part_pkg_taxoverride($class); + + unless (@taxclassnums) { + @taxclassnums = map { $_->taxclassnum } + $part_pkg->part_pkg_taxrate('cch', $geocode, $class); + } + warn "Found taxclassnum values of ". join(',', @taxclassnums) + if $DEBUG; + + my $extra_sql = + "AND (". + join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")"; + + @taxes = grep { ($_->fee || 0 ) == 0 } #ignore unit based taxes + qsearch({ 'table' => 'tax_rate', + 'hashref' => { 'geocode' => $geocode, }, + 'extra_sql' => $extra_sql, + }) + if scalar(@taxclassnums); + + warn "Found taxes ". + join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n" + if $DEBUG; + + [ @taxes ]; + +} + + +=back + + +=cut + +1; + diff --git a/bin/cust_pay_histogram b/bin/cust_pay_histogram new file mode 100755 index 000000000..714b32140 --- /dev/null +++ b/bin/cust_pay_histogram @@ -0,0 +1,115 @@ +#!/usr/bin/perl -w + +use strict; +use Getopt::Std; +use Date::Parse; +use FS::UID qw(adminsuidsetup); +use FS::Record qw( qsearch ); +use FS::cust_pay; + +&untaint_argv; #what it sounds like (eww) +use vars qw(%opt); +getopts("p:a:b:e:", \%opt); + +my $user = shift or die &usage; +my $dbh = adminsuidsetup $user; + +my @where = (); + +push @where, 'agentnum = '. $dbh->quote($opt{a}) if $opt{a}; +push @where, 'cust_pay.payby = '. $dbh->quote($opt{p}) if $opt{p}; +push @where, 'cust_pay._date > '. $dbh->quote(str2time($opt{b})) if $opt{b}; +push @where, 'cust_pay._date < '. $dbh->quote(str2time($opt{e})) if $opt{e}; + +my $extra_sql = scalar(@where) ? 'WHERE '. join(' AND ', @where) : ''; +my $addl_from = 'LEFT JOIN cust_main USING( custnum )'; + +my @payrow = qsearch( { table => 'cust_pay', + hashref => {}, + select => 'count(*) AS quantity, paid', + addl_from => $addl_from, + extra_sql => $extra_sql, + order_by => 'GROUP BY paid', + } + ); + +my $max = 0; +my $sum = 0; +foreach (@payrow) { + $sum += $_->quantity; + $max = $_->quantity if $_->quantity > $max; +} +my $scale = int($max/60) + 1; + +print "\n PAYMENTS RECEIVED"; +print " AFTER $opt{b}" if $opt{b}; +print " UNTIL $opt{e}" if $opt{e}; +print " VIA $opt{p}" if $opt{p}; +print " BY AGENT $opt{a}" if $opt{a}; +print "\n\n"; +print "Total number of payments: $sum\n\n"; +print "(each * represents $scale)\n\n" if $scale > 1; + +foreach my $payrow ( @payrow ) { + print sprintf("%10.2f", $payrow->paid), + ": ", + sprintf("%6d", $payrow->quantity), + "| ", + '*' x($payrow->quantity/$scale), + "\n"; +} + +print "\n"; + + +### +# subroutines +### + +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + # Date::Parse + $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n cust_pay_histogram [ -b 'begin_date' ] [ -e 'end_date' ] [ -p 'payby' ] [ -a agentnum ] user\n"; +} + +### +# documentation +### + +=head1 NAME + +cust_pay_histogram - Show a histogram of payments made for a date range. + +=head1 SYNOPSIS + + freeside-daily [ -b 'begin_date' ] [ -e 'end_date'] [ -p 'payby' ] [ -a agentnum ] user + +=head1 DESCRIPTION + +Displays a histogram of cust_pay records in the database. + + -b: Include only payments since 'begin_date'. Date is in any format Date::Parse is happy with, but be careful. + + -e: Include only payments before 'end_date'. Date is in any format Date::Parse is happy with, but be careful. + + -p: Only process payments with the specified payby (I<CARD>, I<DCRD>, I<CHEK>, I<DCHK>, I<BILL>, I<COMP>, I<LECB>) + + -a: Only process payments of customers with the specified agentnum + +user: From the mapsecrets file - see config.html from the base documentation + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::cust_pay> + +=cut + diff --git a/bin/customer-faker b/bin/customer-faker new file mode 100755 index 000000000..236a41247 --- /dev/null +++ b/bin/customer-faker @@ -0,0 +1,124 @@ +#!/usr/bin/perl + +use strict; +use Getopt::Std; +use Data::Faker; +use Business::CreditCard; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_main; +use FS::cust_pkg; +use FS::svc_acct; + +my $refnum = 1; + +#my @pkgs = ( 4, 5, 6 ); +my $svcpart = 2; + +use vars qw( $opt_p $opt_a $opt_k ); +getopts('p:a:k:'); + +my $agentnum = $opt_a || 1; + +my @pkgs = $opt_k ? split(/,\s*/, $opt_k) : ( 2, 3, 4 ); + +my $user = shift or die &usage; +my $num = shift or die &usage; +adminsuidsetup($user); + +my $onum = $num; +my $start = time; + +my @states = qw( AL AK AS AZ AR CA CO CT DE DC FL GA GU HI ID IL IN IA KS KY LA ME MD MA MI MN MS MO MT NE NV NH NJ NM NY NC ND MP OH OK OR PA PR RI SC SD TN TX UT VT VI VA WA WV WI WY ); +#FM MH + +until ( $num-- <= 0 ) { + + my $faker = new Data::Faker; + + my $cust_main = new FS::cust_main { + 'agentnum' => $agentnum, + 'refnum' => $refnum, + 'first' => $faker->first_name, + 'last' => $faker->last_name, + 'company' => ( $num % 2 ? $faker->company. ', '. $faker->company_suffix : '' ), #half with companies.. + 'address1' => $faker->street_address, + 'city' => 'Tofutown', #missing, so everyone is from tofutown# $faker->city, + #'state' => $faker->us_state_abbr, + 'state' => $states[ int(rand($#states)) ], + 'zip' => $faker->us_zip_code, + 'country' => 'US', + 'daytime' => $faker->phone_number, + 'night' => $faker->phone_number, + #forget it, these can have extensions# 'fax' => ( $num % 2 ? $faker->phone_number : '' ), #ditto + #bah, forget shipping addresses + 'payby' => 'BILL', + 'payip' => $faker->ip_address, + }; + + if ( $opt_p eq 'CARD' || ( !$opt_p && rand() > .33 ) ) { + $cust_main->payby('CARD'); + my $cardnum = '4123'. sprintf('%011u', int(rand(100000000000)) ); + $cust_main->payinfo( $cardnum. generate_last_digit($cardnum) ); + $cust_main->paydate( '2009-05-01' ); + } elsif ( $opt_p eq 'CHEK' || ( !$opt_p && rand() > .66 ) ) { + $cust_main->payby('CHEK'); + my $payinfo = sprintf('%7u@%09u', int(rand(10000000)), int(rand(1000000000)) ); + $cust_main->payinfo($payinfo); + $cust_main->payname( 'First International Bank of Testing' ); + } + + # could insert invoicing_list and other stuff too.. hell, could insert + # packages, services, more + # but i just wanted 10k customers to test the pager and this was good enough + # not anymore, here's some services and packages + + my $now = time; + my $year = 31556736; #60*60*24*365.24 + my $setup = $now - int(rand($year)); + + my $cust_pkg = new FS::cust_pkg { + 'pkgpart' => $pkgs[ int(rand(scalar(@pkgs))) ], + + #some dates in here would be nice + 'setup' => $setup, + #'last_bill' + #'bill' + #'susp' + #'expire' + #'cancel' + }; + + my $svc_acct = new FS::svc_acct { + 'svcpart' => $svcpart, + 'username' => $faker->username, + }; + + while ( qsearch( 'svc_acct', { 'username' => $svc_acct->username } ) ) { + my $username = $svc_acct->username; + $username++; + $svc_acct->username($username); + } + + use Tie::RefHash; + tie my %hash, 'Tie::RefHash', + $cust_pkg => [ $svc_acct ], + ; + + my $error = $cust_main->insert( \%hash ); + die $error if $error; + +} + +my $end = time; + +my $sec = $end-$start; +$sec=1 if $sec==0; +my $persec = $onum / $sec; +print "$onum customers inserted in $sec seconds ($persec customers/sec)\n"; + +#--- + +sub usage { + die "Usage:\n\n customer-faker [ -p payby ] [ -a agentnum ] [ -k pkgpart,pkgpart,pkgpart... ] user num_fakes\n"; +} diff --git a/bin/cvs2cl b/bin/cvs2cl new file mode 100755 index 000000000..1c1bfb097 --- /dev/null +++ b/bin/cvs2cl @@ -0,0 +1,2 @@ +#!/bin/sh +cvs2cl -F trunk diff --git a/bin/drop_slony.slonik b/bin/drop_slony.slonik new file mode 100644 index 000000000..04ffaca7c --- /dev/null +++ b/bin/drop_slony.slonik @@ -0,0 +1,9 @@ +cluster name = freeside; + +node 1 admin conninfo = 'dbname=freeside host=XXX user=postgres'; +node 2 admin conninfo = 'dbname=freeside host=XXX user=postgres'; + +drop set (id=1, origin=1); + +uninstall node ( id=1 ); + diff --git a/bin/expand-country b/bin/expand-country new file mode 100755 index 000000000..c6f2a1f09 --- /dev/null +++ b/bin/expand-country @@ -0,0 +1,29 @@ +#!/usr/bin/perl -w + +use strict; +use Locale::SubCountry; +use FS::UID qw(adminsuidsetup); +use FS::Setup; +use FS::Record qw(qsearch); +use FS::cust_main_county; + +my $user = shift or die &usage; +my $country = shift or die &usage; + +adminsuidsetup($user); + +my @country = qsearch('cust_main_county', { 'country' => $country } ); +die "unknown country $country" unless (@country); +#die "$country already expanded" if scalar(@country) > 1; + +foreach my $cust_main_county ( @country ) { + my $error = $cust_main_county->delete; + die $error if $error; +} + +FS::Setup::_add_country($country); + +sub usage { + die "Usage:\n\n expand-country user countrycode\n"; +} + diff --git a/bin/explain-ar-total.sql b/bin/explain-ar-total.sql new file mode 100644 index 000000000..f1544303b --- /dev/null +++ b/bin/explain-ar-total.sql @@ -0,0 +1,976 @@ +EXPLAIN SELECT ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill LEFT JOIN cust_main USING ( custnum ) WHERE cust_bill._date > ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund LEFT JOIN cust_main USING ( custnum ) WHERE cust_refund._date > ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit LEFT JOIN cust_main USING ( custnum ) WHERE cust_credit._date > ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay LEFT JOIN cust_main USING ( custnum ) WHERE cust_pay._date > ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + AS balance_0_30, ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill LEFT JOIN cust_main USING ( custnum ) WHERE cust_bill._date <= ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND cust_bill._date > ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund LEFT JOIN cust_main USING ( custnum ) WHERE cust_refund._date <= ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND cust_refund._date > ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit LEFT JOIN cust_main USING ( custnum ) WHERE cust_credit._date <= ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND cust_credit._date > ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay LEFT JOIN cust_main USING ( custnum ) WHERE cust_pay._date <= ( EXTRACT( EPOCH FROM now() ) - 2592000 ) AND cust_pay._date > ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + AS balance_30_60, ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill LEFT JOIN cust_main USING ( custnum ) WHERE cust_bill._date <= ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND cust_bill._date > ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund LEFT JOIN cust_main USING ( custnum ) WHERE cust_refund._date <= ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND cust_refund._date > ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit LEFT JOIN cust_main USING ( custnum ) WHERE cust_credit._date <= ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND cust_credit._date > ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay LEFT JOIN cust_main USING ( custnum ) WHERE cust_pay._date <= ( EXTRACT( EPOCH FROM now() ) - 5184000 ) AND cust_pay._date > ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + AS balance_60_90, ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill LEFT JOIN cust_main USING ( custnum ) WHERE cust_bill._date <= ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund LEFT JOIN cust_main USING ( custnum ) WHERE cust_refund._date <= ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit LEFT JOIN cust_main USING ( custnum ) WHERE cust_credit._date <= ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay LEFT JOIN cust_main USING ( custnum ) WHERE cust_pay._date <= ( EXTRACT( EPOCH FROM now() ) - 7776000 ) AND ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + AS balance_90_0, ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill LEFT JOIN cust_main USING ( custnum ) WHERE ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund LEFT JOIN cust_main USING ( custnum ) WHERE ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit LEFT JOIN cust_main USING ( custnum ) WHERE ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay LEFT JOIN cust_main USING ( custnum ) WHERE ( SELECT COALESCE(SUM(charged - ( SELECT COALESCE(SUM(amount),0) FROM cust_bill_pay + WHERE cust_bill.invnum = cust_bill_pay.invnum ) - ( SELECT COALESCE(SUM(amount),0) FROM cust_credit_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum )), 0) FROM cust_bill WHERE cust_main.custnum = cust_bill.custnum ) + + ( SELECT COALESCE(SUM(refund + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_refund.refundnum = cust_credit_refund.refundnum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_refund.refundnum = cust_pay_refund.refundnum ) + ,0 + ) + ), 0) FROM cust_refund WHERE cust_main.custnum = cust_refund.custnum ) + - ( SELECT COALESCE(SUM(amount + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + ,0 + ) + ), 0) FROM cust_credit WHERE cust_main.custnum = cust_credit.custnum ) + - ( SELECT COALESCE(SUM(paid + - COALESCE( + ( SELECT SUM(amount) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + ,0 + ) + - COALESCE( + ( SELECT SUM(amount) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum ) + ,0 + ) + ), 0) FROM cust_pay WHERE cust_main.custnum = cust_pay.custnum ) + > 0 AND ( agentnum = 1 OR agentnum = 2 OR agentnum = 3 OR agentnum = 4 OR agentnum IS NULL ) ) + AS balance_0_0 diff --git a/bin/find-overapplied b/bin/find-overapplied new file mode 100644 index 000000000..7973cef5b --- /dev/null +++ b/bin/find-overapplied @@ -0,0 +1,27 @@ +#!/usr/bin/perl -w + +use strict; +use Data::Dumper; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_credit; +use FS::cust_pay; + +my $user = shift or die &usage; +adminsuidsetup $user; + +my @credits = grep { $_->credited < 0 } qsearch('cust_credit', {}); +my @payments = grep { $_->unapplied < 0 } qsearch('cust_pay', {}); + +if ( @credits ) { + print scalar(@credits). " overapplied credits:\n". Dumper(@credits). "\n"; +} + +if ( @payments ) { + print scalar(@payments). " overapplied payments:\n". Dumper(@payments). "\n"; +} + +sub usage { + die "Usage:\n\n find-overapplied user\n"; +} + diff --git a/bin/fix-sequences b/bin/fix-sequences new file mode 100755 index 000000000..dc4abd751 --- /dev/null +++ b/bin/fix-sequences @@ -0,0 +1,69 @@ +#!/usr/bin/perl -Tw + +# run dbdef-create first! + +use strict; +use DBI; +use DBIx::DBSchema 0.26; +use DBIx::DBSchema::Table; +use DBIx::DBSchema::Column; +use DBIx::DBSchema::ColGroup::Unique; +use DBIx::DBSchema::ColGroup::Index; +use FS::UID qw(adminsuidsetup driver_name); +use FS::Record qw(dbdef); + +my $user = shift or die &usage; +my $dbh = adminsuidsetup $user; + +my $schema = dbdef(); + +#false laziness w/fs-setup +my @tables = scalar(@ARGV) + ? @ARGV + : grep { ! /^h_/ } $schema->tables; +foreach my $table ( @tables ) { + my $tableobj = $schema->table($table) + or die "unknown table $table (did you run dbdef-create?)\n"; + + my $primary_key = $tableobj->primary_key; + next unless $primary_key; + + my $col = $tableobj->column($primary_key); + + + next unless uc($col->type) eq 'SERIAL' + || ( driver_name eq 'Pg' + && defined($col->default) + && $col->default =~ /^nextval\(/i + ) + || ( driver_name eq 'mysql' + && defined($col->local) + && $col->local =~ /AUTO_INCREMENT/i + ); + + my $seq = "${table}_${primary_key}_seq"; + if ( driver_name eq 'Pg' + && defined($col->default) + && $col->default =~ /^nextval\('"(public\.)?(\w+_seq)"'::text\)$/ + ) { + $seq = $2; + } + + warn "fixing sequence for $table\n"; + + + my $sql = "SELECT setval( '$seq', + ( SELECT max($primary_key) FROM $table ) );"; + + #warn $col->default. " $seq\n$sql\n"; + $dbh->do( $sql ) or die $dbh->errstr; + +} + +$dbh->commit or die $dbh->errstr; +$dbh->disconnect or die $dbh->errstr; + +sub usage { + die "Usage:\n fix-sequences user [ table table ... ] \n"; +} + diff --git a/bin/follow-tax-rename b/bin/follow-tax-rename new file mode 100644 index 000000000..b7536e815 --- /dev/null +++ b/bin/follow-tax-rename @@ -0,0 +1,52 @@ +#!/usr/bin/perl + +use FS::UID qw( adminsuidsetup ); +use FS::Record qw( qsearch qsearchs ); +use FS::cust_bill_pkg; + +$FS::Record::nowarn_classload = 1; +$FS::Record::nowarn_classload = 1; + +adminsuidsetup shift; + +my $begin = 1231876106; + +my @old = qsearch('h_cust_main_county', { + 'history_action' => 'replace_old', + 'history_date' => { op=>'>=', value=>$begin, }, +} ); + +foreach my $old (@old) { + + my $new = qsearchs('h_cust_main_county', { + 'history_action' => 'replace_new', + 'history_date' => $old->history_date, + }); + + unless ( $new ) { + warn "huh? no corresponding new record found?"; + next; + } + + my $old_taxname = $old->taxname; + my $new_taxname = $new->taxname; + + my @cust_bill_pkg = qsearch('cust_bill_pkg', { + 'pkgnum' => 0, + 'itemdesc' => $old->taxname, + }); + + next unless @cust_bill_pkg; + + warn 'fixing '. scalar(@cust_bill_pkg). + " dangling line items for rename $old_taxname -> $new_taxname\n"; + + foreach my $cust_bill_pkg ( @cust_bill_pkg ) { + + $cust_bill_pkg->itemdesc( $new->taxname ); + my $error = $cust_bill_pkg->replace; + die $error if $error; + + } + +} diff --git a/bin/freeside-create-initial-data b/bin/freeside-create-initial-data new file mode 100755 index 000000000..410208978 --- /dev/null +++ b/bin/freeside-create-initial-data @@ -0,0 +1,31 @@ +#!/usr/bin/perl -Tw + +#to allow initial insert +use FS::part_pkg; +$FS::part_pkg::setup_hack = 1; +$FS::part_pkg::setup_hack = 1; + +use strict; +use vars qw($opt_d $opt_v); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Setup qw(create_initial_data); + +getopts("d:"); + +my $dbh = adminsuidsetup shift; +create_initial_data('domain' => $opt_d); + +warn "Freeside initial data inserted - commiting transaction\n" if $opt_v; + +$dbh->commit or die $dbh->errstr; +$dbh->disconnect or die $dbh->errstr; + +warn "Database initialization committed successfully\n" if $opt_v; + +sub usage { + die "Usage:\n freeside-create-initial-data -d domain.name [ -v ] user\n" +} + +1; + diff --git a/bin/freeside-init b/bin/freeside-init new file mode 100755 index 000000000..fe12931fc --- /dev/null +++ b/bin/freeside-init @@ -0,0 +1,60 @@ +#! /bin/sh +# +# start the freeside job queue daemon + +#PATH=/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin +DAEMON=/usr/local/bin/freeside-queued +NAME=freeside-queued +DESC="freeside job queue daemon" +USER="ivan" + +test -f $DAEMON || exit 0 + +set -e + +case "$1" in + start) + echo -n "Starting $DESC: " +# start-stop-daemon --start --quiet --pidfile /var/run/$NAME.pid -b -m\ +# --exec $DAEMON + $DAEMON $USER & + echo "$NAME." + ;; + stop) + echo -n "Stopping $DESC: " + start-stop-daemon --stop --quiet --pidfile /var/run/$NAME.pid \ + --exec $DAEMON + echo "$NAME." + rm /var/run/$NAME.pid + ;; + #reload) + # + # If the daemon can reload its config files on the fly + # for example by sending it SIGHUP, do it here. + # + # If the daemon responds to changes in its config file + # directly anyway, make this a do-nothing entry. + # + # echo "Reloading $DESC configuration files." + # start-stop-daemon --stop --signal 1 --quiet --pidfile \ + # /var/run/$NAME.pid --exec $DAEMON + #;; + restart|force-reload) + # + # If the "reload" option is implemented, move the "force-reload" + # option to the "reload" entry above. If not, "force-reload" is + # just the same as "restart". + # + $0 stop + sleep 1 + $0 start + ;; + *) + N=/etc/init.d/$NAME + # echo "Usage: $N {start|stop|restart|reload|force-reload}" >&2 + echo "Usage: $N {start|stop|restart|force-reload}" >&2 + exit 1 + ;; +esac + +exit 0 diff --git a/bin/freeside-migrate-events b/bin/freeside-migrate-events new file mode 100644 index 000000000..3e8a6b209 --- /dev/null +++ b/bin/freeside-migrate-events @@ -0,0 +1,266 @@ +#!/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 new file mode 100755 index 000000000..d5fd703f6 --- /dev/null +++ b/bin/freeside-session-kill @@ -0,0 +1,103 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($conf); +use Fcntl qw(:flock); +use FS::UID qw(adminsuidsetup datasrc dbh); +use FS::Record qw(dbdef qsearch fields); +use FS::session; +use FS::svc_acct; + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $sessionlock = "/usr/local/etc/freeside/session-kill.lock.". datasrc; + +open(LOCK,"+>>$sessionlock") or die "Can't open $sessionlock: $!"; +select(LOCK); $|=1; select(STDOUT); +unless ( flock(LOCK,LOCK_EX|LOCK_NB) ) { + seek(LOCK,0,0); + my($pid)=<LOCK>; + chop($pid); + #no reason to start loct of blocking processes + die "Is another session kill process running under pid $pid?\n"; +} +seek(LOCK,0,0); +print LOCK $$,"\n"; + +$FS::UID::AutoCommit = 0; + +my $now = time; + +#uhhhhh + +use DBIx::DBSchema; +use DBIx::DBSchema::Table; #down this path lies madness +use DBIx::DBSchema::Column; + +my $dbdef = dbdef or die; +#warn $dbdef; +#warn $dbdef->{'tables'}; +#warn keys %{$dbdef->{'tables'}}; +my $session_table = $dbdef->table('session') or die; +my $svc_acct_table = $dbdef->table('svc_acct') or die; + +my $session_svc_acct = new DBIx::DBSchema::Table ( 'session,svc_acct', '', '', '', + map( DBIx::DBSchema::Column->new( "session.$_", + $session_table->column($_)->type, + $session_table->column($_)->null, + $session_table->column($_)->length, + ), $session_table->columns() ), + map( DBIx::DBSchema::Column->new( "svc_acct.$_", + $svc_acct_table->column($_)->type, + $svc_acct_table->column($_)->null, + $svc_acct_table->column($_)->length, + ), $svc_acct_table->columns ), +# map("svc_acct.$_", $svc_acct_table->columns), +); + +$dbdef->addtable($session_svc_acct); #madness, i tell you + +$FS::Record::DEBUG = 1; +my @session = qsearch('session,svc_acct', {}, '', ' WHERE '. join(' AND ', + 'svc_acct.svcnum = session.svcnum', + '( session.logout IS NULL OR session.logout = 0 )', + "( $now - session.login ) >= svc_acct.seconds" +). " FOR UPDATE" ); + +my $dbh = dbh; + +foreach my $join ( @session ) { + + my $session = new FS::session ( { + map { $_ => $join->{'Hash'}{"session.$_"} } fields('session') + } ); #see no evil + + my $svc_acct = new FS::svc_acct ( { + map { $_ => $join->{'Hash'}{"svc_acct.$_"} } fields('svc_acct') + } ); + + #false laziness w/ fs_session_server + my $nsession = new FS::session ( { $session->hash } ); + my $error = $nsession->replace($session); + if ( $error ) { + $dbh->rollback; + die $error; + } + my $time = $nsession->logout - $nsession->login; + my $new_svc_acct = new FS::svc_acct ( { $svc_acct->hash } ); + my $seconds = $new_svc_acct->seconds; + $seconds -= $time; + $seconds = 0 if $seconds < 0; + $new_svc_acct->seconds( $seconds ); + $error = $new_svc_acct->replace( $svc_acct ); + warn "can't debit time from ". $svc_acct->username. ": $error\n"; #don't want to rollback, though + #ssenizal eslaf + +} + +$dbh->commit or die $dbh->errstr; + +sub usage { + die "Usage:\n\n freeside-session-kill user\n"; +} diff --git a/bin/freeside-upgrade-unicode b/bin/freeside-upgrade-unicode new file mode 100755 index 000000000..c60336567 --- /dev/null +++ b/bin/freeside-upgrade-unicode @@ -0,0 +1,72 @@ +#!/bin/bash + +# based on example code from +# http://blog.larik.nl:80/articles/2006/03/13/upgrade-your-postgresql-databases-to-unicode +# by frodo larik / blog.larik.nl + +db=freeside + +# This script updates all dbs to use unicode + +dbhost='localhost' +username='freeside' +#odir=${HOME}/freeside_unicode_upgrade +odir=/home/ivan/FREESIDE_unicode_upgrade + +if [ "${db}X" == "X" ] +then + echo "I need a db for host ${dbhost} and username ${username} $db" + exit +fi + +if [ ! -d $odir ] +then + mkdir $odir || exit "Exit at mkdir" +fi + +#echo -n "Enter a comma-separated list of country codes to keep [US,CA]:" +#countries=`line` +#if [ "${countries}X" == "X" ] +#then +# countries='US,CA' +#fi + +echo "delete from cust_main_county where 0 = ( select count(*) from cust_main where cust_main_county.country = cust_main.country );" | su freeside -c 'psql freeside' + +dump_sql=${odir}/${db}_out.sql +conv_sql=${odir}/${db}_conv.sql +result_sql=${odir}/${db}_result.txt +sql_diff=${odir}/${db}.diff + +# 0. stop + +/etc/init.d/freeside stop || die "can't stop freeside" +/etc/init.d/apache stop || die "can't stop apache" +/etc/init.d/apache2 stop || die "can't stop apache" + +echo "Dumping $db database to $dump_sql" + +su $username -c "pg_dump --host=$dbhost --username=$username -D --format=p $db" >$dump_sql || exit "exit at pg_dump" + +echo "Removing invalid characters from the dump" + +iconv -c -f UTF-8 -t UTF-8 ${dump_sql} > ${conv_sql} || exit "exit at iconv" + +echo "*** Making a diff from the dump: check $sql_diff ***" + +diff $dump_sql $conv_sql > $sql_diff + +echo "Removing current database" + +su $freeside -c "dropdb --host=$dbhost --username=$username $db" || exit "exit at dropdb" + +echo "Creating a new databse" + +su freeside -c "createdb --encoding='unicode' --host=$dbhost --username=$username $db" || exit "exit at createdb" + +echo "Loading data into new database" +su freeside -c "psql -f $conv_sql -o $result_sql -h $dbhost -U $username $db" || exit "exit at psql ${extra_string}" + +# 99. +/etc/init.d/freeside start || die "oh no, can't start freeside" +/etc/init.d/apache start || die "oh no, can't start apache" diff --git a/bin/freeside.import b/bin/freeside.import new file mode 100644 index 000000000..fdfcc083e --- /dev/null +++ b/bin/freeside.import @@ -0,0 +1,146 @@ +#!/usr/bin/perl -w + +use strict; +use DBI; + +my $s_datasrc = 'DBI:mysql:host=ns1.enetonline.net;port=3307;user=ivan;dbname=freeside'; +my $s_dbuser = 'ivan'; +my $s_dbpass = ''; + +my $d_datasrc = 'DBI:Pg:dbname=freeside'; +my $d_dbuser = 'freeside'; +my $d_dbpass = ''; + +#my @tables = qw( +#addr_block +#agent +#agent_type +#cust_bill +#cust_bill_event +#cust_bill_pay +#cust_bill_pkg +#cust_bill_pkg_detail +#cust_credit +#cust_credit_bill +#cust_credit_refund +#cust_main +#cust_main_county +#cust_main_invoice +#cust_pay +#cust_pay_batch +#cust_pkg +#cust_refund +#cust_svc +#cust_tax_exempt +#domain_record +#export_svc +#h_addr_block +#h_agent +#h_agent_type +#h_cust_bill +#h_cust_bill_event +#h_cust_bill_pay +#h_cust_bill_pkg +#h_cust_bill_pkg_detail +#h_cust_credit +#h_cust_credit_bill +#h_cust_credit_refund +#h_cust_main +#h_cust_main_county +#h_cust_main_invoice +#h_cust_pay +#h_cust_pay_batch +#h_cust_pkg +#h_cust_refund +#h_cust_svc +#h_cust_tax_exempt +#h_domain_record +#h_export_svc +#h_msgcat +#h_nas +#h_part_bill_event +#h_part_export +#h_part_export_option +#h_part_pkg +#h_part_pop_local +#h_part_referral +#h_part_svc +#h_part_svc_column +#h_part_svc_router +#h_pkg_svc +#h_port +#h_prepay_credit +#h_queue +#h_queue_arg +#h_queue_depend +#h_radius_usergroup +#h_router +#h_router_field +#h_sb_field +#h_session +#h_svc_acct +#h_svc_acct_pop +#h_svc_broadband +#h_svc_domain +#h_svc_forward +#h_svc_www +#h_type_pkgs +#msgcat +#nas +#part_bill_event +#part_export +#part_export_option +#part_pkg + +my @tables = qw( +part_pop_local +part_referral +part_router_field +part_sb_field +part_svc +part_svc_column +part_svc_router +pkg_svc +port +prepay_credit +queue +queue_arg +queue_depend +radius_usergroup +router +router_field +sb_field +session +svc_acct +svc_acct_pop +svc_broadband +svc_domain +svc_forward +svc_www +type_pkgs +); + +my $s_dbh = DBI->connect($s_datasrc, $s_dbuser, $s_dbpass) or die $DBI::errstr; +my $d_dbh = DBI->connect($d_datasrc, $d_dbuser, $d_dbpass) or die $DBI::errstr; + +foreach my $table ( @tables ) { + $d_dbh->do("delete from $table"); + + my $s_sth = $s_dbh->prepare("select * from $table"); + $s_sth->execute or die $s_sth->errstr; + + my $row; + while ( $row = $s_sth->fetchrow_arrayref ) { + my $d_sth = $d_dbh->prepare( + "insert into $table ( ". + join(', ', @{$s_sth->{NAME}} ). + ' ) VALUES ( '. + join(', ', map { '?' } @{$s_sth->{NAME}} ). + ' )' + ) or die $d_dbh->errstr; + + $d_sth->execute(@$row) or die $d_sth->errstr; + + } +} + diff --git a/bin/fs-migrate-cust_tax_exempt b/bin/fs-migrate-cust_tax_exempt new file mode 100755 index 000000000..35c74ffab --- /dev/null +++ b/bin/fs-migrate-cust_tax_exempt @@ -0,0 +1,323 @@ +#!/usr/bin/perl -w + +use strict; +use Time::Local; +use Date::Format; +use Time::Duration; +use FS::UID qw(adminsuidsetup); +use FS::Record qw( qsearch dbh ); +use FS::cust_tax_exempt; +#use FS::cust_bill; +use FS::h_cust_bill; +use FS::h_cust_tax_exempt; +use FS::cust_bill_pkg; +use FS::cust_tax_exempt_pkg; +#use Data::Dumper; + +my $start = time; + +adminsuidsetup shift; + +my $fuz = 7; #seconds + + #site-specific rewrites +my %rewrite = ( + #cust_tax_exempt.exemptnum => { 'field' => 'newvalue', ... }, +# '23' => { month=>10, year=>2005, invnum=>1640 }, + + #etc. +); + +my @cust_tax_exempt = qsearch('cust_tax_exempt', {} ); +my $num_cust_tax_exempt = scalar(@cust_tax_exempt); +my $num_cust_tax_exempt_migrated = 0; +my $total_cust_tax_exempt_migrated = 0; +my $num_cust_tax_exempt_pkg_migrated = 0; +my $total_cust_tax_exempt_pkg_migrated = 0; + +$FS::UID::AutoCommit = 0; + +foreach my $cust_tax_exempt ( @cust_tax_exempt ) { + + if ( exists $rewrite{ $cust_tax_exempt->exemptnum } ) { + my $hashref = $rewrite{ $cust_tax_exempt->exemptnum }; + $cust_tax_exempt->setfield($_, $hashref->{$_}) + foreach keys %$hashref; + } + + if ( $cust_tax_exempt->year < 1990 ) { + warn "exemption year is ". $cust_tax_exempt->year. + "; not migrating exemption ". $cust_tax_exempt->exemptnum. + ' for custnum '. $cust_tax_exempt->custnum. "\n\n"; + next; + } + + # also make sure cust_bill_pkg record dates contain the month/year +# my $mon = $cust_tax_exempt->month; +# my $year = $cust_tax_exempt->year; +# $mon--; +# my $edate_after = timelocal(0,0,0,1,$mon,$year); +# $mon++; +# if ( $mon >= 12 ) { $mon-=12; $year++ }; +# my $sdate_before = timelocal(0,0,0,1,$mon,$year); + + my $mon = $cust_tax_exempt->month; + my $year = $cust_tax_exempt->year; + if ( $mon >= 12 ) { $mon-=12; $year++ }; + my $sdate_before = timelocal(0,0,0,1,$mon,$year); + #$mon++; + #if ( $mon >= 12 ) { $mon-=12; $year++ }; + my $edate_after = timelocal(0,0,0,1,$mon,$year); + + # !! start a transaction? (yes, its started) + + my @h_cust_tax_exempt = qsearch({ + 'table' => 'h_cust_tax_exempt', + 'hashref' => { 'exemptnum' => $cust_tax_exempt->exemptnum }, + 'extra_sql' => " AND ( history_action = 'insert' + OR history_action = 'replace_new' ) + ORDER BY history_date ASC + ", + }); + + my $amount_so_far = 0; + my $num_cust_tax_exempt_pkg = 0; + my $total_cust_tax_exempt_pkg = 0; + H_CUST_TAX_EXEMPT: foreach my $h_cust_tax_exempt ( @h_cust_tax_exempt ) { + + my $amount = sprintf('%.2f', $h_cust_tax_exempt->amount - $amount_so_far ); + $amount_so_far += $amount; + +# print Dumper($h_cust_tax_exempt), "\n"; + + #find a matching cust_bill record + # (print time differences and choose a meaningful threshold, should work) + + my @h_cust_bill = (); + if ( $cust_tax_exempt->invnum ) { + #warn "following invnum ". $cust_tax_exempt->invnum. + # " kludge for cust_tax_exempt ". $cust_tax_exempt->exemptnum. "\n"; + + @h_cust_bill = qsearch({ + #'table' => 'cust_bill', + 'table' => 'h_cust_bill', + 'hashref' => { 'custnum' => $h_cust_tax_exempt->custnum, + 'invnum' => $cust_tax_exempt->invnum, + 'history_action' => 'insert', + }, + #'extra_sql' => + # ' AND history_date <= '. ( $h_cust_tax_exempt->history_date + $fuz ). + # ' AND history_date > '. ( $h_cust_tax_exempt->history_date - $fuz ), + }); + + } else { + + @h_cust_bill = qsearch({ + #'table' => 'cust_bill', + 'table' => 'h_cust_bill', + 'hashref' => { 'custnum' => $h_cust_tax_exempt->custnum, + 'history_action' => 'insert', + }, + 'extra_sql' => + ' AND history_date <= '. ( $h_cust_tax_exempt->history_date + $fuz ). + ' AND history_date > '. ( $h_cust_tax_exempt->history_date - $fuz ), + }); + + } + + if ( scalar(@h_cust_bill) != 1 ) { + warn ' '. scalar(@h_cust_bill). ' h_cust_bill records matching '. + 'h_cust_tax_exempt.historynum '. $h_cust_tax_exempt->historynum. + "; not migrating (adjust fuz factor?)\n"; + next; + } + + my $h_cust_bill = $h_cust_bill[0]; + +# print Dumper(@cust_bill), "\n\n"; + + # then find a matching cust_bill_pkg record with part_pkg.taxclass record + # that matches the one pointed to by cust_tax_exempt.taxnum + # (hopefully just one, see how many we can match automatically) + + my $cust_main_county = $cust_tax_exempt->cust_main_county; + my $taxclass = $cust_main_county->taxclass; + + my $hashref = { + 'custnum' => $cust_tax_exempt->custnum, + 'invnum' => $h_cust_bill->invnum, + 'pkgnum' => { op=>'>', value=>0, }, + }; + unless ( $cust_tax_exempt->invnum ) { + # also make sure cust_bill_pkg record dates contain the month/year + + #$hashref->{'sdate'} = { op=>'<', value=>$sdate_before }; + $hashref->{'sdate'} = { op=>'<=', value=>$sdate_before }; + + #$hashref->{'edate'} = { op=>'>', value=>$edate_after }; + $hashref->{'edate'} = { op=>'>=', value=>$edate_after }; + } + + if ( $cust_tax_exempt->billpkgnum ) { + $hashref->{'billpkgnum'} = $cust_tax_exempt->billpkgnum; + } + + my $extra_sql = 'ORDER BY billpkgnum'; + + $extra_sql = "AND taxclass = '$taxclass' $extra_sql" + unless $cust_tax_exempt->ignore_current_taxclass; + + my @cust_bill_pkg = qsearch({ + 'select' => 'cust_bill_pkg.*, part_pkg.freq', + 'table' => 'cust_bill_pkg', + 'addl_from' => 'LEFT JOIN cust_pkg using ( pkgnum ) '. + 'LEFT JOIN part_pkg using ( pkgpart ) ', + 'hashref' => $hashref, + 'extra_sql' => $extra_sql, + }); + + foreach my $cust_bill_pkg ( @cust_bill_pkg ) { + $cust_bill_pkg->exemptable_per_month( + sprintf('%.2f', + ( $cust_bill_pkg->setup + $cust_bill_pkg->recur ) + / + ( $cust_bill_pkg[0]->freq || 1 ) + ) + ); + } + + my(@cust_tax_exempt_pkg) = (); + if ( scalar(@cust_bill_pkg) == 1 + && $cust_bill_pkg[0]->exemptable_per_month >= $amount + ) + { + + my $cust_bill_pkg = $cust_bill_pkg[0]; + + # finally, create an appropriate cust_tax_exempt_pkg record + + push @cust_tax_exempt_pkg, new FS::cust_tax_exempt_pkg { + 'billpkgnum' => $cust_bill_pkg->billpkgnum, + 'taxnum' => $cust_tax_exempt->taxnum, + 'year' => $cust_tax_exempt->year, + 'month' => $cust_tax_exempt->month, + 'amount' => $amount, + }; + + } else { + +# warn ' '. scalar(@cust_bill_pkg). ' cust_bill_pkg records for invoice '. +# $h_cust_bill->invnum. +# "; not migrating h_cust_tax_exempt historynum ". +# $h_cust_tax_exempt->historynum. " for \$$amount\n"; +# warn " *** DIFFERENT DATES ***\n" +# if grep { $_->sdate != $cust_bill_pkg[0]->sdate +# || $_->edate != $cust_bill_pkg[0]->edate +# } @cust_bill_pkg; +# foreach ( @cust_bill_pkg ) { +# warn ' '. $_->billpkgnum. ': '. $_->setup. 's/'. $_->recur.'r'. +# ' '. time2str('%D', $_->sdate). '-'. time2str('%D', $_->edate). +# "\n"; +# } +# +# next; + + my $remaining = $amount; + foreach my $cust_bill_pkg ( @cust_bill_pkg ) { + last unless $remaining; + my $this_amount =sprintf('%.2f', + $remaining <= $cust_bill_pkg->exemptable_per_month + ? $remaining + : $cust_bill_pkg->exemptable_per_month + );; + + push @cust_tax_exempt_pkg, new FS::cust_tax_exempt_pkg { + 'billpkgnum' => $cust_bill_pkg->billpkgnum, + 'taxnum' => $cust_tax_exempt->taxnum, + 'year' => $cust_tax_exempt->year, + 'month' => $cust_tax_exempt->month, + 'amount' => $this_amount, + }; + + $remaining -= $this_amount; + + } + + } + + foreach my $cust_tax_exempt_pkg ( @cust_tax_exempt_pkg ) { + my $error = $cust_tax_exempt_pkg->insert; + #my $error = $cust_tax_exempt_pkg->check; + if ( $error ) { + warn "*** error inserting cust_tax_exempt_pkg record: $error\n"; + next; #not necessary.. H_CUST_TAX_EXEMPT; + + #not necessary, incorrect $total_cust_tax_exempt_pkg will error it out + # roll back at least the entire cust_tax_exempt transaction + # next CUST_TAX_EXEMPT; + } + + $num_cust_tax_exempt_pkg++; + + $total_cust_tax_exempt_pkg += $cust_tax_exempt_pkg->amount; + + } + + } + + $total_cust_tax_exempt_pkg = sprintf('%.2f', $total_cust_tax_exempt_pkg ); + + unless ( $total_cust_tax_exempt_pkg == $cust_tax_exempt->amount ) { + warn "total h_ amount $total_cust_tax_exempt_pkg != cust_tax_exempt.amount ". + $cust_tax_exempt->amount. + ";\n not migrating exemption ". $cust_tax_exempt->exemptnum. " for ". + $cust_tax_exempt->month. '/'. $cust_tax_exempt->year. + ' (custnum '. $cust_tax_exempt->custnum. ") ". + #"\n (sdate < ". time2str('%D', $sdate_before ). + "\n (sdate <= ". time2str('%D', $sdate_before ). " [$sdate_before]". + #' / edate > '. time2str('%D', $edate_after ). ')'. + ' / edate >= '. time2str('%D', $edate_after ). " [$edate_after])". + "\n\n"; + + # roll back at least the entire cust_tax_exempt transaction + dbh->rollback; + + # next CUST_TAX_EXEMPT; + next; + } + + # remove the cust_tax_exempt record + my $error = $cust_tax_exempt->delete; + if ( $error ) { + #roll back at least the entire cust_tax_exempt transaction + dbh->rollback; + + #next CUST_TAX_EXEMPT; + next; + } + + $num_cust_tax_exempt_migrated++; + $total_cust_tax_exempt_migrated += $cust_tax_exempt->amount; + + $num_cust_tax_exempt_pkg_migrated += $num_cust_tax_exempt_pkg; + $total_cust_tax_exempt_pkg_migrated += $total_cust_tax_exempt_pkg; + + # commit the transaction + dbh->commit; + +} + +$total_cust_tax_exempt_migrated = + sprintf('%.2f', $total_cust_tax_exempt_migrated ); +$total_cust_tax_exempt_pkg_migrated = + sprintf('%.2f', $total_cust_tax_exempt_pkg_migrated ); + +warn + "$num_cust_tax_exempt_migrated / $num_cust_tax_exempt (". + sprintf('%.2f', 100 * $num_cust_tax_exempt_migrated / $num_cust_tax_exempt). + '%) cust_tax_exempt records migrated ($'. $total_cust_tax_exempt_migrated. + ")\n to $num_cust_tax_exempt_pkg_migrated cust_tax_exempt_pkg records". + ' ($'. $total_cust_tax_exempt_pkg_migrated. ')'. + "\n in ". duration(time-$start). "\n" +; + diff --git a/bin/fs-migrate-part_svc b/bin/fs-migrate-part_svc new file mode 100755 index 000000000..b0f3ac57e --- /dev/null +++ b/bin/fs-migrate-part_svc @@ -0,0 +1,41 @@ +#!/usr/bin/perl + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch fields); +use FS::part_svc; + +my $user = shift or die &usage; +my $dbh = adminsuidsetup $user; + +my $oldAutoCommit = $FS::UID::AutoCommit; +local $FS::UID::AutoCommit = 0; + +foreach my $part_svc ( qsearch('part_svc', {} ) ) { + foreach my $field ( + grep { defined($part_svc->getfield($part_svc->svcdb.'__'.$_.'_flag') ) } + fields($part_svc->svcdb) + ) { + my $flag = $part_svc->getfield($part_svc->svcdb.'__'.$field.'_flag'); + if ( uc($flag) =~ /^([DF])$/ ) { + my $part_svc_column = new FS::part_svc_column { + 'svcpart' => $part_svc->svcpart, + 'columnname' => $field, + 'columnflag' => $1, + 'columnvalue' => $part_svc->getfield($part_svc->svcdb.'__'.$field), + }; + my $error = $part_svc_column->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + die $error; + } + } + } +} + +$dbh->commit or die $dbh->errstr; + +sub usage { + die "Usage:\n fs-migrate-part_svc user\n"; +} + diff --git a/bin/fs-migrate-payref b/bin/fs-migrate-payref new file mode 100755 index 000000000..158419706 --- /dev/null +++ b/bin/fs-migrate-payref @@ -0,0 +1,31 @@ +#!/usr/bin/perl + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_pay; +use FS::cust_refund; + +my $user = shift or die &usage; +my $dbh = adminsuidsetup $user; + +# apply payments to invoices + +foreach my $cust_pay ( qsearch('cust_pay', {} ) ) { + my $error = $cust_pay->upgrade_replace; + warn $error if $error; +} + +# apply refunds to credits + +foreach my $cust_refund ( qsearch('cust_refund') ) { + my $error = $cust_refund->upgrade_replace; + warn $error if $error; +} + +# ? apply credits to invoices + +sub usage { + die "Usage:\n fs-migrate-payref user\n"; +} + diff --git a/bin/fs-migrate-svc_acct_sm b/bin/fs-migrate-svc_acct_sm new file mode 100755 index 000000000..07f7b611c --- /dev/null +++ b/bin/fs-migrate-svc_acct_sm @@ -0,0 +1,227 @@ +#!/usr/bin/perl -Tw +# +# jeff@cmh.net 01-Jul-20 + +#to delay loading dbdef until we're ready +#BEGIN { $FS::Record::setup_hack = 1; } + +use strict; +use Term::Query qw(query); +#use DBI; +#use DBIx::DBSchema; +#use DBIx::DBSchema::Table; +#use DBIx::DBSchema::Column; +#use DBIx::DBSchema::ColGroup::Unique; +#use DBIx::DBSchema::ColGroup::Index; +use FS::Conf; +use FS::UID qw(adminsuidsetup datasrc checkeuid getsecrets); +use FS::Record qw(qsearch qsearchs); +use FS::svc_domain; +use FS::svc_forward; +use vars qw( $conf $old_default_domain %part_domain_svc %part_acct_svc %part_forward_svc $svc_acct $svc_acct_sm $error); + +die "Not running uid freeside!" unless checkeuid(); + +my $user = shift or die &usage; +getsecrets($user); + +$conf = new FS::Conf; +$old_default_domain = $conf->config('domain'); + +#needs to match FS::Record +#my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc; + +### +# This section would be the appropriate place to manipulate +# the schema & tables. +### + +## we need to add the domsvc to svc_acct +## we must add a svc_forward record.... +## I am thinking that the fields svcnum (int), destsvc (int), and +## dest (varchar (80)) are appropriate, with destsvc/dest an either/or +## much in the spirit of cust_main_invoice + +### +# massage the data +### + +my($dbh)=adminsuidsetup $user; + +$|=1; + +$FS::svc_Common::noexport_hack = 1; +$FS::svc_domain::whois_hack = 1; + +%part_domain_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_domain'}); +%part_acct_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'}); +%part_forward_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_forward'}); + +die "No services with svcdb svc_domain!\n" unless %part_domain_svc; +die "No services with svcdb svc_acct!\n" unless %part_acct_svc; +die "No services with svcdb svc_forward!\n" unless %part_forward_svc; + +my($svc_domain) = qsearchs('svc_domain', { 'domain' => $old_default_domain }); +if (! $svc_domain || $svc_domain->domain != $old_default_domain) { + print <<EOF; + +Your database currently does not contain a svc_domain record for the +domain $old_default_domain. Would you like me to add one for you? +EOF + + my($response)=scalar(<STDIN>); + chop $response; + if ($response =~ /^[yY]/) { + print "\n\n", &menu_domain_svc, "\n", <<END; +I need to create new domain accounts. Which service shall I use for that? +END + my($domain_svcpart)=&getdomainpart; + + $svc_domain = new FS::svc_domain { + 'domain' => $old_default_domain, + 'svcpart' => $domain_svcpart, + 'action' => 'M', + }; +# $error=$svc_domain->insert && die "Error adding domain $old_default_domain: $error"; + $error=$svc_domain->insert; + die "Error adding domain $old_default_domain: $error" if $error; + }else{ + print <<EOF; + + This program cannot function properly until a svc_domain record matching +your conf_dir/domain file exists. +EOF + + exit 1; + } +} + +print "\n\n", &menu_acct_svc, "\n", <<END; +I may need to create some new pop accounts and set up forwarding to them +for some users. Which service shall I use for that? +END +my($pop_svcpart)=&getacctpart; + +print "\n\n", &menu_forward_svc, "\n", <<END; +I may need to create some new forwarding for some users. Which service +shall I use for that? +END +my($forward_svcpart)=&getforwardpart; + +sub menu_domain_svc { + ( join "\n", map "$_: ".$part_domain_svc{$_}->svc, sort keys %part_domain_svc ). "\n"; +} +sub menu_acct_svc { + ( join "\n", map "$_: ".$part_acct_svc{$_}->svc, sort keys %part_acct_svc ). "\n"; +} +sub menu_forward_svc { + ( join "\n", map "$_: ".$part_forward_svc{$_}->svc, sort keys %part_forward_svc ). "\n"; +} +sub getdomainpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %part_domain_svc ]; + $^W=1; + $return; +} +sub getacctpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %part_acct_svc ]; + $^W=1; + $return; +} +sub getforwardpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %part_forward_svc ]; + $^W=1; + $return; +} + + +#migrate data + +my(@svc_accts) = qsearch('svc_acct', {}); +foreach $svc_acct (@svc_accts) { + my(@svc_acct_sms) = qsearch('svc_acct_sm', { + domuid => $svc_acct->getfield('uid'), + } + ); + + # Ok.. we've got the svc_acct record, and an array of svc_acct_sm's + # What do we do from here? + + # The intuitive: + # plop the svc_acct into the 'default domain' + # and then represent the svc_acct_sm's with svc_forwards + # they can be gussied up manually, later + # + # Perhaps better: + # when no svc_acct_sm exists, place svc_acct in 'default domain' + # when one svc_acct_sm exists, place svc_acct in corresponding + # domain & possibly create a svc_forward in 'default domain' + # when multiple svc_acct_sm's exists (in different domains) we'd + # better use the 'intuitive' approach. + # + # Specific way: + # as 'perhaps better,' but we may be able to guess which domain + # is correct by comparing the svcnum of domains to the username + # of the svc_acct + # + + # The intuitive way: + + my $def_acct = new FS::svc_acct ( { $svc_acct->hash } ); + $def_acct->setfield('domsvc' => $svc_domain->getfield('svcnum')); + $error = $def_acct->replace($svc_acct); + die "Error replacing svc_acct for " . $def_acct->username . " : $error" if $error; + + foreach $svc_acct_sm (@svc_acct_sms) { + + my($domrec)=qsearchs('svc_domain', { + svcnum => $svc_acct_sm->getfield('domsvc'), + }) || die "svc_acct_sm references invalid domsvc $svc_acct_sm->getfield('domsvc')\n"; + + if ($svc_acct_sm->getfield('domuser') =~ /^\*$/) { + + my($newdom) = new FS::svc_domain ( { $domrec->hash } ); + $newdom->setfield('catchall', $svc_acct->svcnum); + $newdom->setfield('action', "M"); + $error = $newdom->replace($domrec); + die "Error replacing svc_domain for (anything)@" . $domrec->domain . " : $error" if $error; + + } else { + + my($newacct) = new FS::svc_acct { + 'svcpart' => $pop_svcpart, + 'username' => $svc_acct_sm->getfield('domuser'), + 'domsvc' => $svc_acct_sm->getfield('domsvc'), + 'dir' => '/dev/null', + }; + $error = $newacct->insert; + die "Error adding svc_acct for " . $newacct->username . " : $error" if $error; + + my($newforward) = new FS::svc_forward { + 'svcpart' => $forward_svcpart, + 'srcsvc' => $newacct->getfield('svcnum'), + 'dstsvc' => $def_acct->getfield('svcnum'), + }; + $error = $newforward->insert; + die "Error adding svc_forward for " . $newacct->username ." : $error" if $error; + } + + $error = $svc_acct_sm->delete; + die "Error deleting svc_acct_sm for " . $svc_acct_sm->domuser ." : $error" if $error; + + }; + +}; + + +$dbh->commit or die $dbh->errstr; +$dbh->disconnect or die $dbh->errstr; + +print "svc_acct_sm records sucessfully migrated\n"; + +sub usage { + die "Usage:\n fs-migrate-svc_acct_sm user\n"; +} + diff --git a/bin/fs-radius-add-check b/bin/fs-radius-add-check new file mode 100755 index 000000000..4e4769e58 --- /dev/null +++ b/bin/fs-radius-add-check @@ -0,0 +1,68 @@ +#!/usr/bin/perl -Tw + +# quick'n'dirty hack of fs-setup to add radius attributes + +use strict; +use DBI; +use FS::UID qw(adminsuidsetup checkeuid getsecrets); +use FS::raddb; + +die "Not running uid freeside!" unless checkeuid(); + +my %attrib2db = + map { lc($FS::raddb::attrib{$_}) => $_ } keys %FS::raddb::attrib; + +my $user = shift or die &usage; +getsecrets($user); + +my $dbh = adminsuidsetup $user; + +### + +print "\n\n", <<END, ":"; +Enter the additional RADIUS check attributes you need to track for +each user, separated by whitespace. +END +my @attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; } + split(" ",&getvalue); + +sub getvalue { + my($x)=scalar(<STDIN>); + chop $x; + $x; +} + +### + +my($char_d) = 80; #default maxlength for text fields + +### + +foreach my $attribute ( @attributes ) { + + my $statement = + "ALTER TABLE svc_acct ADD COLUMN rc_$attribute varchar($char_d) NULL"; + my $sth = $dbh->prepare( $statement ) + or warn "Error preparing $statement: ". $dbh->errstr; + my $rc = $sth->execute + or warn "Error executing $statement: ". $sth->errstr; + + $statement = + "ALTER TABLE h_svc_acct ADD COLUMN rc_$attribute varchar($char_d) NULL"; + $sth = $dbh->prepare( $statement ) + or warn "Error preparing $statement: ". $dbh->errstr; + $rc = $sth->execute + or warn "Error executing $statement: ". $sth->errstr; + +} + +$dbh->commit or die $dbh->errstr; + +$dbh->disconnect or die $dbh->errstr; + +print "\n\n", "Now you must run dbdef-create.\n\n"; + +sub usage { + die "Usage:\n fs-radius-add-check user\n"; +} + diff --git a/bin/fs-radius-add-reply b/bin/fs-radius-add-reply new file mode 100755 index 000000000..3de01374f --- /dev/null +++ b/bin/fs-radius-add-reply @@ -0,0 +1,69 @@ +#!/usr/bin/perl -Tw + +# quick'n'dirty hack of fs-setup to add radius attributes + +use strict; +use DBI; +use FS::UID qw(adminsuidsetup checkeuid getsecrets); +use FS::raddb; + +die "Not running uid freeside!" unless checkeuid(); + +my %attrib2db = + map { lc($FS::raddb::attrib{$_}) => $_ } keys %FS::raddb::attrib; + +my $user = shift or die &usage; +getsecrets($user); + +my $dbh = adminsuidsetup $user; + +### + +print "\n\n", <<END, ":"; +Enter the additional RADIUS reply attributes you need to track for +each user, separated by whitespace. +END +my @attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; } + split(" ",&getvalue); + +sub getvalue { + my($x)=scalar(<STDIN>); + chop $x; + $x; +} + +### + +my($char_d) = 80; #default maxlength for text fields + +### + +foreach my $attribute ( @attributes ) { + + my $statement = + "ALTER TABLE svc_acct ADD COLUMN radius_$attribute varchar($char_d) NULL"; + my $sth = $dbh->prepare( $statement ) + or warn "Error preparing $statement: ". $dbh->errstr; + my $rc = $sth->execute + or warn "Error executing $statement: ". $sth->errstr; + + $statement = + "ALTER TABLE h_svc_acct ADD COLUMN radius_$attribute varchar($char_d) NULL"; + $sth = $dbh->prepare( $statement ) + or warn "Error preparing $statement: ". $dbh->errstr; + $rc = $sth->execute + or warn "Error executing $statement: ". $sth->errstr; + +} + +$dbh->commit or die $dbh->errstr; + +$dbh->disconnect or die $dbh->errstr; + +print "\n\n", "Now you must run dbdef-create.\n\n"; + +sub usage { + die "Usage:\n fs-radius-add-reply user\n"; +} + + diff --git a/bin/generate-prepay b/bin/generate-prepay new file mode 100755 index 000000000..cb4ba7fc6 --- /dev/null +++ b/bin/generate-prepay @@ -0,0 +1,35 @@ +#!/usr/bin/perl -w + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::prepay_credit; + +require 5.004; #srand(time|$$); + +my $user = shift or die &usage; +&adminsuidsetup( $user ); + +my $amount = shift or die &usage; + +my $seconds = shift or die &usage; + +my $num_digits = shift or die &usage; + +my $num_entries = shift or die &usage; + +for ( 1 .. $num_entries ) { + my $identifier = join( '', map int(rand(10)), ( 1 .. $num_digits ) ); + my $prepay_credit = new FS::prepay_credit { + 'identifier' => $identifier, + 'amount' => $amount, + 'seconds' => $seconds, + }; + my $error = $prepay_credit->insert; + die $error if $error; + print "$identifier\n"; +} + +sub usage { + die "Usage:\n\n generate-prepay user amount seconds num_digits num_entries"; +} + diff --git a/bin/generate-raddb b/bin/generate-raddb new file mode 100755 index 000000000..af21c05a8 --- /dev/null +++ b/bin/generate-raddb @@ -0,0 +1,53 @@ +#!/usr/bin/perl + +# usage: generate-raddb radius-server/raddb/dictionary* >raddb.pm +# i.e.: generate-raddb ~/freeradius/freeradius-1.0.5/share/dictionary* ~/wirelessoceans/dictionary.ip3networks ~/wtxs/dictionary.mot.canopy >raddb.pm.new +print <<END; +package FS::raddb; +use vars qw(%attrib); + +%attrib = ( +END + +while (<>) { + next if /^(#|\s*$|\$INCLUDE\s+)/; + next if /^(VALUE|VENDOR|BEGIN\-VENDOR|END\-VENDOR)\s+/; + /^(ATTRIBUTE|ATTRIB_NMC)\s+([\w\-\/]+)\s+/ or die $_; + $attrib = $2; + $dbname = lc($2); + $dbname =~ s/[\-\/]/_/g; + $dbname = substr($dbname,0,24); + while ( exists $hash{$dbname} ) { + #warn $dbname; + $dbname =~ s/(.)$//; + my $w = $1; + $w =~ tr/_a-z0-9/a-z0-9_/; + $dbname = "$dbname$w"; + } + $hash{$dbname} = $attrib; + #print "$2\n"; +} + +foreach ( sort keys %hash ) { +# print "$_\n" if length($_)>24; +# print substr($_,0,24),"\n" if length($_)>24; +# $max = length($_) if length($_)>$max; +# have to fudge things since everything >24 is *not* unique + + #print " '". substr($_,0,24). "' => '$hash{$_}',\n"; + print " '$_' ". ( " " x (24-length($_) ) ). "=> '$hash{$_}',\n"; +} + +print <<END; + + #NETC.NET.AU (RADIATOR?) + 'authentication_type' => 'Authentication-Type', + + #wtxs (dunno) + #'radius_operator' => 'Radius-Operator', + +); + +1; +END + diff --git a/bin/generate-table-module b/bin/generate-table-module new file mode 100755 index 000000000..16a23e5b7 --- /dev/null +++ b/bin/generate-table-module @@ -0,0 +1,103 @@ +#!/usr/bin/perl + +use FS::Schema qw( dbdef_dist ); + +my $table = shift; + +### +# add a new FS/FS/table.pm +### + +my %ut = ( #just guesses + 'int' => 'number', + 'number' => 'float', + 'varchar' => 'text', + 'text' => 'text', + 'serial' => 'number', +); + +my $dbdef_table = dbdef_dist->table($table) + or die "define table in Schema.pm first"; +my $primary_key = $dbdef_table->primary_key; + +open(SRC,"<eg/table_template.pm") or die $!; +-e "FS/FS/$table.pm" and die "FS/FS/$table.pm already exists!"; +open(DEST,">FS/FS/$table.pm") or die $!; + +while (my $line = <SRC>) { + + $line =~ s/table_name/$table/g; + + if ( $line =~ /^=item\s+field\s+-\s+description\s*$/ ) { + + foreach my $column ( $dbdef_table->columns ) { + print DEST "=item $column\n\n"; + if ( $column eq $primary_key ) { + print DEST "primary key\n\n"; + } else { + print DEST "$column\n\n"; + } + } + next; + + } elsif ( $line=~ /^(\s*)\$self->ut_numbern\('primary_key'\)\s*/ ) { + + print DEST "$1\$self->ut_numbern('$primary_key')\n" + if $primary_key; + next; + + } elsif ( + $line =~ /^(\s*)\|\|\s+\$self->ut_number\('validate_other_fields'\)\s*/ + ) { + + foreach my $column ( grep { $_ ne $primary_key } $dbdef_table->columns ) { + my $ut = $ut{$dbdef_table->column($column)->type}; + $ut .= 'n' if $dbdef_table->column($column)->null; + print DEST "$1|| \$self->ut_$ut('$column')\n"; + } + next; + + } + + print DEST $line; +} + +close SRC; +close DEST; + +### +# add to FS/FS/Mason.pm +### + +# it needs to be: +# 1. disablable (have an option to turn it off) +# 2. documented in the schema change docs +# +#my $magic = '# Sammath Naur'; +#system("perl -pi -e 's/$magic/use FS::$table;\n $magic/' FS/FS/Mason.pm"); + +### +# add FS/t/table.t +### + +open(TEST,">FS/t/$table.t") or die $!; +print TEST <<ENDTEST; +BEGIN { \$| = 1; print "1..1\\n" } +END {print "not ok 1\\n" unless \$loaded;} +use FS::$table; +\$loaded=1; +print "ok 1\\n"; +ENDTEST +close TEST; + +### +# add them to MANIFEST +### + +system('cvs edit FS/MANIFEST'); + +open(MANIFEST,">>FS/MANIFEST") or die $!; +print MANIFEST "FS/$table.pm\n", + "t/$table.t\n"; +close MANIFEST; + diff --git a/bin/generate-tests b/bin/generate-tests new file mode 100755 index 000000000..73fd29ecb --- /dev/null +++ b/bin/generate-tests @@ -0,0 +1,21 @@ +#!/usr/bin/perl +@files = glob('FS/*.pm'); +foreach (@files) { +# warn $_; + chomp; + s/^FS\///; + $f=$_; + $f=~s/pm$/t/; + $m=$_; + $m=~s/\.pm$//; + open(TEST,">t/$f"); + print "t/$f\n"; + print TEST + 'BEGIN { $| = 1; print "1..1\n" }'. "\n". + 'END {print "not ok 1\n" unless $loaded;}'. "\n". + "use FS::$m;\n". + '$loaded=1;'. "\n". + 'print "ok 1\n";'. "\n" + ; + close TEST; +} diff --git a/bin/h_cust_main-wipe_paycvv b/bin/h_cust_main-wipe_paycvv new file mode 100755 index 000000000..d34c15f34 --- /dev/null +++ b/bin/h_cust_main-wipe_paycvv @@ -0,0 +1,30 @@ +#!/usr/bin/perl + +use strict; +use FS::UID qw(adminsuidsetup dbh); +use FS::Record; #buh? + +my $user = shift or die 'usage'; +adminsuidsetup $user; + +while (1) { + + my $sql = ' UPDATE h_cust_main SET paycvv = NULL + WHERE historynum IN ( SELECT historynum FROM h_cust_main + WHERE paycvv IS NOT NULL LIMIT 8192 )'; +# WHERE paycvv IS NOT NULL LIMIT 1 )'; + + my $sth = dbh->prepare($sql) or die dbh->errstr; + + print '.'; $|=1; + + my $rv = $sth->execute; + + dbh->commit or die dbh->errstr; + + last if $rv == 0; + +} + +print "\n"; + diff --git a/bin/import-county-tax-rates b/bin/import-county-tax-rates new file mode 100755 index 000000000..05798c9a2 --- /dev/null +++ b/bin/import-county-tax-rates @@ -0,0 +1,30 @@ +#!/usr/bin/perl +# +# import-county-tax-rates username state country <filename.csv +# example: import-county-tax-rates ivan CA US <taxes.csv +# +# rates.csv: taxrate,county + +use FS::UID qw(adminsuidsetup); +use FS::cust_main_county; + +my $user = shift; +adminsuidsetup $user; + +my($state, $country) = (shift, shift); + +while (<>) { + my($tax, $county) = split(','); #half-ass CSV parser + + my $cust_main_county = new FS::cust_main_county { + 'county' => $county, + 'state' => $state, + 'country' => $country, + 'tax' => $tax, + }; + + my $error = $cust_main_county->insert; + #my $error = $cust_main_county->check; + die $error if $error; + +} diff --git a/bin/import-optigold.pl b/bin/import-optigold.pl new file mode 100755 index 000000000..d32a2a129 --- /dev/null +++ b/bin/import-optigold.pl @@ -0,0 +1,1077 @@ +#!/usr/bin/perl -Tw + +use strict; +use DBI; +use HTML::TableParser; +use Date::Parse; +use Text::CSV_XS; +use FS::Record qw(qsearch qsearchs); +use FS::cust_credit; +use FS::cust_main; +use FS::cust_pkg; +use FS::cust_svc; +use FS::svc_acct; +use FS::part_referral; +use FS::part_pkg; +use FS::UID qw(adminsuidsetup); + +my $DEBUG = 0; + +my $dry_run = '0'; + +my $s_dbname = 'DBI:Pg:dbname=optigoldimport'; +my $s_dbuser = 'freeside'; +my $s_dbpass = ''; +my $extension = '.htm'; + +#my $d_dbuser = 'freeside'; +my $d_dbuser = 'enet'; +#my $d_dbuser = 'ivan'; +#my $d_dbuser = 'freesideimport'; + +my $radius_file = 'radius.csv'; +my $email_file = 'email.csv'; + +#my $agentnum = 1; +my $agentnum = 13; +my $legacy_domain_svcnum = 1; +my $legacy_ppp_svcpart = 2; +my $legacy_email_svcpart = 3; +#my $legacy_broadband_svcpart = 4; +#my $legacy_broadband_svcpart = 14; +#my $previous_credit_reasonnum = 1; +my $previous_credit_reasonnum = 1220; + + +my $state = ''; #statemachine-ish +my $sourcefile; +my $s_dbh; +my $columncount; +my $rowcount; + +my @args = ( + { + id => 1, + hdr => \&header, + row => \&row, + start => \&start, + end => \&end, + }, + ); + + +$s_dbh = DBI->connect($s_dbname, $s_dbuser, $s_dbpass, + { 'AutoCommit' => 0, + 'ChopBlanks' => 1, + 'ShowErrorStatement' => 1 + } + ); + +foreach ( qw ( billcycle cust email product ) ) { + $sourcefile = $_; + + print "parsing $sourcefile\n"; + + die "bad file name" unless $sourcefile =~ /^\w+$/; + + $columncount = 0; + $rowcount = 0; + + my $c_sth = ''; + if ( $c_sth = $s_dbh->prepare("SELECT COUNT(*) FROM $sourcefile") ) { + if ( $c_sth->execute ) { + if ( $c_sth->fetchrow_arrayref->[0] ) { + warn "already have data in $sourcefile table; skipping"; + next; + } + } + } + + my $tp = new HTML::TableParser( \@args, { Decode => 1, Trim => 1, Chomp => 1 }); + $tp->parse_file($sourcefile.$extension) or die "failed"; + $s_dbh->commit or die $s_dbh->errstr; +# $s_dbh->disconnect; +} + + +sub start { + warn "start\n" if $DEBUG; + my $table_id = shift; + die "unexpected state change" unless $state eq ''; + die "unexpected table" unless $table_id eq '1'; + $state = 'table'; +} + +sub end { + warn "end\n" if $DEBUG; + my ($tbl_id, $line, $udata) = @_; + die "unexpected state change in header" unless $state eq 'rows'; + die "unexpected table" unless $tbl_id eq '1'; + $state = ''; +} + +sub header { + warn "header\n" if $DEBUG; + my ($tbl_id, $line, $cols, $udata) = @_; + die "unexpected state change in header" unless $state eq 'table'; + die "unexpected table" unless $tbl_id eq '1'; + $state = 'rows'; + + die "invalid column ". join (', ', grep { !/^[ \w\r]+$/ } @$cols) + if scalar(grep { !/^[ \w\r]+$/ } @$cols); + + my $sql = "CREATE TABLE $sourcefile ( ". + join(', ', map { s/[ \r]/_/g; "$_ varchar NULL" } @$cols). " )"; + $s_dbh->do($sql) or die "create table failed: ". $s_dbh->errstr; + $columncount = scalar( @$cols ); +} + +sub row { + warn "row\n" if $DEBUG; + my ($tbl_id, $line, $cols, $udata) = @_; + die "unexpected state change in row" unless $state eq 'rows'; + die "unexpected table" unless $tbl_id eq '1'; + + die "invalid number of columns: ". join(', ', @$cols) + unless (scalar(@$cols) == $columncount); + + my $sql = "INSERT INTO $sourcefile VALUES(". + join(', ', map { s/\s*(\S[\S ]*?)\s*$/$1/; $s_dbh->quote($_) } @$cols). ")"; + $s_dbh->do($sql) or die "insert failed: ". $s_dbh->errstr; + $rowcount++; + warn "row $rowcount\n" unless ($rowcount % 1000); +} + +## now svc_acct from CSV files + +$FS::cust_main::import=1; +$FS::cust_pkg::disable_agentcheck = 1; +$FS::cust_svc::ignore_quantity = 1; + +my (%master_map) = (); +my (%referrals) = (); +my (%custid) = (); +my (%cancel) = (); +my (%susp) = (); +my (%adjo) = (); +my (%bill) = (); +my (%cust_pkg_map) = (); +my (%object_map) = (); +my (%package_cache) = (); +my $count = 0; + +my $d_dbh = adminsuidsetup $d_dbuser; +local $FS::UID::AutoCommit = 0; + +my @import = ( { 'file' => $radius_file, + 'sep_char' => ';', + 'fields' => [ qw( garbage1 username garbage2 garbage3 _password ) ], + 'fixup' => sub { + my $hash = shift; + delete $hash->{$_} + foreach qw (garbage1 garbage2 garbage3); + $hash->{'svcpart'} = $legacy_ppp_svcpart; + $hash->{'domsvc'} = $legacy_domain_svcnum; + ''; + }, + 'mapkey' => 'legacy_ppp', + 'skey' => 'username', + }, + { 'file' => $email_file, + 'sep_char' => ';', + 'fields' => [ qw( username null finger _password status garbage ) ], + 'fixup' => sub { + my $hash = shift; + #return 1 + # if $object_map{'legacy_ppp'}{$hash->{'username'}}; + delete $hash->{$_} + foreach qw (null status garbage); + $hash->{'svcpart'} = $legacy_email_svcpart; + $hash->{'domsvc'} = $legacy_domain_svcnum; + ''; + }, + 'mapkey' => 'legacy_email', + 'skey' => 'username', + }, +); + +while ( @import ) { + my $href = shift @import; + my $file = $href->{'file'} or die "No file specified"; + my (@fields) = @{$href->{'fields'}}; + my ($sep_char) = $href->{'sep_char'} || ';'; + my ($fixup) = $href->{'fixup'}; + my ($mapkey) = $href->{'mapkey'}; + my ($skey) = $href->{'skey'}; + my $line; + + my $csv = new Text::CSV_XS({'sep_char' => $sep_char}); + open(FH, $file) or die "cannot open $file: $!"; + $count = 0; + + while ( defined($line=<FH>) ) { + chomp $line; + + $line &= "\177" x length($line); # i hope this isn't really necessary + $csv->parse($line) + or die "cannot parse: " . $csv->error_input(); + + my @values = $csv->fields(); + my %hash; + foreach my $field (@fields) { + $hash{$field} = shift @values; + } + + if (@values) { + warn "skipping malformed line: $line\n"; + next; + } + + my $skip = &{$fixup}(\%hash) + if $fixup; + + unless ($skip) { + my $svc_acct = new FS::svc_acct { %hash }; + my $error = $svc_acct->insert; + if ($error) { + warn $error; + next; + } + + if ($skey && $mapkey) { + my $key = (ref($skey) eq 'CODE') ? &{$skey}($svc_acct) : $hash{$skey}; + $object_map{$mapkey}{$key} = $svc_acct->svcnum; + } + + $count++ + } + } + print "Imported $count service records\n"; + +} + + + +sub pkg_freq { + my ( $href ) = ( shift ); + my $once; + $href->{'one_time_list'} =~ /^\s*(\S[\S ]*?)\s*$/ && ($once = $1); + $once + ? 0 + : int(eval "$href->{'months_credit'} + 0"); +# int(eval "$href->{'month_credit'} + 0"); +} + +sub account_id { + my $href = shift; + if ($href->{'slave_account_id'} =~ /^\s*(\S[\S ]*?)\s*$/) { + "slave:$1"; + }else{ + my $l = $href->{cbilling_cycle_login}; + $l =~ /^\s*(\S[\S ]*?)\s*$/ && ($l = $1); + $l; + } +} + +sub b_or { + my ( $field, $hash ) = ( shift, shift ); + $field = 'billing_'. $field + if $hash->{'billing_use'} eq 'Billing Address'; + $hash->{$field}; +} + +sub p_or { + my ( $field, $hash ) = ( shift, shift ); + $field = 'billing_'. $field + if $hash->{'billing_use'} eq 'Billing Address'; + my $ac = ( $hash->{$field. '_area_code'} + && $hash->{$field. '_area_code'} =~ /^\d{3}$/ ) + ? $hash->{$field. '_area_code'}. '-' + : '903-' # wtf? + ; + ( $hash->{$field} && $hash->{$field} =~ /^\d{3}-\d{4}$/) + ? $ac. $hash->{$field} + : ''; +} + +sub or_b { + my ( $field, $hash ) = ( shift, shift ); + $hash->{'billing_use'} eq 'Billing Address' ? $hash->{$field} : ''; +} + +sub or_p { + my ( $field, $hash ) = ( shift, shift ); + $hash->{'billing_use'} eq 'Billing Address' && $hash->{$field} =~ /^\d{3}-\d{4}$/ + ? ( $hash->{$field. '_area_code'} =~ /^\d{3}$/ + ? $hash->{$field. '_area_code'}. '-' + : '903-' # wtf? + ). $hash->{$field} + : ''; +} + +my %payby_map = ( '' => 'BILL', + 'None' => 'BILL', + 'Credit Card' => 'CARD', + 'Bank Debit' => 'CHEK', + 'Virtual Check' => 'CHEK', +); +sub payby { + $payby_map{ shift->{billing_type} }; +} + +sub payinfo { + my $hash = shift; + my $payby = payby($hash); + my $info; + my $cc = + $hash->{'credit_card_number_1'}. + $hash->{'credit_card_number_2'}. + $hash->{'credit_card_number_3'}. + $hash->{'credit_card_number_4'}; + my $bank = + $hash->{'bank_account_number'}. + '@'. + $hash->{'bank_transit_number'}; + if ($payby eq 'CARD') { + $info = $cc; + }elsif ($payby eq 'CHEK') { + $info = $bank; + }elsif ($payby eq 'BILL') { + $info = $hash->{'blanket_purchase_order_number'}; + $bank =~ s/[^\d\@]//g; + $cc =~ s/\D//g; + if ( $bank =~ /^\d+\@\d{9}/) { + $info = $bank; + $payby = 'DCHK'; + } + if ( $cc =~ /^\d{13,16}/ ) { + $info = $cc; + $payby = 'DCRD'; + } + }else{ + die "unexpected payby"; + } + ($info, $payby); +} + +sub ut_name_fixup { + my ($object, $field) = (shift, shift); + my $value = $object->getfield($field); + $value =~ s/[^\w \,\.\-\']/ /g; + $object->setfield($field, $value); +} + +sub ut_text_fixup { + my ($object, $field) = (shift, shift); + my $value = $object->getfield($field); + $value =~ s/[^\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=\[\]]/ /g; + $object->setfield($field, $value); +} + +sub ut_state_fixup { + my ($object, $field) = (shift, shift); + my $value = $object->getfield($field); + $value = 'TX' if $value eq 'TTX'; + $object->setfield($field, $value); +} + +sub ut_zip_fixup { + my ($object, $field) = (shift, shift); + my $value = $object->getfield($field); + $value =~ s/[^-\d]//g; + $object->setfield($field, $value); +} + +my @tables = ( +part_pkg => { 'stable' => 'product', +#part_pkg => { 'stable' => 'billcycle', + 'mapping' => + { 'pkg' => sub { my $href = shift; + $href->{'description'} + ? $href->{'description'} + : $href->{'product_id'}; + }, + 'comment' => 'product_id', + 'freq' => sub { pkg_freq(shift) }, + 'recur_fee'=> sub { my $href = shift; + my $price = ( pkg_freq($href) + ? $href->{'unit_price'} + : 0 + ); + $price =~ s/[^\d.]//g; + $price = 0 unless $price; + sprintf("%.2f", $price); + }, + 'setuptax' => sub { my $href = shift; + $href->{'taxable'} ? '' : 'Y'; + }, + 'recurtax' => sub { my $href = shift; + $href->{'taxable'} ? '' : 'Y'; + }, + 'plan' => sub { 'flat' }, + 'disabled' => sub { 'Y' }, + 'pkg_svc' => sub { my $href = shift; + my $result = {}; + if (pkg_freq($href)){ + $result->{$legacy_ppp_svcpart} = 1; + $result->{$legacy_email_svcpart} = + $href->{emails_allowed} + if $href->{emails_allowed}; + } + }, + 'primary_svc'=> sub { pkg_freq(shift) + ? $legacy_ppp_svcpart + : '' + ; + }, + }, + 'fixup' => sub { my $part_pkg = shift; + my $row = shift; + unless ($part_pkg->pkg =~ /^\s*(\S[\S ]*?)\s*$/) { + warn "no pkg: ". $part_pkg->pkg. " for ". $row->{product_id}; + return 1; + } + + unless ($part_pkg->comment =~ /^\s*(\S[\S ]*?)\s*$/) { + warn "no comment: ". $part_pkg->comment. " for ". $row->{product_id}; + return 1; + } + + return 1 if exists($package_cache{$1}); + $package_cache{$1} = $part_pkg; + 1; + }, + 'wrapup' => sub { foreach (keys %package_cache) { + my $part_pkg = $package_cache{$_}; + my $options = + { map { my $v = $part_pkg->$_; + $part_pkg->$_(''); + ($_ => $v); + } + qw (setup_fee recur_fee) + }; + my $error = + $part_pkg->insert(options=>$options); + die "Error inserting package: $error" + if $error; + $count++ unless $error; + } + }, + }, +part_referral => { 'stable' => 'cust', + 'mapping' => + { 'agentnum' => sub { $agentnum }, + 'referral' => sub { my $r = shift->{'referred_from'}; + $referrals{$r} = 1; + }, + }, + 'fixup' => sub { 1 }, + 'wrapup' => sub { foreach (keys %referrals) { + my $part_referral = + new FS::part_referral( { + 'agentnum' => $agentnum, + 'referral' => $referrals{$_}, + } ); + my $error = $part_referral->insert; + die "Error inserting referral: $error" + if $error; + $count++ unless $error; + $referrals{$_} = $part_referral->refnum; + } + }, + }, +#svc_acct => { 'stable' => 'cust', +# 'mapping' => +# { 'username' => 'login', +# '_password' => 'password', +# 'svcpart' => sub{ $legacy_ppp_svcpart }, +# 'domsvc' => sub{ $legacy_domain_svcnum }, +# 'status' => 'status', +# }, +# 'fixup' => sub { my $svc_acct = shift; +# my $row = shift; +# my $id = $row->{'master_account'} +# ? 'slave:'. $row->{'customer_id'} +# : $row->{'login'}; +# my $status = $svc_acct->status; +# if ( $status ne 'Current' +# && $status ne 'On Hold' ) +# { +# $cancel{$id} = +# str2time($row->{termination_date}); +# warn "not creating (cancelled) svc_acct for " . +# $svc_acct->username. "\n"; +# return 1 +# } +# $susp{$id} = str2time($row->{hold_date}) +# if $status eq 'On Hold'; +# $adjo{$id} = str2time($row->{hold_date}) +# if ( $status eq 'Current' && +# $row->{hold_date} ); +# $bill{$id} = +# str2time($row->{expiration_date}); +# ''; +# }, +# 'skey' => sub { my $svc_acct = shift; +# my $row = shift; +# my $id = $row->{'master_account'} +# ? 'slave:'. $row->{'customer_id'} +# : $row->{'login'}; +# }, +# }, +cust_main => { 'stable' => 'cust', + 'mapping' => + { 'agentnum' => sub { $agentnum }, + 'agent_custid' => sub { my $id = shift->{'customer_number'}; + if (exists($custid{$id})) { + $custid{$id}++; + $id. chr(64 + $custid{$id}); + }else{ + $custid{$id} = 0; + $id; + } + }, + 'last' => sub { b_or('last_name', shift) || ' ' }, + 'first' => sub { b_or('first_name', shift) || ' ' }, + 'stateid' => 'drivers_license_number', + 'signupdate' => sub { str2time(shift->{'creation_date'}) }, + 'company' => sub { b_or('company_name', shift) }, + 'address1' => sub { b_or('address', shift) || ' ' }, + 'city' => sub { b_or('city', shift) || 'Paris' }, + 'state' => sub { uc(b_or('state', shift)) || 'TX' }, + 'zip' => sub { b_or('zip_code', shift) || '75460' }, + 'country' => sub { 'US' }, + 'daytime' => sub { p_or('phone', shift) }, + 'night' => sub { p_or('phone_alternate_1', shift) }, + 'fax' => sub { p_or('fax', shift) }, + 'ship_last' => sub { or_b('last_name', shift) }, + 'ship_first' => sub { or_b('first_name', shift) }, + 'ship_company' => sub { or_b('company_name', shift) }, + 'ship_address1'=> sub { or_b('address', shift) }, + 'ship_city' => sub { or_b('city', shift) }, + 'ship_state' => sub { uc(or_b('state', shift)) }, + 'ship_zip' => sub { or_b('zip_code', shift) }, + 'ship_daytime' => sub { or_p('phone', shift) }, + 'ship_fax' => sub { or_p('fax', shift) }, + 'tax' => sub { shift->{taxable} eq '' ? 'Y' : '' }, + 'refnum' => sub { $referrals{shift->{'referred_from'}} + || 1 + }, + }, + 'fixup' => sub { my $cust_main = shift; + my $row = shift; + + my ($master_account, $customer_id, $login) = + ('', '', ''); + $row->{'master_account'} =~ /^\s*(\S[\S ]*?)\s*$/ + && ($master_account = $1); + $row->{'customer_id'} =~ /^\s*(\S[\S ]*?)\s*$/ + && ($customer_id = $1); + $row->{'login'} =~ /^\s*(\S[\S ]*?)\s*$/ + && ($login = $1); + + my ($first, $last, $company) = + ('', '', ''); + $cust_main->first =~ /^\s*(\S[\S ]*?)\s*$/ + && ($first = $1); + $cust_main->last =~ /^\s*(\S[\S ]*?)\s*$/ + && ($last = $1); + $cust_main->company =~ /^\s*(\S[\S ]*?)\s*$/ + && ($company = $1); + + unless ($first || $last || $company) { + warn "bogus entry: ". $row->{'login'}; + return 1; + } + + my $id = $master_account + ? 'slave:'. $customer_id + : $login; + #my $id = $login; + my $status = $row->{status}; + + my $cancelled = 0; + if ( $status ne 'Current' + && $status ne 'current' + && $status ne 'On Hold' ) + { + $cancelled = 1; + $cancel{$login} = + str2time($row->{termination_date}); + } + $susp{$id} = str2time($row->{hold_date}) + if ($status eq 'On Hold' && !$cancelled); + $adjo{$id} = str2time($row->{hold_date}) + if ( $status eq 'Current' && !$cancelled && + $row->{hold_date} ); + $bill{$id} = + str2time($row->{expiration_date}) + if (!$cancelled); + + my $svcnum = + $object_map{legacy_ppp}{$row->{'login'} }; + unless( $cancelled || $svcnum || $status eq 'Pn Hold' ) { + warn "can't find svc_acct for legacy ppp ". + $row->{'login'}, "\n"; + } + + $object_map{svc_acct}{$id} = $svcnum + unless $cancelled; + + $master_map{$login} = $master_account + if $master_account; + return 1 if $master_account; + $cust_main->ship_country('US') + if $cust_main->has_ship_address; + ut_name_fixup($cust_main, 'first'); + ut_name_fixup($cust_main, 'company'); + ut_name_fixup($cust_main, 'last'); + + my ($info, $payby) = payinfo($row); + $cust_main->payby($payby); + $cust_main->payinfo($info); + + $cust_main->paycvv( + $row->{'credit_card_cvv_number'} + ) + if ($payby eq 'CARD' or $payby eq 'DCRD'); + + $cust_main->paydate('20'. + $row->{'credit_card_exp_date_2'}. '-'. + substr( + $row->{'credit_card_exp_date_1'}, + 0, + 2, + ). + '-01' + ) + if ($payby eq 'CARD' or $payby eq 'DCRD'); + + my $payname = ''; + $payname = $row->{'credit_card_name'} + if ($payby eq 'CARD' or $payby eq 'DCRD'); + $payname = $row->{'bank_name'} + if ($payby eq 'CHEK' or $payby eq 'DCHK'); + $cust_main->payname($payname); + + $cust_main->paytype( + $row->{'bank_account_to_debit'} + ? 'Personal '. + $row->{bank_account_to_debit} + : '' + ) + if ($payby eq 'CHEK' or $payby eq 'DCHK'); + + $cust_main->payby('BILL') + if ($cust_main->payby eq 'CHEK' && + $cust_main->payinfo !~ /^\d+\@\d{9}$/); + $cust_main->payby('BILL') + if ($cust_main->payby eq 'CARD' && + $cust_main->payinfo =~ /^\s*$/); + $cust_main->paydate('2037-12-01') + if ($cust_main->payby eq 'BILL'); + ut_text_fixup($cust_main, 'address1'); + ut_state_fixup($cust_main, 'state'); + ut_zip_fixup($cust_main, 'zip'); + + + ''; + }, + 'skey' => sub { my $object = shift; + my $href = shift; + my $balance = sprintf("%.2f", + $href->{balance_due}); + if ($balance < 0) { + my $cust_credit = new FS::cust_credit({ + 'custnum' => $object->custnum, + 'amount' => sprintf("%.2f", -$balance), + 'reasonnum' => $previous_credit_reasonnum, + }); + my $error = $cust_credit->insert; + warn "Error inserting credit for ", + $href->{'login'}, " : $error\n" + if $error; + + }elsif($balance > 0) { + my $error = $object->charge( + $balance, "Prior balance", + ); + warn "Error inserting balance charge for ", + $href->{'login'}, " : $error\n" + if $error; + + } + $href->{'login'}; + }, + }, +#cust_main => { 'stable' => 'cust', +# 'mapping' => +# { 'referred_by' => sub { my $href = shift; +# my $u = shift->{'login'}; +# my $cn = $href->{'customer_number'}; +# +# my $c = qsearch( 'cust_main', +# { 'custnum' => $cn } +# ) or die "can't fine customer $cn"; +# +# my $s = qsearch( 'svc_acct', +# { 'username' => $u } +# ) or return ''; +# +# my $n = $s->cust_svc +# ->cust_pkg +# ->cust_main +# ->custnum; +# +# $c->referral_custnum($n); +# my $error = $c->replace; +# die "error setting referral: $error" +# if $error; +# ''; +# }, +# }; +# 'fixup' => sub { 1 }, +# }, +cust_pkg => { 'stable' => 'billcycle', + 'mapping' => + { 'custnum' => sub { my $l = shift->{cbilling_cycle_login}; + $l =~ /^\s*(\S[\S ]*?)\s*$/ && ($l = $1); + my $r = $object_map{'cust_main'}{$l}; + unless ($r) { + my $m = $master_map{$l}; + $r = $object_map{'cust_main'}{$m} + if $m; + } + $r; + }, + 'pkgpart' => sub { my $href = shift; + my $p = $href->{product_id}; + $p =~ /^\s*(\S[\S ]*?)\s*$/ && ($p = $1); + my $pkg = $package_cache{$p} + if $package_cache{$p}; + + my $month = ''; + $href->{month_credit} =~ /\s*(\S[\S ]*?)\s*$/ && ($month = $1); + $month = int(eval "$month + 0"); + + my $price = 0; + $href->{unit_price} =~ /\s*(\S[\S ]*?)\s*$/ && ($price = $1); + $price = eval "$price + 0"; + + if ($pkg) { + $pkg = '' + unless $pkg->freq + 0 == $month; + + if ($pkg && ($pkg->freq + 0)) { + my $recur = 0; + $pkg->recur_fee =~ /\s*(\S[\S ]*?)\s*$/ && ($recur = $1); + $recur = eval "$recur + 0"; + $pkg = '' + unless $recur == $price; + } + + if ($pkg) { + $pkg = '' + unless $pkg->setuptax + eq ($href->{taxable} ? '' : 'Y'); + } + + } + + unless ($pkg) { + my $pkghref = { 'pkg' => ($href->{description} ? $href->{description} : $href->{product_id} ), + 'comment' => $href->{product_id}, + 'freq' => $month, + 'setuptax' => ($href->{'taxable'} ? '' : 'Y'), + 'recurtax' => ($href->{'taxable'} ? '' : 'Y'), + 'plan' => 'flat', + 'disabled' => 'Y', + }; + + my @pkgs = qsearch('part_pkg', $pkghref); + my $recur = sprintf("%.2f", ($month ? $price : 0)); + for (@pkgs) { + my %options = $_->options; + if ($options{recur_fee} eq $recur) { + $pkg = $_; + last; + } + } + + $pkghref->{recur_fee} = $recur + unless $pkg; + + my $pkg_svc = {}; + + if ($month){ + $pkg_svc->{$legacy_ppp_svcpart} = 1; + $pkg_svc->{$legacy_email_svcpart} = + $href->{emails_allowed} + if $href->{emails_allowed}; + } + $pkghref->{pkg_svc} = $pkg_svc; + $pkghref->{primary_svc} + = ( $month + ? $legacy_ppp_svcpart + : ''); + unless ($pkg) { + $pkg = new FS::part_pkg $pkghref; + my $options = + { map { my $v = $pkg->$_; + $pkg->$_(''); + ($_ => $v); + } + qw (setup_fee recur_fee) + }; + my $error = + $pkg->insert(options=>$options); + if ($error) { + warn "Error inserting pkg ". + join(", ", map{"$_ => ". $pkg->get($_)} fields $pkg). + ": $error\n"; + $pkg = ''; + } + } + } + $pkg ? $pkg->pkgpart : ''; + }, + 'setup' => sub { str2time(shift->{creation_date}) }, + 'bill' => sub { $bill{account_id(shift)} + #$bill{$href->{cbilling_cycle_login}}; + }, + 'susp' => sub { $susp{account_id(shift)} + #$susp{$href->{cbilling_cycle_login}}; + }, + 'adjo' => sub { $adjo{account_id(shift)} + #$adjo{$href->{cbilling_cycle_login}}; + }, + 'cancel' => sub { $cancel{account_id(shift)} + #$cancel{$href->{cbilling_cycle_login}}; + }, + }, + 'fixup' => sub { my ($object, $row) = (shift,shift); + unless ($object->custnum) { + warn "can't find customer for ". + $row->{cbilling_cycle_login}. "\n"; + return 1; + } + unless ($object->pkgpart) { + warn "can't find package for ". + $row->{product_id}. "\n"; + return 1; + } + ''; + }, + 'skey' => sub { my $object = shift; + my $href = shift; + my $id = $href->{'billing_cycle_item_id'}; + $id =~ /^\s*(\S[\S ]*?)\s*$/ && ($id = $1); + $cust_pkg_map{$id} = $object->pkgnum; + account_id($href); + }, + 'wrapup' => sub { for my $id (keys %{$object_map{'cust_pkg'}}){ + my $cust_svc = + qsearchs( 'cust_svc', { 'svcnum' => + $object_map{'svc_acct'}{$id} } + ); + unless ($cust_svc) { + warn "can't find legacy ppp $id\n"; + next; + } + $cust_svc-> + pkgnum($object_map{'cust_pkg'}{$id}); + my $error = $cust_svc->replace; + warn "error linking legacy ppp $id: $error\n" + if $error; + } + }, + }, +svc_acct => { 'stable' => 'email', + 'mapping' => + { 'username' => 'email_name', + '_password' => 'password', + 'svcpart' => sub{ $legacy_email_svcpart }, + 'domsvc' => sub{ $legacy_domain_svcnum }, + }, +# 'fixup' => sub { my ($object, $row) = (shift,shift); +# my ($sd,$sm,$sy) = split '/', +# $row->{shut_off_date} +# if $row->{shut_off_date}; +# if ($sd && $sm && $sy) { +# my ($cd, $cm, $cy) = (localtime)[3,4,5]; +# $cy += 1900; $cm++; +# return 1 if $sy < $cy; +# return 1 if ($sy == $cy && $sm < $cm); +# return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd); +# } +# return 1 if $object_map{'cust_main'}{$object->username}; +# ''; +# }, + 'fixup' => sub { my ($object, $row) = (shift,shift); + my ($sd,$sm,$sy) = split '/', + $row->{shut_off_date} + if $row->{shut_off_date}; + if ($sd && $sm && $sy) { + my ($cd, $cm, $cy) = (localtime)[3,4,5]; + $cy += 1900; $cm++; + return 1 if $sy < $cy; + return 1 if ($sy == $cy && $sm < $cm); + return 1 if ($sy == $cy && $sm == $cm && $sd <= $cd); + } + #return 1 if $object_map{'cust_main'}{$object->username}; + + my $email_name; + $row->{email_name} =~ /^\s*(\S[\S ]*?)\s*$/ + && ($email_name = $1); + + my $svcnum = + $object_map{legacy_email}{$email_name} + if $email_name; + unless( $svcnum ) { + warn "can't find svc_acct for legacy email ". + $row->{'email_name'}, "\n"; + return 1; + } + + $object_map{svc_acct}{'email:'.$row->{'email_customer_id'}} = $svcnum; + return 1; + }, +# 'skey' => sub { my $object = shift; +# my $href = shift; +# 'email:'. $href->{'email_customer_id'}; +# }, + 'wrapup' => sub { for my $id (keys %{$object_map{'svc_acct'}}){ + next unless $id =~ /^email:(\d+)/; + my $custid = $1; + my $cust_svc = + qsearchs( 'cust_svc', { 'svcnum' => + $object_map{'svc_acct'}{$id} } + ); + unless ($cust_svc) { + warn "can't find legacy email $id\n"; + next; + } + + if ($cust_svc->pkgnum) { + warn "service already linked for $id\n"; + next; + } + + $cust_svc-> + pkgnum($cust_pkg_map{$custid}); + if ($cust_svc->pkgnum){ + my $error = $cust_svc->replace; + warn "error linking legacy email $id: $error\n" + if $error; + }else{ + warn "can't find package for $id\n" + } + } + }, + }, +); + +#my $s_dbh = DBI->connect($s_datasrc, $s_dbuser, $s_dbpass) or die $DBI::errstr; + +while ( @tables ) { + my ($table, $href) = (shift @tables, shift @tables); + my $stable = $href->{'stable'} or die "No source table"; # good enough for now + my (%mapping) = %{$href->{'mapping'}}; + my ($fixup) = $href->{'fixup'}; + my ($wrapup) = $href->{'wrapup'}; + my ($id) = $href->{'id'}; + my ($skey) = $href->{'skey'}; + + #$d_dbh->do("delete from $table"); + + my $s_sth = $s_dbh->prepare("select count(*) from $stable"); + $s_sth->execute or die $s_sth->errstr; + my $rowcount = $s_sth->fetchrow_arrayref->[0]; + + $s_sth = $s_dbh->prepare("select * from $stable"); + $s_sth->execute or die $s_sth->errstr; + + my $row; + $count = 0; + while ( $row = $s_sth->fetchrow_hashref ) { + my $class = "FS::$table"; + + warn sprintf("%.2f", 100*$count/$rowcount). "% of $table processed\n" + unless( !$count || $count % 100 ); + + my $object = new $class ( { + map { $_ => ( ref($mapping{$_}) eq 'CODE' + ? &{$mapping{$_}}($row) + : $row->{$mapping{$_}} + ) + } + keys(%mapping) + } ); + my $skip = &{$fixup}($object, $row) + if $fixup; + + unless ($skip) { + my $error = $object->insert; + if ($error) { + warn "Error inserting $table ". + join(", ", map{"$_ => ". $object->get($_)} fields $object). + ": $error\n"; + next; + } + if ($skey) { + my $key = (ref($skey) eq 'CODE') ? &{$skey}($object, $row) + : $row->{$skey}; + $object_map{$table}{$key} = $object->get($object->primary_key) + } + $count++; + } + } + + &{$wrapup}() + if $wrapup; + + print "$count/$rowcount of $table SUCCESSFULLY processed\n"; + +} + +# link to any uncancelled package on customer +foreach my $username ( keys %{$object_map{'legacy_email'}} ) { + my $cust_svc = qsearchs( 'cust_svc', + { 'svcnum' => $object_map{legacy_email}{$username} } + ); + next unless $cust_svc; + next if $cust_svc->pkgnum; + + my $custnum = $object_map{cust_main}{$username}; + unless ($custnum) { + my $master = $master_map{$username}; + $custnum = $object_map{'cust_main'}{$master} + if $master; + next unless $custnum; + } + + #my $extra_sql = ' AND 0 != (select freq from part_pkg where '. + # 'cust_pkg.pkgpart = part_pkg.pkgpart )'; + my $extra_sql = " AND 'Prior balance' != (select pkg from part_pkg where ". + "cust_pkg.pkgpart = part_pkg.pkgpart )"; + + my @cust_pkg = qsearch( { + 'table' => 'cust_pkg', + 'hashref' => { 'custnum' => $custnum, + 'cancel' => '', + }, + 'extra_sql' => $extra_sql, + } ); + next unless scalar(@cust_pkg); + + $cust_svc->pkgnum($cust_pkg[0]->pkgnum); + $cust_svc->replace; +} + + +if ($dry_run) { + $d_dbh->rollback; +}else{ + $d_dbh->commit or die $d_dbh->errstr; +} + diff --git a/bin/import-tax-rates b/bin/import-tax-rates new file mode 100755 index 000000000..1cb76e0ba --- /dev/null +++ b/bin/import-tax-rates @@ -0,0 +1,56 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw($opt_c $opt_p $opt_t $opt_d $opt_z $opt_f); +use vars qw($DEBUG); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Conf; +use FS::tax_rate; +use FS::cust_tax_location; + +getopts('c:p:t:d:z:f:'); + +my $user = shift or die &usage; +my $dbh = adminsuidsetup $user; + +my ($format) = $opt_f =~ /^([-\w]+)$/; + +my @list = ( + 'CODE', $opt_c, \&FS::tax_class::batch_import, + 'PLUS4', $opt_p, \&FS::cust_tax_location::batch_import, + 'ZIP', $opt_z, \&FS::cust_tax_location::batch_import, + 'TXMATRIX', $opt_t, \&FS::part_pkg_taxrate::batch_import, + 'DETAIL', $opt_d, \&FS::tax_rate::batch_import, +); + +my $oldAutoCommit = $FS::UID::AutoCommit; +local $FS::UID::AutoCommit = 0; + +my $error = ''; + +while(@list) { + my ($name, $file, $method) = splice(@list, 0, 3); + + my $fh; + + $file =~ /^([\s\d\w.]+)$/ or die "Illegal filename: $file\n"; + $file = $1; + + my $f = $format; + $f .= '-zip' if $name eq 'ZIP'; + + open $fh, '<', $file or die "can't open $name file: $!\n"; + $error ||= &{$method}( { filehandle => $fh, 'format' => $f, } ); + + die "error while processing $file: $error" if $error; + close $fh; +} + +if ($error) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; +}else{ + $dbh->commit or die $dbh->errstr if $oldAutoCommit; +} + +sub usage { die "Usage:\nimport-tax-rates f FORMAT -c CODEFILE -p PLUS4FILE -z ZIPFILE -t TXMATRIXFILE -d DETAILFILE user\n\n"; } diff --git a/bin/ispman.ldap.import b/bin/ispman.ldap.import new file mode 100755 index 000000000..7495f47f8 --- /dev/null +++ b/bin/ispman.ldap.import @@ -0,0 +1,114 @@ +#!/usr/bin/perl -w + +use strict; +use Net::LDAP::LDIF; + +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearchs); +use FS::svc_domain; +use FS::svc_acct; + +my $user = shift or die; +adminsuidsetup($user); + +$FS::svc_Common::noexport_hack = 1; +$FS::svc_domain::whois_hack = 1; + +my $domain_svcpart = 1; +my $account_svcpart = 2; +my $mailbox_svcpart = 3; +my $fedweeknet_svcpart = 4; + +#my $ldif = +# Net::LDAP::LDIF->new( "ispman-06-23-04.ldif", "r", onerror => 'undef' ); +my $ldif = + Net::LDAP::LDIF->new( "ispman-06-23-04.ldif", "r", onerror => 'warn' ); + +#my %objectclass; + +my $acct = 0; +my $imported = 0; + +my $entry; +while ( $entry = $ldif->read_entry ) { + #warn "$entry\n"; + my %attributes = map { $_ => [ $entry->get_value( $_ ) ] } $entry->attributes; + + my $objectclass = join('/', @{$attributes{'objectclass'}} ); + + next unless $objectclass eq 'posixAccount/ispmanDomainUser/radiusprofile'; + + foreach my $attr ( keys %attributes ) { + print join( " => ", substr($attr.' 'x30,0,30), @{$attributes{ $attr }} ), "\n"; + #if ( $attr eq 'objectclass' ) { + # $objectclass{ join('/', @{$attributes{$attr}} ) }++; + #} + } + print "\n"; + + $acct++; + + my $email = $attributes{'maillocaladdress'}->[0]; + $email =~ /^(\w+)\@([\w\.\-]+)$/ or die $email; + die "$1 ne ". $attributes{'ispmanuserid'}->[0]. "\n" + unless lc($1) eq $attributes{'ispmanuserid'}->[0]; + my $username = lc($1); + my $domain = lc($2); + + my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ) + || new FS::svc_domain { 'svcpart' => $domain_svcpart, + 'domain' => $domain, + 'action' => 'N', + }; + + unless ( $svc_domain->svcnum ) { + my $error = $svc_domain->insert; + if ( $error ) { + die "inserting domain: $error\n"; + } + } + + ( my $password = $attributes{'userpassword'}->[0] ) =~ s/^\{crypt\}//; + + # pick svcpart + my $svcpart = $account_svcpart; + if ( $domain eq 'fedweeknet.com' ) { + $svcpart = $fedweeknet_svcpart; + } elsif ( $attributes{'dialupaccess'}->[0] =~ /(false|no)/i ) { + $svcpart = $mailbox_svcpart; + } + + my $dir = $attributes{'homedirectory'}->[0]; + $dir =~ s/\s+//g; + $dir =~ s/\@/_/; + + my $svc_acct = new FS::svc_acct { + 'svcpart' => $svcpart, + 'username' => $username, + '_password' => $password, + 'finger' => $attributes{'cn'}->[0], + 'domsvc' => $svc_domain->svcnum, + 'shell' => $attributes{'loginshell'}->[0], + 'uid' => $attributes{'uidnumber'}->[0], + 'gid' => $attributes{'gidnumber'}->[0], + 'dir' => $dir, + 'quota' => $attributes{'mailquota'}->[0], + }; + my $error = $svc_acct->insert; + #my $error = $svc_acct->check; + + if ( $error ) { + warn "$error\n"; + } else { + $imported++; + } + +} + +print "$imported of $acct imported\n"; + +#print "\n\n"; + +#foreach ( sort { $objectclass{$b} <=> $objectclass{$a} } keys %objectclass ) { +# print "$objectclass{$_}: $_\n"; +#} diff --git a/bin/japan.pl b/bin/japan.pl new file mode 100755 index 000000000..14e44e4ec --- /dev/null +++ b/bin/japan.pl @@ -0,0 +1,32 @@ +#!/usr/bin/perl + +use FS::UID qw( adminsuidsetup ); +use FS::Record qw( qsearch ); +use FS::cust_main_county; + +adminsuidsetup shift; + +my $country = 'JP'; + +foreach my $cust_main_county ( + qsearch('cust_main_county', { 'country' => $country } ) +) { + + if ( $cust_main_county->state =~ /\[([\w ]+)\]\s*$/ ) { + $cust_main_county->state($1); + my $error = $cust_main_county->replace; + die $error if $error; + } + +} + + +#use Locale::SubCountry; +# +##my $state = 'Tôkyô [Tokyo]'; +#my $state = 'Tottori'; +# +#my $lsc = new Locale::SubCountry 'JP'; +# +#print $lsc->code($state)."\n"; + diff --git a/bin/make-pkg-fruit b/bin/make-pkg-fruit new file mode 100755 index 000000000..61d707f4a --- /dev/null +++ b/bin/make-pkg-fruit @@ -0,0 +1,172 @@ +#!/usr/bin/perl -w + +use strict; +use FS::UID qw( adminsuidsetup ); +use FS::Record qw( qsearch qsearchs ); +use FS::part_export; +use FS::export_svc; +use FS::pkg_svc; +use FS::part_svc; +use FS::part_pkg; +use FS::cust_svc; +use FS::svc_Common; +use FS::svc_broadband; +use FS::part_svc_router; + +my $exporttype = 'prizm'; +my $pkg_property = 'pkg'; +my $svc_property = 'performance_profile'; + +my $user = shift or die &usage; + +$FS::svc_Common::noexport_hack = 1; +$FS::cust_svc::ignore_quantity = 1; +$FS::UID::AutoCommit = 0; + +my $DEBUG = 0; + +my $dbh = adminsuidsetup($user); + +my @exportnum = map { $_->exportnum } + qsearch( 'part_export', { 'exporttype' => $exporttype } ); + +die "no $exporttype exports found\n" unless scalar(@exportnum); + +my %pkg_svc_map = (); + +my @old_svcpart = (); +push @old_svcpart, map { $_->svcpart } + qsearch ( 'export_svc', { 'exportnum' => $_ } ) + foreach @exportnum; + +die "no svcparts found\n" unless scalar(@old_svcpart); + +foreach (@old_svcpart) { + foreach my $pkg_svc ( qsearch( 'pkg_svc', + { 'svcpart' => $_, + 'quantity' => { 'op' => '>', + 'value' => '0', + }, + } + ) + ) + { + warn "updating package ". $pkg_svc->pkgpart. "\n" if $DEBUG; + my $pkg_from = $pkg_svc->part_pkg->$pkg_property; + unless ( $pkg_svc_map{ $pkg_from }{ $pkg_svc->svcpart } ) { + my $old_part_svc = $pkg_svc->part_svc; + my $part_svc = new FS::part_svc( { $old_part_svc->hash } ); + $part_svc->svcpart(''); + + my $svcdb = $part_svc->svcdb; + foreach ( $old_part_svc->all_part_svc_column ) { + my $formatter = FS::part_svc->svc_table_fields($svcdb)->{$_}->{format} + || sub { shift }; + + $part_svc->setfield( $svcdb.'__'.$_->columnname.'_flag', $_->columnflag); + $part_svc->setfield( $svcdb.'__'.$_->columnname, + &$formatter($_->columnvalue) + ); + } + + my $formatter = + FS::part_svc->svc_table_fields($svcdb)->{$svc_property}->{format} + || sub { shift }; + $part_svc->setfield( $svcdb.'__'.$svc_property.'_flag', 'F'); + $part_svc->setfield( $svcdb.'__'.$svc_property, + &$formatter($pkg_svc->part_pkg->$pkg_property) + ); + my $error = $part_svc->insert( [], + { map { $_->exportnum => 1 } + $old_part_svc->part_export + }, + ); + die "error inserting service: $error\n" if $error; + + # this part is specific to svc_broadband + foreach (qsearch( 'part_svc_router', { 'svcpart' => $pkg_svc->svcpart } )) + { + my $part_svc_router = new FS::part_svc_router( { $_->hash } ); + $part_svc_router->svcrouternum( '' ); + $part_svc_router->svcpart( $part_svc->svcpart ); + my $error = $part_svc_router->insert; + die "error associating service with router: $error\n" if $error; + } + + $pkg_svc_map{ $pkg_from }{ $pkg_svc->svcpart } = $part_svc->svcpart; + + } + + my $new_pkg_svc = new FS::pkg_svc( { $pkg_svc->hash } ); + $new_pkg_svc->svcpart( $pkg_svc_map{ $pkg_from }{ $pkg_svc->svcpart } ); + my $error = $pkg_svc->delete; + die "error removing old service from package: $error\n" if $error; + $error = $new_pkg_svc->insert; + die "error adding new service to package: $error\n" if $error; + + } +} +warn "done with packages\n" if $DEBUG; + +foreach my $svcpart ( @old_svcpart ) { + foreach my $cust_svc ( qsearch( 'cust_svc', { 'svcpart' => $svcpart } ) ) { + my $svc_x = $cust_svc->svc_x; + my $cust_pkg = $cust_svc->cust_pkg; + die "can't handle unattached service ". $cust_svc->svcnum unless $cust_pkg; + my $pkg_from = $cust_pkg->part_pkg->$pkg_property; + $svc_x->setfield( $svc_property, $pkg_from ); + $svc_x->setfield( 'svcpart', $pkg_svc_map{ $pkg_from }{ $svcpart } ); + my $error = $svc_x->replace; + die "error replacing service ". $svc_x->svcnum. ": $error\n" if $error; + + $cust_svc->svcpart( $pkg_svc_map{ $pkg_from }{ $svcpart } ); + $error = $cust_svc->replace; + die "error replacing customer service ". $cust_svc->svcnum. ": $error\n" + if $error; + } + + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $svcpart } ); + die "can't find old part_svc!" unless $part_svc; + + my $new_part_svc = new FS::part_svc( { $part_svc->hash } ); + $new_part_svc->disabled('Y'); + my $svcdb = $part_svc->svcdb; + foreach ( $part_svc->all_part_svc_column ) { + my $formatter = FS::part_svc->svc_table_fields($svcdb)->{$_}->{format} + || sub { shift }; + + $part_svc->setfield( $svcdb.'__'.$_->columnname.'_flag', $_->columnflag); + $part_svc->setfield( $svcdb.'__'.$_->columnname, + &$formatter($_->columnvalue) + ); + } + my $error = $new_part_svc->replace($part_svc, '1.3-COMPAT'); + die "error disabling service: $error\n" if $error; +} + +$dbh->commit or die $dbh->errstr; +$dbh->disconnect or die $dbh->errstr; + + +sub usage { + die "Usage:\n\n make-pkg-fruit user\n"; +} + +=head1 NAME + +make-pkg-fruit - Tool to migrate package properties to services + +=head1 SYNOPSIS + + make-pkg-fruit + +=head1 DESCRIPTION + +Multiplies out services with package properties and migrates package +definitions and customer services to the new services. Read the source. + +=head1 SEE ALSO + +=cut + +1; diff --git a/bin/mapsecrets2access_user b/bin/mapsecrets2access_user new file mode 100755 index 000000000..d632360f5 --- /dev/null +++ b/bin/mapsecrets2access_user @@ -0,0 +1,87 @@ +#!/usr/bin/perl -w + +use strict; +use File::Copy "cp"; +use FS::UID qw(adminsuidsetup); +use FS::CurrentUser; +use FS::AccessRight; +use FS::Record qw(qsearchs qsearch); +use FS::access_group; +use FS::access_user; +use FS::access_usergroup; +use FS::access_right; +use FS::access_groupagent; +use FS::agent; + +$FS::CurrentUser::upgrade_hack = 1; +my $user = shift or die &usage; +adminsuidsetup $user; + +my $supergroup = qsearchs('access_group', { 'groupname' => 'Superuser' } ); +unless ( $supergroup ) { + + $supergroup = new FS::access_group { 'groupname' => 'Superuser' }; + my $error = $supergroup->insert; + die $error if $error; + + foreach my $rightname ( FS::AccessRight->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 new file mode 100755 index 000000000..509ef3ec8 --- /dev/null +++ b/bin/masonize @@ -0,0 +1,80 @@ +#!/usr/bin/perl + +foreach $file ( split(/\n/, `find . -depth -print`) ) { + next unless $file =~ /(cgi|html)$/; + open(F,$file) or die "can't open $file for reading: $!"; + @file = <F>; + #print "$file ". scalar(@file). "\n"; + close $file; + $newline = ''; #avoid prepending extraneous newlines + $all = join('',@file); + + $w = ''; + + $mode = 'html'; + while ( length($all) ) { + + if ( $mode eq 'html' ) { + + if ( $all =~ /^(.+?)(<%=?.*)$/s && $1 !~ /<%/s ) { + $w .= $1; + $all = $2; + next; + } elsif ( $all =~ /^<%=(.*)$/s ) { + $w .= '<%'; + $all = $1; + $mode = 'perlv'; + #die; + next; + } elsif ( $all =~ /^<%(.*)$/s ) { + $w .= $newline; $newline = "\n"; + $all = $1; + $mode = 'perlc'; + + #avoid newline prepend fix from borking indented first <% + $w =~ s/\n\s+\z/\n/; + $w .= "\n" if $w =~ /.+\z/; + + next; + } elsif ( $all !~ /<%/s ) { + $w .= $all; + last; + } else { + warn length($all); die; + } + die; + + } elsif ( $mode eq 'perlv' ) { + + if ( $all =~ /^(.*?%>)(.*)$/s ) { + $w .= $1; + $all=$2; + $mode = 'html'; + next; + } + die "unterminated <%= ??? (in $file):"; + + } elsif ( $mode eq 'perlc' ) { + + if ( $all =~ /^([^\n]*?)%>(.*)$/s ) { + $w .= "%$1\n"; + $all=$2; + $mode='html'; + next; + } + if ( $all =~ /^([^\n]*)\n(.*)$/s ) { + $w .= "%$1\n"; + $all=$2; + next; + } + + } else { die }; + + } + + system("chmod u+w $file"); + select W; $| = 1; select STDOUT; + open(W,">$file") or die "can't open $file for writing: $!"; + print W $w; + close W; +} diff --git a/bin/move-customers b/bin/move-customers new file mode 100755 index 000000000..a7ea19781 --- /dev/null +++ b/bin/move-customers @@ -0,0 +1,678 @@ +#!/usr/bin/perl -w + +#script to move customers from one installation to another +# source is remote, destination is local +# script is kinda-specific to a somewhat old source installation (1.7? older?) +# target installation has to be 1.9 (after 9/2009) + +use strict; +use vars qw( $sdbh ); +use DBI; +use FS::UID qw( adminsuidsetup dbh ); +use FS::Schema qw( dbdef ); +use FS::Record qw( qsearchs ); +use FS::agent; +use FS::cust_main; +use FS::part_pkg; +use FS::part_svc; +use FS::cust_bill_ApplicationCommon; +use FS::svc_Common; +use FS::cust_event; +use FS::svc_domain; +use FS::cust_pkg; + +my $DANGEROUS = 0; +my $DRY = 0; + +#ssh -p 2222 -L 1080:66.209.32.4:7219 -L 5454:localhost:5432 66.209.32.4 + +#my $source_datasrc = 'DBI:Pg:host=66.209.32.4;dbname=freeside;sslmode=require'; +my $source_datasrc = 'DBI:Pg:host=localhost;port=5454;dbname=freeside'; +my $source_user = 'readonly'; +my $source_pw = ''; + +#my @source_agents = ( 2, 7, 3, 4, 5, 1 ); +my @source_agents = ( 1, 2, 3, 4, 5, 7 ); + +my $dest_agent_typenum = 12; + +my $dest_refnum = 60; + +my $dest_legacy_credit_reasontype = 5; + +my $dest_pkg_classnum = 6; + +my %domsvc_map = ( + 1 => 20450, + 3653 => 20162, + 7634 => 20451, +); + +#testing +#my %eventparts = ( +# 'CARD' => [ 1, ], +# 'CHEK' => [], +# 'BILL' => [], +# 'DCHK' => [], +# 'DCRD' => [], +# 'COMP' => [], +#); +#production +my %eventparts = ( + 'CARD' => [ 1, ], + 'CHEK' => [ 2, ], + 'BILL' => [ 5, ], + 'DCHK' => [ 12, ], + 'DCRD' => [ 15, ], + 'COMP' => [], +); + +#-- + +# target(local) setup + +my $user = shift + or die "Usage:\n (edit variables at top of script and then)\n". + " move-customers user\n"; +adminsuidsetup $user; + +$FS::cust_main::ignore_expired_card = 1; +$FS::cust_main::ignore_expired_card = 1; +$FS::part_pkg::skip_pkg_svc_hack = 1; +$FS::part_pkg::skip_pkg_svc_hack = 1; +$FS::cust_bill_ApplicationCommon::skip_apply_to_lineitems_hack = 1; +$FS::cust_bill_ApplicationCommon::skip_apply_to_lineitems_hack = 1; +$FS::svc_Common::noexport_hack = 1; +$FS::svc_Common::noexport_hack = 1; +$FS::svc_domain::whois_hack = 1; +$FS::svc_domain::whois_hack = 1; +$FS::cust_pkg::disable_agentcheck = 1; +$FS::cust_pkg::disable_agentcheck = 1; + +my $void_paynum = 2147483646; #top of int range + +# -- + +# source(remote) setup + +$sdbh = DBI->connect($source_datasrc, $source_user, $source_pw) + or die $DBI::errstr; + +$sdbh->{ChopBlanks} = 1; + +# -- + +my %map = (); +$map{'_DOMSVC'} = \%domsvc_map; + +import_table('pkg_class', 'nomap' => 1); +import_table('svc_acct_pop', 'nomap' => 1); + +#XXX +#import_table('reason_type', 'nomap' => 1); +#foreach my $src_typenum ( keys %{ $map{'reason_type'} } ) { +# import_table('reason', 'reason_type' => $src_typenum, +# 'search' => 'reason_type', +# 'map' => 'reason_type', +# ); +#} + +my $agent_sth = $sdbh->prepare( + 'SELECT * FROM agent WHERE agentnum IN ( '. join(',', @source_agents ). ')' +) or die $sdbh->errstr; + +$agent_sth->execute or die $agent_sth->errstr; + + +while ( my $agentrow = $agent_sth->fetchrow_hashref ) { + + my $src_agent = $agentrow->{'agent'}; + + warn "importing customers for $src_agent\n"; + + my $agent = qsearchs('agent', { 'agent' => $src_agent, 'disabled' => '' } ); + + if ( $agent ) { + + warn " using existing agentnum ". $agent->agentnum. "\n"; + + if ( $DANGEROUS ) { + warn "DELETING ALL CUSTOMERS OF $src_agent locally \n"; + + foreach my $statement ( + 'DELETE FROM cust_main WHERE agentnum = '. $agent->agentnum, + ( map { "DELETE FROM $_ + WHERE 0 = ( SELECT COUNT(*) FROM cust_main + WHERE cust_main.custnum = $_.custnum ) + " + } + qw( + cust_credit + cust_main_invoice + cust_main_note + cust_pay + cust_refund + ) + ) + #pkg_class, part_pkg_pop + #part_pkg, pkg_svc, part_svc, part_svc_column + #XXX more... does it matter? + ) { + + #warn $statement; + my $sth = dbh->prepare($statement) or die dbh->errstr; + $sth->execute or die $sth->errstr; + + } + + dbh->commit or die dbh->errstr; + + } + + } else { + + warn " creating new agent...\n"; + + $agent = new FS::agent { 'agent' => $src_agent, + 'typenum' => $dest_agent_typenum }; + my $error = $agent->insert; + die $error if $error; + + warn " agentnum ". $agent->agentnum. "\n"; + + } + + $map{'agent'}->{ $agentrow->{'agentnum'} } = $agent->agentnum; + +} + + #my $customer_sth = $sdbh->prepare( + # 'SELECT * FROM cust_main WHERE agentnum = '. $agentrow->{'agentnum'} + #) or die $sdbh->errstr; +my $customer_sth = $sdbh->prepare( + 'SELECT * FROM cust_main WHERE agentnum IN ( '. join(',', @source_agents ). ') + ORDER BY custnum' +) or die $sdbh->errstr; + +$customer_sth->execute or die $customer_sth->errstr; + +while ( my $customerrow = $customer_sth->fetchrow_hashref ) { + + #use Data::Dumper; + # warn Dumper($customerrow); + my $src_custnum = $customerrow->{'custnum'}; + + warn " $src_custnum has referral_custnum ". $customerrow->{'referral_custnum'} + if $customerrow->{'referral_custnum'}; + + my $cust_main = new FS::cust_main { + %{ $customerrow }, + 'custnum' => '', + 'referral_custnum' => '', #restore afterwords? + 'refnum' => $dest_refnum, + 'agentnum' => $map{'agent'}->{ $customerrow->{'agentnum'} }, + 'agent_custid' => $src_custnum, + }; + + #$cust_main->ship_country('') if $cust_main->ship_country eq ' '; + #$cust_main->tax('') if $cust_main->tax =~ /^\s+$/; + + my $error = $cust_main->insert; + if ( $error ) { + warn "*** WARNING: error importing customer src custnum $src_custnum: $error"; + use Data::Dumper; + warn Dumper($cust_main) if $src_custnum == 6854; + next; + } + + warn "inserting dest customer ". $cust_main->custnum. " for $src_custnum\n"; + + $map{'cust_main'}->{$src_custnum} = $cust_main->custnum; + + #now import the relations, easy and hard: + + import_table( 'cust_main_note', 'custnum' => $src_custnum ); + + import_table( 'cust_pay', 'custnum' => $src_custnum, + #ivan showing up as cust_pay otaker + # old db doesn't have cust_pay.otaker, pull it from history + 'preinsert_callback' => sub { + my($row, $cust_pay) = @_; + + my $sth = $sdbh->prepare( + "SELECT history_user FROM h_cust_pay WHERE history_action = 'insert' + AND paynum = ". $row->{'paynum'} + ) or die $sdbh->errstr; + $sth->execute or die $sth->errstr; + my $otaker = $sth->fetchrow_arrayref->[0]; + + $cust_pay->otaker($otaker); + }, + ); + + # crap, cust_credit.reason is text in old db +#*** WARNING: error importing cust_credit src crednum 2200: failed to set reason for [ FS::cust_credit ]: at ./move-customers line 232. + import_table( 'cust_credit', 'custnum' => $src_custnum, + 'insert_opts' => [ 'reason_type' => $dest_legacy_credit_reasontype ], + 'preinsert_callback' => sub { + my($row, $object) = @_; + $object->set('reason', '(none)') if $object->get('reason') =~ /^\s*$/; + }, + ); + + import_table( 'cust_refund', 'custnum' => $src_custnum, + 'post_callback' => sub { + #my( $src_refundnum, $dst_refundnum ) = @_; + my $src_refundnum = shift; + + # cust_credit_refund (map refundnum and crednum...) + import_table( 'cust_credit_refund', + 'refundnum' => $src_refundnum, + 'search' => 'refundnum', + 'map' => 'cust_refund', + 'map2' => 'cust_credit', + 'map2key' => 'crednum', + ); + + # cust_pay_refund (map refundnum and paynum...) + import_table( 'cust_pay_refund', + 'refundnum' => $src_refundnum, + 'search' => 'refundnum', + 'map' => 'cust_refund', + 'map2' => 'cust_pay', + 'map2key' => 'paynum', + ); + + }, + ); + + # dunno what's up with this (ship_country ' ', fixed) +#*** WARNING: error importing customer src custnum 6854: Illegal (name) (error code illegal_name) ship_last: at ./move-customers line 129. + + # cust_pay_void + import_table( 'cust_pay_void', 'custnum' => $src_custnum, + 'preinsert_callback' => sub { + my($row, $object) = @_; + $object->paynum( $void_paynum-- ); + }, + ); + + # (not in old db: cust_attachment, cust_statement, cust_location, + # cust_main_exemption, cust_pay_pending ) + # (not used in old db: cust_pay_batch, cust_tax_exempt) + # (not useful to migrate: queue) + + #werid direct cust_main relations: + + # cust_pkg (part_pkg, part_svc, etc.) + import_table( 'cust_pkg', 'custnum' => $src_custnum, + 'preinsert_callback' => sub { + my($row, $object) = @_; + my $src_pkgpart = $row->{'pkgpart'} or die "wtf"; + my $dest_pkgpart = $map{'part_pkg'}->{$src_pkgpart}; + if ( $dest_pkgpart ) { + $object->pkgpart($dest_pkgpart); + return; + } + + my $sth = $sdbh->prepare( + "SELECT * FROM part_pkg WHERE pkgpart = $src_pkgpart" + ) or die $sdbh->errstr; + + $sth->execute or die $sth->errstr; + + my $part_pkg_row = $sth->fetchrow_hashref + or die "cust_pkg.pkgpart missing in part_pkg?!"; + + my $hashref = { + %{ $part_pkg_row }, + 'pkgpart' => '', + }; + my $src_classnum = $part_pkg_row->{'classnum'}; + $hashref->{'classnum'} = $map{'pkg_class'}->{ $src_classnum } + if $src_classnum; + + my $part_pkg = new FS::part_pkg $hashref; + + #$part_pkg->setuptax('') if $part_pkg->setuptax =~ /^\s+$/; + #$part_pkg->recurtax('') if $part_pkg->recurtax =~ /^\s+$/; + + my $error = $part_pkg->insert( 'options' => {} ); + die "*** FATAL: error importing part_pkg src pkgpart $src_pkgpart ". + ": $error" + if $error; + + $map{ 'part_pkg' }->{ $part_pkg_row->{'pkgpart'} } = $part_pkg->pkgpart; + + # part_pkg_option + import_table( 'part_pkg_option', + 'pkgpart' => $src_pkgpart, + 'search' => 'pkgpart', + 'map' => 'part_pkg', + ); + + my $osth = $sdbh->prepare( + "SELECT * FROM part_pkg_option WHERE pkgpart = $src_pkgpart" + ) or die $sdbh->errstr; + + # pkg_svc, part_svc, part_svc_column + import_table( 'pkg_svc', + 'pkgpart' => $src_pkgpart, + 'search' => 'pkgpart', + 'map' => 'part_pkg', + 'preinsert_callback' => sub { + + my($row, $object) = @_; + my $src_svcpart = $row->{'svcpart'} or die "wtf2"; + my $dest_svcpart = $map{'part_svc'}->{$src_svcpart}; + if ( $dest_svcpart ) { + $object->svcpart($dest_svcpart); + return; + } + + my $sth = $sdbh->prepare( + "SELECT * FROM part_svc WHERE svcpart = $src_svcpart" + ) or die $sdbh->errstr; + + $sth->execute or die $sth->errstr; + + my $part_svc_row = $sth->fetchrow_hashref + or die "svcpart missing in part_svc?!"; + + my $hashref = { + %{ $part_svc_row }, + 'svcpart' => '', + }; + + my $part_svc = new FS::part_svc $hashref; + $part_svc->disabled('') if $part_svc->disabled =~ /^\s+$/; + my $error = $part_svc->insert; + die "*** FATAL: error importing part_svc src svcpart $src_svcpart ". + ": $error" + if $error; + + $map{ 'part_svc' }->{ $part_svc_row->{'svcpart'} } = $part_svc->svcpart; + + # part_svc_column + import_table( 'part_svc_column', + 'svcpart' => $src_svcpart, + 'search' => 'svcpart', + 'map' => 'part_svc', + 'preinsert_callback' => sub { + my($row, $object) = @_; + if ( $object->columnname eq 'domsvc' ) { + $object->columnvalue( $map{'_DOMSVC'}->{ $object->columnvalue } ); + } + }, + ); + + #what we came here for in the first place + $object->svcpart( $part_svc->svcpart ); + + } + ); + + #what we came here for in the first place + $object->pkgpart( $part_pkg->pkgpart ); + + }, + + 'post_callback' => sub { + #my( $src_pkgnum, $dst_pkgnum ) = @_; + my $src_pkgnum = shift; + + #XXX grr... action makes this very hard... + ## cust_pkg_reason (shit, and bring in/remap reasons) + #import_table( 'cust_pkg_reason', + # 'pkgnum' => $src_pkgnum, + # 'search' => 'pkgnum', + # 'map' => 'cust_pkg', + # 'map2' => 'reason', + # 'map2key' => 'reasonnum', + # ); + + #cust_svc + import_table( 'cust_svc', + 'pkgnum' => $src_pkgnum, + 'search' => 'pkgnum', + 'map' => 'cust_pkg', + 'map2' => 'part_svc', + 'map2key' => 'svcpart', + 'post_callback' => sub { + #my( $src_svcnum, $dst_svcnum ) = @_; + my $src_svcnum = shift; + + #svc_domain + import_table( 'svc_domain', + 'svcnum' => $src_svcnum, + 'search' => 'svcnum', + 'map' => 'cust_svc', + 'noblank_primary' => 1, + ); + + #svc_acct + import_table( 'svc_acct', + 'svcnum' => $src_svcnum, + 'search' => 'svcnum', + 'map' => 'cust_svc', + 'noblank_primary' => 1, + 'map2' => 'svc_acct_pop', + 'map2key' => 'popnum', + #'map3' => 'svc_domain', + 'map3' => '_DOMSVC', + 'map3key' => 'domsvc', + ); + + #radius_usergroup + import_table( 'radius_usergroup', + 'svcnum' => $src_svcnum, + 'search' => 'svcnum', + 'map' => 'cust_svc', + ); + + #other svc_ tables not in old db + + }, + ); + + }, + + + + + ); + # end of cust_pkg (part_pkg, part_svc, etc.) + + # cust_bill (invnum move) + import_table( 'cust_bill', 'custnum' => $src_custnum, + 'preinsert_callback' => sub { + my($row, $object) = @_; + $object->agent_invid( $row->{'invnum'} ); + }, + 'post_callback' => sub { + my( $src_invnum, $dst_invnum ) = @_; + #my $src_invnum = shift; + + # cust_bill_pkg ( map invnum and pkgnum... ) + import_table( 'cust_bill_pkg', + 'invnum' => $src_invnum, + 'search' => 'invnum', + 'map' => 'cust_bill', + 'map2' => 'cust_pkg', + 'map2key' => 'pkgnum', + 'post_callback' => sub { + my $src_billpkgnum = shift; + + import_table( 'cust_bill_pkg_detail', + 'billpkgnum' => $src_billpkgnum, + 'search' => 'billpkgnum', + 'map' => 'cust_bill_pkg', + 'addl_from' => 'left join cust_bill_pkg using ( invnum, pkgnum )', + ); + + }, + ); + + # cust_credit_bill (map invnum and crednum... ) + import_table( 'cust_credit_bill', + 'invnum' => $src_invnum, + 'search' => 'invnum', + 'map' => 'cust_bill', + 'map2' => 'cust_credit', + 'map2key' => 'crednum', + 'post_callback' => sub { + my $src_creditbillnum = shift; + #map creditbillnum and billpkgnum + import_table( 'cust_credit_bill_pkg', + 'creditbillnum' => $src_creditbillnum, + 'search' => 'creditbillnum', + 'map' => 'cust_credit_bill', + 'map2' => 'cust_bill_pkg', + 'map2key' => 'billpkgnum', + ); + + }, + ); + + # cust_bill_pay (map invnum and paynum...) + import_table( 'cust_bill_pay', + 'invnum' => $src_invnum, + 'search' => 'invnum', + 'map' => 'cust_bill', + 'map2' => 'cust_pay', + 'map2key' => 'paynum', + 'post_callback' => sub { + my $src_billpaynum = shift; + #map billpaynum and billpkgnum + import_table( 'cust_bill_pay_pkg', + 'billpaynum' => $src_billpaynum, + 'search' => 'billpaynum', + 'map' => 'cust_bill_pay', + 'map2' => 'cust_bill_pkg', + 'map2key' => 'billpkgnum', + ); + }, + ); + + #need to do something about events. mark initial stuff as done + foreach my $eventpart ( @{ $eventparts{$cust_main->payby} } ) { + + my $cust_event = new FS::cust_event { + 'eventpart' => $eventpart, + 'tablenum' => $dst_invnum, + '_date' => time, # XXX something? probably not + 'status' => 'done', + }; + + my $error = $cust_event->insert; + die "*** FATAL: error inserting cust_event for eventpart $eventpart,". + " tablenum (invnum) $dst_invnum: $error" + if $error; + + } + + }, + ); + + # --- + + # (not in old db: cust_pkg_detail) + # (not used in old db: cust_bill_pay_batch, cust_pkg_option) + + # --- + + # (not in old db: cust_bill_pkg_display, cust_bill_pkg_tax_location, + # cust_bill_pkg_tax_rate_location, cust_tax_adjustment, cust_svc_option, ) + # (not used in old db: cust_tax_exempt_pkg) + + #do this last, so no notices go out + import_table( 'cust_main_invoice', 'custnum' => $src_custnum ); + + #dbh->commit or die dbh->errstr; + warn "customer ". $cust_main->custnum. " inserted\n"; + #exit; + +} + + +warn "import successful!\n"; +if ( $DRY ) { + warn "rolling back (dry run)\n"; + dbh->rollback or die dbh->errstr; + warn "rolled back\n" +} else { + warn "commiting\n"; + dbh->commit or die dbh->errstr; + warn "committed\n"; +} + +sub import_table { + my( $table, %opt ) = @_; + + eval "use FS::$table;"; + die $@ if $@; + + my $map = $opt{'map'} || 'cust_main'; + my $search = $opt{'search'} || 'custnum'; + + $opt{'insert_opts'} ||= []; + + my $primary_key = dbdef->table($table)->primary_key; + + my $addl_from = defined($opt{'addl_from'}) ? $opt{'addl_from'} : ''; + + my $sth = $sdbh->prepare( + "SELECT * FROM $table $addl_from ". + ( $opt{'nomap'} ? '' : " WHERE $search = ". $opt{$search} ) + ) or die $sdbh->errstr; + + $sth->execute or die "(searching $table): ". $sth->errstr; + + while ( my $row = $sth->fetchrow_hashref ) { + #my $src_custnum = $customerrow->{'custnum'}; + + my $hashref = { %$row }; + $hashref->{$primary_key} = '' + unless $opt{'noblank_primary'}; + $hashref->{ $search } = $map{$map}->{ $row->{$search} } + unless $opt{'nomap'}; + + if ( $opt{'map2'} ) { + my $key2 = $opt{'map2key'}; + $hashref->{$key2} = $map{ $opt{'map2'} }->{ $row->{$key2} } + unless $opt{map2key} eq 'pkgnum' && ( $row->{$key2} eq '0' + || $row->{$key2} eq '-1' + ) + or ! defined($row->{$key2}) + or $row->{$key2} eq ''; + #warn "map $opt{map2}.$opt{map2key}: ". $row->{$key2}. " to ". $map{ $opt{'map2'} }->{ $row->{$key2} }; + } + + if ( $opt{'map3'} ) { + my $key3 = $opt{'map3key'}; + $hashref->{$key3} = $map{ $opt{'map3'} }->{ $row->{$key3} }; + } + + my $object = eval "new FS::$table \$hashref;"; + die $@ if $@; + + &{ $opt{preinsert_callback} }( $row, $object ) + if $opt{preinsert_callback}; + + my $error = $object->insert( @{ $opt{'insert_opts'} } ); + if ( $error ) { + warn "*** WARNING: error importing $table src $primary_key ". $row->{$primary_key}. ": $error"; + next; + } + + $map{ $table }->{ $row->{$primary_key} } = $object->get($primary_key); + + &{ $opt{post_callback} }( $row->{$primary_key}, $object->get($primary_key) ) + if $opt{post_callback}; + + } + +} + +1; + diff --git a/bin/move-unlinked b/bin/move-unlinked new file mode 100755 index 000000000..0d31a49f3 --- /dev/null +++ b/bin/move-unlinked @@ -0,0 +1,99 @@ +#!/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/passwd.import b/bin/passwd.import new file mode 100755 index 000000000..8ab9e2ae3 --- /dev/null +++ b/bin/passwd.import @@ -0,0 +1,121 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw(%part_svc); +use Date::Parse; +use Term::Query qw(query); +use Net::SCP qw(iscp); +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(qsearch qsearchs); +use FS::svc_acct; +use FS::part_svc; + +my $user = shift or die &usage; +adminsuidsetup $user; + +push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others? + +my($spooldir)="/usr/local/etc/freeside/export.". datasrc; + +#$FS::svc_acct::nossh_hack = 1; +$FS::svc_Common::noexport_hack = 1; + +### + +%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'}); + +die "No services with svcdb svc_acct!\n" unless %part_svc; + +print "\n\n", &menu_svc, "\n", <<END; +Enter part number to import. +END +my($shell_svcpart)=&getpart; + +print "\n\n", <<END; +Enter the location and name of your _user_ passwd file, for example +"mail.isp.com:/etc/passwd" or "nis.isp.com:/etc/global/passwd" +END +my($loc_passwd)=&getvalue(":"); +iscp("root\@$loc_passwd", "$spooldir/passwd.import"); + +print "\n\n", <<END; +Enter the location and name of your _user_ shadow file, for example +"mail.isp.com:/etc/shadow" or "bsd.isp.com:/etc/master.passwd" +END +my($loc_shadow)=&getvalue(":"); +iscp("root\@$loc_shadow", "$spooldir/shadow.import"); + +sub menu_svc { + ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n"; +} +sub getpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %part_svc ]; + $^W=1; + $return; +} +sub getvalue { + my $prompt = shift; + $^W=0; # Term::Query isn't -w-safe + my $return = query $prompt, ''; + $^W=1; + $return; +} + +print "\n\n"; + +### + +open(PASSWD,"<$spooldir/passwd.import"); +open(SHADOW,"<$spooldir/shadow.import"); + +my(%password); +while (<SHADOW>) { + chop; + my($username,$password)=split(/:/); + #$password =~ s/^\!$/\*/; + #$password =~ s/\!+/\*SUSPENDED\* /; + $password =~ s/^NP$/\*/; + $password =~ s/^\*LK\*$/\*/; + $password{$username}=$password; +} + +while (<PASSWD>) { + chop; + my($username,$x,$uid,$gid,$finger,$dir,$shell) = split(/:/); + my $password = $password{$username}; + + my $svcpart = $shell_svcpart; + + #if ( qsearchs('svc_acct', { 'username' => $username } ) ) { + # warn "warning: $username already exists; skipping\n"; + # next; + #} + + my($svc_acct) = new FS::svc_acct ({ + 'svcpart' => $svcpart, + 'username' => $username, + '_password' => $password, + 'uid' => $uid, + 'gid' => $gid, + 'finger' => $finger, + 'dir' => $dir, + 'shell' => $shell, + #%{$allparam{$username}}, + }); + my($error); + $error=$svc_acct->insert; + if ( $error ) { + if ( $error =~ /duplicate/i ) { + warn "$username: $error"; + } else { + die "$username: $error"; + } + } + +} + +sub usage { + die "Usage:\n\n passwd.import user\n"; +} + diff --git a/bin/payment-faker b/bin/payment-faker new file mode 100755 index 000000000..03316e1c0 --- /dev/null +++ b/bin/payment-faker @@ -0,0 +1,54 @@ +#!/usr/bin/perl + +use Date::Parse; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_pay; +use FS::cust_credit; + +my $user; +$user = shift or die "usage: payment-faker $user"; +adminsuidsetup($user); + +for $month ( 1 .. 11 ) { + + print "month $month\n"; + + system(qq!freeside-daily -d "$month/1/2006" $user!); + + foreach my $cust_main ( qsearch('cust_main', {} ) ) { + next unless $cust_main->balance > 0; + my $item = ''; + if ( rand() > .95 ) { + $item = new FS::cust_credit { + 'amount' => $cust_main->balance, + '_date' => str2time("$month/1/2006"), + 'reason' => 'testing', + }; + } else { + + if ( rand() > .5 ) { + $payby = 'BILL'; + $payinfo = int(rand(10000)); + } else { + $payby = 'CARD'; + $payinfo = '4111111111111111'; + } + + $item = new FS::cust_pay { + 'paid' => $cust_main->balance, + '_date' => str2time("$month/1/2006"), + 'payby' => $payby, + 'payinfo' => $payinfo, + }; + } + + $item->custnum($cust_main->custnum); + my $error = $item->insert; + die $error if $error; + $cust_main->apply_payments; + $cust_main->apply_credits; + + } + +} diff --git a/bin/pg-readonly b/bin/pg-readonly new file mode 100644 index 000000000..ad69fbde2 --- /dev/null +++ b/bin/pg-readonly @@ -0,0 +1,24 @@ +#!/usr/bin/perl +# +# hack to update/add read-only permissions for a user on the db +# +# usage: pg-readonly freesideuser readonlyuser + +use strict; +use DBI; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(dbdef); + +my $user = shift or die &usage; +my $rouser = shift or die &usage; + +my $dbh = adminsuidsetup $user; + +foreach my $table ( dbdef->tables ) { + $dbh->do("GRANT SELECT ON $table TO $rouser"); + $dbh->commit(); + if ( my $pkey = dbdef->table($table)->primary_key ) { + $dbh->do("GRANT SELECT ON ${table}_${pkey}_seq TO $rouser"); + $dbh->commit(); + } +} diff --git a/bin/pg-version b/bin/pg-version new file mode 100755 index 000000000..b6cddb612 --- /dev/null +++ b/bin/pg-version @@ -0,0 +1,13 @@ +#!/usr/bin/perl -w + +use strict; +use FS::UID qw(adminsuidsetup dbh); + +my $user = shift or die &usage; +adminsuidsetup($user); + +print "pg_server_version: ". dbh->{'pg_server_version'}. "\n"; + +sub usage { + "\n\nUsage: pg-version username\n"; +}; diff --git a/bin/ping b/bin/ping new file mode 100755 index 000000000..605a2047e --- /dev/null +++ b/bin/ping @@ -0,0 +1,58 @@ +#!/usr/bin/perl + +use Net::Ping; +use Net::SSH qw( ssh_cmd ); +use Email::Send; + +my @other_hosts = ( 'freeside.biz', 'saturn5.com' ); + +my( $machine, @emails ) = @ARGV; +die "no notification email given" unless @emails; + +my $ping = new Net::Ping; # 'icmp'; #requires root + +my $pong = ''; +# can't tcp ping... $ping->ping($machine) and +$pong = eval { ssh_cmd('freeside@'.$machine, 'echo pong') }; +#(command ignored if authorized_keys setup w/command=) + +if ( $@ || $pong !~ /pong/ ) { #houston, we may have a problem + + #warn "can't reach $machine, checking @other_hosts\n"; + + #let's do a sanity check, can we see some other hosts? + exit unless grep $ping->ping($_), @other_hosts; + + #uh-oh, this is bad. + + #warn "checking to see if we've alerted on this recently\n"; + + #but we don't want to be too noisy, have we alerted on this in the last 24h? + my $file = "/tmp/alert-$machine"; + exit if -e $file && -M $file < 1; + + open(FILE, ">>$file"); + print FILE "emailing\n"; + close FILE; + + #warn "emailing alerts\n"; + + foreach my $email ( @emails ) { + + my $message = <<"__MESSAGE__"; +From: support\@freeside.biz +To: $email +Subject: ALERT - $machine + +ALERT: $machine appears to be down. + +__MESSAGE__ + + my $sender = Email::Send->new({mailer => 'SMTP'}); + $sender->mailer_args([Host => 'mail.freeside.biz']); + $sender->send($message); + + } + +} + diff --git a/bin/pod2x b/bin/pod2x new file mode 100755 index 000000000..ecb7f913b --- /dev/null +++ b/bin/pod2x @@ -0,0 +1,145 @@ +#!/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 new file mode 100755 index 000000000..61380da59 --- /dev/null +++ b/bin/postfix.export @@ -0,0 +1,122 @@ +#!/usr/bin/perl -w + +use strict; +#use File::Path; +use File::Rsync; +use Net::SSH qw(ssh); +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(qsearch); # qsearchs); +use FS::part_export; +#use FS::cust_pkg; +use FS::cust_svc; +#use FS::svc_domain; + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/postfix"; +mkdir $spooldir, 0700 unless -d $spooldir; + +my @exports = qsearch('part_export', { 'exporttype' => 'postfix' } ); + +my $rsync = File::Rsync->new({ + rsh => 'ssh', +# dry_run => 1, +}); + +foreach my $export ( @exports ) { + + my $machine = $export->machine; + my $prefix = "$spooldir/$machine"; + mkdir $prefix, 0700 unless -d $prefix; + + #construct %domain hash + + my $mydomain = $export->option('mydomain'); + my %domain; + foreach my $svc_forward ( $export->svc_x ) { + + my( $username, $domain ); + my $srcsvc_acct = $svc_forward->srcsvc_acct; + if ( $srcsvc_acct ) { + ( $username, $domain ) = ( $srcsvc_acct->username, $srcsvc_acct->domain ); + } elsif ( $svc_forward->src =~ /^([^@]*)\@([^@]+)$/ ) { + ( $username, $domain ) = ( $1, $2 ); + } else { + die "bad svc_forward record? svcnum ". $svc_forward->svcnum. "\n"; + } + + my( $dusername, $ddomain ); + my $dstsvc_acct = $svc_forward->dstsvc_acct; + if ( $dstsvc_acct ) { + $dusername = $dstsvc_acct->username; + $ddomain = $dstsvc_acct->domain; + } elsif ( $svc_forward->dst =~ /([^@]+)\@([^@]+)$/ ) { + ( $dusername, $ddomain ) = ( $1, $2 ); + } else { + die "bad svc_forward record? svcnum ". $svc_forward->svcnum. "\n"; + } + my $dest; + if ( $ddomain eq $mydomain ) { + $dest = $dusername; + } else { + $dest = "$dusername\@$ddomain"; + } + + push @{$domain{$domain}{$username}}, $dest; + + } + + #write aliases + + my $aliases = delete $domain{$mydomain}; + open(ALIASES, ">$prefix/aliases") or die "can't open $prefix/aliases: $!"; + foreach my $alias ( keys %$aliases ) { + print ALIASES "$alias: ". join(',', @{ $aliases->{$alias} } ). "\n"; + } + close ALIASES; + + #write virtual + + open(VIRTUAL, ">$prefix/virtual") or die "can't open $prefix/virtual: $!"; + foreach my $domain ( keys %domain ) { + print VIRTUAL "$domain DOMAIN\n"; + #foreach my $virtual ( sort { $a ne '' <=> $b ne '' } keys %{$domain{$domain}} ) { + foreach my $virtual ( sort { ( ($b ne '') <=> ($a ne '') ) || $a cmp $b } keys %{$domain{$domain}} ) { + print VIRTUAL "$virtual\@$domain ". + join(',', @{ $domain{$domain}{$virtual} } ). "\n"; + } + print VIRTUAL "\n"; + } + close VIRTUAL; + + #rsync + + my $user = $export->option('user'); + $rsync->exec( { + src => "$prefix/aliases", + dest => "$user\@$machine:". $export->option('aliases'), + } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err); +# warn $rsync->out; + + ssh("$user\@$machine", $export->option('newaliases') || 'newaliases'); +# ssh("$user\@$machine", "postfix reload"); + + $rsync->exec( { + src => "$prefix/virtual", + dest => "$user\@$machine:". $export->option('virtual'), + } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err); +# warn $rsync->out; + ssh("$user\@$machine", $export->option('postmap') + || 'postmap hash:/etc/postfix/virtual'); + ssh("$user\@$machine", $export->option('reload') || 'postfix reload'); + +} + +# ----- + +sub usage { + die "Usage:\n postfix.export user\n"; +} + + diff --git a/bin/postfix_courierimap.import b/bin/postfix_courierimap.import new file mode 100755 index 000000000..12c138b49 --- /dev/null +++ b/bin/postfix_courierimap.import @@ -0,0 +1,137 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw(%part_svc %domain_part_svc); +#use Date::Parse; +use DBI; +use Term::Query qw(query); +use FS::UID qw(adminsuidsetup); #datasrc +use FS::Record qw(qsearch qsearchs); +use FS::svc_acct; +use FS::part_svc; +use FS::svc_domain; + +my $user = shift or die &usage; +adminsuidsetup $user; + +#push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others? + +$FS::svc_Common::noexport_hack = 1; +$FS::svc_domain::whois_hack = 1; + +### + +%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'}); + +die "No services with svcdb svc_acct!\n" unless %part_svc; + +print "\n\n", &menu_svc, "\n", <<END; +Enter part number to import. +END +my $mailbox_svcpart = &getpart; + +%domain_part_svc = map { $_->svcpart, $_ } + qsearch('part_svc', { 'svcdb' => 'svc_domain'} ); + +die "No services with svcdb svc_domain!\n" unless %domain_part_svc; + +print "\n\n", &menu_domain_svc, "\n", <<END; +Enter part number for domains. +END +my $domain_svcpart = &getdomainpart; + +my $datasrc = &getvalue("\n\nEnter the DBI datasource:"); +my $db_user = &getvalue("\n\nEnter the database user:"); +my $db_pass = &getvalue("\n\nEnter the database password:"); + +sub menu_svc { + ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n"; +} +sub menu_domain_svc { + ( join "\n", map "$_: ".$domain_part_svc{$_}->svc, sort keys %domain_part_svc ). "\n"; +} +sub getpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %part_svc ]; + $^W=1; + $return; +} +sub getdomainpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %domain_part_svc ]; + $^W=1; + $return; +} +sub getvalue { + my $prompt = shift; + $^W=0; # Term::Query isn't -w-safe + my $return = query $prompt, ''; + $^W=1; + $return; +} + +print "\n\n"; + +### + +my $dbh = DBI->connect( $datasrc, $db_user, $db_pass ) + or die $DBI::errstr; + +my $sth = $dbh->prepare('SELECT username, password, crypt, name, domain FROM mailbox') + or die $dbh->errstr; +$sth->execute or die $sth->errstr; + +my $row; +while ( defined ( $row = $sth->fetchrow_arrayref ) ) { + my( $r_username, $password, $crypt, $finger, $r_domain ) = @$row; + + my( $username, $domain ); + if ( $r_username =~ /^([^@]+)\@([^@]+)$/ ) { + $username = $1; + $domain = $2; + } else { + $username = $r_username; + $domain = $r_domain; + } + my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ) + || new FS::svc_domain { + 'domain' => $domain, + 'svcpart' => $domain_svcpart, + 'action' => 'N', + }; + unless ( $svc_domain->svcnum ) { + my $error = $svc_domain->insert; + if ( $error ) { + die "can't insert domain $domain: $error\n"; + } + } + + $password = $crypt if $password eq '*CRYPTED*'; + + $finger =~ s/Outdoor Power.*$/Outdoor Power/; + + my $svc_acct = new FS::svc_acct { + 'svcpart' => $mailbox_svcpart, + 'username' => $username, + 'domsvc' => $svc_domain->svcnum, + '_password' => $password, + 'finger' => $finger, + }; + + my $error = $svc_acct->insert; + #my $error = $svc_acct->check; + if ( $error ) { + if ( $error =~ /duplicate/i ) { + warn "$r_username / $r_domain: $error"; + } else { + die "$r_username / $r_domain: $error"; + } + } + +} + +sub usage { + die "Usage:\n\n postfix_courierimap.import user\n"; +} + + diff --git a/bin/print-directory_assist b/bin/print-directory_assist new file mode 100755 index 000000000..4c5e4a861 --- /dev/null +++ b/bin/print-directory_assist @@ -0,0 +1,12 @@ +#!/usr/bin/perl -w + +use strict; + +my $acs = `cut -c1-3 ../etc/areacodes.txt`; + +my $plus = ''; +foreach my $npa ( split(/\n/, $acs ) ) { + warn $npa; + $plus .= $npa. '5551212,'; +} +print "$plus\n"; diff --git a/bin/print-schema b/bin/print-schema new file mode 100755 index 000000000..886e3250b --- /dev/null +++ b/bin/print-schema @@ -0,0 +1,7 @@ +#!/usr/bin/perl + +use DBIx::DBSchema; + +$l = load DBIx::DBSchema "/usr/local/etc/freeside/dbdef.DBI:Pg:dbname=freeside"; + +print $l->pretty_print, "\n"; diff --git a/bin/rate-us.import b/bin/rate-us.import new file mode 100755 index 000000000..66ac5de94 --- /dev/null +++ b/bin/rate-us.import @@ -0,0 +1,109 @@ +#!/usr/bin/perl -w + +use strict; +#use Spreadsheet::ParseExcel; +use DBI; +use FS::UID qw(adminsuidsetup); +use FS::rate_region; +use FS::rate_prefix; +use FS::rate_region; + +my $ratenum = 1; + +my $user = shift or usage(); +adminsuidsetup $user; + +sub usage { + #die "Usage:\n\n rate.import user rates.xls worksheet_name"; + die "Usage:\n\n rate.import user"; +} + +my %rate_region; + +foreach my $file ( 'areas and rates US.xls', + 'areas and rates US2.xls', + 'areas and rates US3.xls', + ) +{ + + my $dbh = DBI->connect("DBI:Excel:file=$file") + or die "can't connect: $DBI::errstr"; + + #my $table = shift or usage(); + my $table = 'Sheet1'; + my $sth = $dbh->prepare("select * from $table") + or die "can't prepare: ". $dbh->errstr; + $sth->execute + or die "can't execute: ". $sth->errstr; + + while ( my $row = $sth->fetchrow_hashref ) { + + #print join(' - ', map $row->{$_}, qw( rate_center Code Area_Prefix Rate ) ). "\n"; + + my $regionname = $row->{'rate_center'}; + $regionname =~ s/\xA0//g; + #$regionname =~ s/\xE9/e/g; #e with accent aigu + $regionname =~ s/(^\s+|\s+$)//; + $regionname .= ', USA'; + + my $prefix = $row->{'area_prefix'}; + $prefix =~ s/\xA0//g; + $prefix =~ s/\s$//; + #my $prefixprefix = ''; + #if ( $prefix =~ /^\s*(\d+)\s*\((.*)\)\s*$/ ) { + # $prefixprefix = $1; + # $prefix = $2; + #} elsif ( $prefix =~ /^\s*\((\d{3})\)\s*(.*)$/ ) { + # $prefixprefix = $1; + # $prefix = $2; + #} + + my @rate_prefix = map { + #warn $row->{'rate_center'}. ": $prefixprefix$_\n"; + new FS::rate_prefix { + 'countrycode' => '1', # $row->{'Country'} + #'npa' => $prefixprefix.$_, + 'npa' => $_, + }; + } + split(/\s*[;,]\s*/, $prefix); + + + my $dest_detail = new FS::rate_detail { + 'ratenum' => $ratenum, + 'min_included' => 0, + 'min_charge' => + sprintf('%.2f', $row->{'rate'} ), + 'sec_granularity' => 60, + }; + + unless ( exists $rate_region{$regionname} ) { + + my $rate_region = new FS::rate_region { + 'regionname' => $regionname, + }; + + my $error = $rate_region->insert( 'rate_prefix' => \@rate_prefix, + 'dest_detail' => [ $dest_detail ], + ); + die $error if $error; + + $rate_region{$regionname} = $rate_region->regionnum; + + } else { + + foreach my $rate_prefix ( @rate_prefix ) { + $rate_prefix->regionnum($rate_region{$regionname}); + my $error = $rate_prefix->insert; + die $error if $error; + } + + #$rate_detail->dest_regionnum($rate_region{$regionname}); + #$error = $rate_detail->insert; + #die $error if $error; + + } + + } + +} diff --git a/bin/rate.delete b/bin/rate.delete new file mode 100644 index 000000000..7b7e4bcf5 --- /dev/null +++ b/bin/rate.delete @@ -0,0 +1,3 @@ +#delete from rate_detail where ratenum = 18; +#delete from rate_region where 0 = ( select count(*) from rate_detail where rate_region.regionnum = rate_detail.dest_regionnum ); +#delete from rate_prefix where 0 = ( select count(*) from rate_region where rate_prefix.regionnum = rate_region.regionnum ); diff --git a/bin/rate.import b/bin/rate.import new file mode 100755 index 000000000..fdd756d72 --- /dev/null +++ b/bin/rate.import @@ -0,0 +1,95 @@ +#!/usr/bin/perl + +use strict; +#use Spreadsheet::ParseExcel; +use DBI; +use FS::UID qw(adminsuidsetup); +use FS::rate_region; +use FS::rate_prefix; +use FS::rate_region; + +my $ratenum = 1; + +my $user = shift or usage(); +adminsuidsetup $user; + +#my $file = shift or usage(); +my $file = 'areas and rates.xls'; +my $dbh = DBI->connect("DBI:Excel:file=$file") + or die "can't connect: $DBI::errstr"; + +#my $table = shift or usage(); +my $table = 'areas_and_rates'; +my $sth = $dbh->prepare("select * from $table") + or die "can't prepare: ". $dbh->errstr; +$sth->execute + or die "can't execute: ". $sth->errstr; + +sub usage { + #die "Usage:\n\n rate.import user rates.xls worksheet_name"; + die "Usage:\n\n rate.import user"; +} + +## + +while ( my $row = $sth->fetchrow_hashref ) { + + #print join(' - ', map $row->{$_}, qw( Country Code Area_Prefix Rate ) ). "\n"; + + my $regionname = $row->{'Country'}; + $regionname =~ s/\xA0//g; + $regionname =~ s/\xE9/e/g; #e with accent aigu + $regionname =~ s/(^\s+|\s+$)//; + + #next if $regionname =~ /Sweden Telia Mobile/; + + my $rate_region = new FS::rate_region { + 'regionname' => $regionname, + }; + + my $prefix = $row->{'Area_Prefix'}; + $prefix =~ s/\xA0//g; + $prefix =~ s/\s$//; + my $prefixprefix = ''; + if ( $prefix =~ /^\s*(\d+)\s*\((.*)\)\s*$/ ) { + $prefixprefix = $1; + $prefix = $2; + } elsif ( $prefix =~ /^\s*\((\d{3})\)\s*(.*)$/ ) { + $prefixprefix = $1; + $prefix = $2; + } + + my @rate_prefix = (); + if ( $prefix =~ /\d/ ) { + + @rate_prefix = map { + #warn $row->{'Country'}. ": $prefixprefix$_\n"; + new FS::rate_prefix { + 'countrycode' => $row->{'Code'}, + 'npa' => $prefixprefix.$_, + }; + } + split(/\s*[;,]\s*/, $prefix); + + } else { + @rate_prefix = ( new FS::rate_prefix { + 'countycode' => $row->{'Code'}, + 'npa' => '', + }; + ); + } + + my $dest_detail = new FS::rate_detail { + 'ratenum' => $ratenum, + 'min_included' => 0, + 'min_charge' => + sprintf('%.2f', $row->{'Rate'} ), + 'sec_granularity' => 60, + }; + + my $error = $rate_region->insert( 'rate_prefix' => \@rate_prefix, + 'dest_detail' => [ $dest_detail ], + ); + die $error if $error; + +} diff --git a/bin/rebill b/bin/rebill new file mode 100755 index 000000000..4f052384d --- /dev/null +++ b/bin/rebill @@ -0,0 +1,132 @@ +#!/usr/bin/perl -w + +use strict; +use Getopt::Std; +use Date::Parse; +use FS::UID qw(adminsuidsetup); +use FS::Record qw( qsearch ); +use cust_main_special; + +&untaint_argv; #what it sounds like (eww) +use vars qw(%opt); +getopts("p:a:d:sy:n", \%opt); + +my $user = shift or die &usage; +adminsuidsetup $user; + +my (@custnums) = @ARGV; + +my $time = $opt{d} ? str2time($opt{d}) : $^T; +$time += $opt{y} * 86400 if $opt{y}; +my $invoice_time = $opt{n} ? $^T : $time; + +my %args = ( + 'time' => $time, + 'invoice_time' => $invoice_time, + 'actual_time' => $^T, #when freeside-bill was started + #(not, when using -m, freeside-queued) + 'resetup' => ( $opt{'s'} ? $opt{'s'} : 0 ), + 'backbill' => $time, +); + +my $extra_sql = ( $opt{a} || $opt{p} ) ? ' AND ' : ' WHERE '; +$extra_sql .= "( ". join( ' OR ', map{ "custnum = $_" } @custnums ). " )"; +$extra_sql = '' unless scalar @custnums; + +my @cust = qsearch( { table => 'cust_main', + hashref => { $opt{a} ? ( 'agentnum' => $opt{a} ) : (), + $opt{p} ? ( 'payby' => $opt{p} ) : (), + }, + extra_sql => $extra_sql, + } + ); + +foreach my $cust ( @cust ) { + my $balance = $cust->balance; + cust_main_special::bill($cust, %args); + if ($balance != $cust->balance){ + $cust->apply_payments_and_credits; + my $error = $cust->collect(%args); + warn "Error collecting, custnum ". $cust->custnum. ": $error" if $error; + } +} + + +### +# subroutines +### + +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + # Date::Parse + $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-daily [ -d 'date' ] [ -y days ] [ -p 'payby' ] [ -a agentnum ] [ -s ] user [ custnum custnum ... ]\n"; +} + +### +# documentation +### + +=head1 NAME + +freeside-daily - Run daily billing and invoice collection events. + +=head1 SYNOPSIS + + freeside-daily [ -d 'date' ] [ -y days ] [ -p 'payby' ] [ -a agentnum ] [ -s ] user [ custnum custnum ... ] + +=head1 DESCRIPTION + +Bills customers and runs invoice collection events. Should be run from +crontab daily. + +Bills customers. Searches for customers who are due for billing and calls +the bill and collect methods of a cust_main object. See L<FS::cust_main>. + + -d: Pretend it's 'date'. Date is in any format Date::Parse is happy with, + but be careful. + + -y: In addition to -d, which specifies an absolute date, the -y switch + specifies an offset, in days. For example, "-y 15" would increment the + "pretend date" 15 days from whatever was specified by the -d switch + (or now, if no -d switch was given). + + -n: When used with "-d" and/or "-y", specifies that invoices should be dated + with today's date, irregardless of the pretend date used to pre-generate + the invoices. + + -p: Only process customers with the specified payby (I<CARD>, I<DCRD>, I<CHEK>, I<DCHK>, I<BILL>, I<COMP>, I<LECB>) + + -a: Only process customers with the specified agentnum + + -s: re-charge setup fees + + -v: enable debugging + + -l: debugging level + + -m: Experimental multi-process mode uses the job queue for multi-process and/or multi-machine billing. + + -r: Multi-process mode dry run option + + -k: skip notify_flat_delay and vacuum + +user: From the mapsecrets file - see config.html from the base documentation + +custnum: if one or more customer numbers are specified, only bills those +customers. Otherwise, bills all customers. + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::cust_main>, config.html from the base documentation + +=cut + diff --git a/bin/reset-cust_credit-otaker b/bin/reset-cust_credit-otaker new file mode 100755 index 000000000..93002d05a --- /dev/null +++ b/bin/reset-cust_credit-otaker @@ -0,0 +1,88 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($opt_d); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::cust_credit; +use FS::h_cust_credit; + +getopts('d:'); + +my $user = shift or die &usage; +adminsuidsetup $user; + +die &usage + unless ($opt_d); + +$FS::Record::nowarn_identical = 1; + +if ( $opt_d ) { + $opt_d =~ /^(\d+)$/ or die "invalid date"; +} else { + die "no date specified\n"; +} + +my @cust_credit = qsearch('cust_credit', { otaker => $user } ); +die "no credits found\n" unless @cust_credit; + +my $cust_credit = new FS::cust_credit; +my @fields = grep { $_ !~ /^otaker|reason|reasonnum$/ } $cust_credit->fields; + +foreach my $cust_credit ( @cust_credit ) { + my %hash = $cust_credit->hash; + foreach (qw(otaker reason reasonnum)) { + delete $hash{$_}; + } + $hash{'history_action'} = 'replace_old'; + my $h_cust_credit = + qsearchs({ 'table' => 'h_cust_credit', + 'hashref' => \%hash, + 'select' => '*', + 'extra_sql' => " AND history_date <= $opt_d", + 'order_by' => 'ORDER BY history_date DESC LIMIT 1', + }); + if ($h_cust_credit) { + $cust_credit->otaker($h_cust_credit->otaker); + my $reason = $h_cust_credit->getfield('reason'); + if ($reason =~ /^\s*$/) { + $reason = '(none)'; + } + $cust_credit->otaker($h_cust_credit->otaker); + $cust_credit->reason($reason); + my $error = $cust_credit->replace + if $cust_credit->modified; + die "error replacing cust_credit: $error\n" + if $error; + }else{ + warn "Skipping credit.crednum ". $cust_credit->crednum; + } +} + +sub usage { + die "Usage:\n\n reset-cust_credit-otaker -d epoch_date user\n"; +} + +=head1 NAME + +reset-cust_credit-otaker - Command line tool to reset the otaker column for cust_credits to a previous value + +=head1 SYNOPSIS + + reset-cust_credit-otaker -d epoch_date user + +=head1 DESCRIPTION + + Sets the otaker column of the cust_credit records specified by user and + datespec to the value just prior to datespec. + + The reasonnum of the cust_credit record is also set to reason record + which matches the reason specified in the history. + +=head1 SEE ALSO + +L<FS::cust_credit>, L<FS::h_cust_credit>; + +=cut + diff --git a/bin/rollback b/bin/rollback new file mode 100755 index 000000000..7f83ef41a --- /dev/null +++ b/bin/rollback @@ -0,0 +1,38 @@ +#!/usr/bin/perl + +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs fields); + +use FS::svc_acct; + +#cust_pkg pkgnum 240133 241206 replace_old +#cust_svc svcnum 31102 32083 delete +#svc_acct svcnum 37162 37652 delete +my($user, $table, $pkey, $start, $end, $action) = @ARGV; + +adminsuidsetup $user or die; + +#eval "use FS::h_$table;"; +#die $@ if $@; +eval "use FS::$table;"; +die $@ if $@; + +my @history = grep { $_->historynum <= $end } qsearch("h_$table", { 'historynum' => { op=>'>=', value=>$start }, history_action => $action } ); + +my %seen; +foreach my $h (@history) { + my $error; + if ( $action eq 'replace_old' ) { + my $old = qsearchs($table, { $pkey => $h->get($pkey) } ); + unless ( $old ) { die "can't find $table $pkey ". $h->get($pkey). "\n"; } + my $new = "FS::$table"->new( { map { $_ => $h->get($_) } fields($table) } ); + $error = $new->replace($old); + } elsif ( $action eq 'delete' ) { + next if $seen{$h->get($pkey)}++; + my $new = "FS::$table"->new( { map { $_ => $h->get($_) } fields($table) } ); + $error = $new->insert; + } else { + die "unknown action $action\n"; + } + die $error if $error; +} diff --git a/bin/rotate-cdrs b/bin/rotate-cdrs new file mode 100755 index 000000000..7bef0bbb0 --- /dev/null +++ b/bin/rotate-cdrs @@ -0,0 +1,38 @@ +#!/usr/bin/perl -w + +use strict; +use Fcntl qw(:flock); +use IO::File; + +my $dir = '/usr/local/etc/freeside/export/cdr'; +#chdir $dir; + +#XXX glob might not handle lots of args at some point... +foreach my $file ( glob("$dir/*/CDR*-spool.CSV") ) { + + $file =~ m{(\d+)/CDR(\d+)-spool.CSV$} + or die "guru meditation #54: can't parse filename: $file\n"; + my($custnum, $date) = ($1, $2); + + + my $alpha = 'A'; + while ( -e "$dir/$custnum/CDR$date$alpha.CSV" ) { + $alpha++; # A -> Z -> AA etc. + } + my $newfile = "$dir/$custnum/CDR$date$alpha.CSV"; + + rename $file, $newfile + or die "$! moving $file to $newfile\n"; + + use IO::File; + my $lock = new IO::File ">>$newfile" + or die "can't open $newfile: $!\n"; + sleep 1; #just in case. i guess there's still a *remotely* possible + #race condition, but i'm not losing any sleep over it... (rimshot) + flock($lock, LOCK_EX) + or die "can't lock $newfile: $!\n"; + #okay we've got the lock, any pending write should be done... + + print "$custnum: $newfile\n"; + +} diff --git a/bin/rt-drop-tables b/bin/rt-drop-tables new file mode 100755 index 000000000..b027542b3 --- /dev/null +++ b/bin/rt-drop-tables @@ -0,0 +1,29 @@ +#!/usr/bin/perl + +my @tables = qw( +Attachments +Queues +Links +Principals +Groups +ScripConditions +Transactions +Scrips +ACL +GroupMembers +CachedGroupMembers +Users +Tickets +ScripActions +Templates +TicketCustomFieldValues +CustomFields +CustomFieldValues +sessions +); + +foreach my $table ( @tables ) { + print "drop table $table;\n"; + print "drop sequence ${table}_id_seq;\n"; +} + diff --git a/bin/rt-update-links b/bin/rt-update-links new file mode 100644 index 000000000..75d554f48 --- /dev/null +++ b/bin/rt-update-links @@ -0,0 +1,36 @@ +#!/usr/bin/perl + +use FS::UID qw(adminsuidsetup); + +my( $olddb, $newdb ) = ( shift, shift ); + +$FS::CurrentUser::upgrade_hack = 1; +my $dbh = adminsuidsetup; + +my $statement = "select * from links where base like 'fsck.com-rt://$olddb/%' OR target like 'fsck.com-rt://$olddb/%'"; + +my $sth = $dbh->prepare($statement) or die $dbh->errstr; +$sth->execute or die $sth->errstr; + +while ( my $row = $sth->fetchrow_hashref ) { + + ( my $base = $row->{'base'} ) + =~ s(^fsck\.com-rt://$olddb/)(fsck.com-rt://$newdb/); + + ( my $target = $row->{'target'} ) + =~ s(^fsck\.com-rt://$olddb/)(fsck.com-rt://$newdb/); + + if ( $row->{'base'} ne $base || $row->{'target'} ne $target ) { + + my $update = 'UPDATE links SET base = ?, target = ? where id = ?'; + my @param = ( $base, $target, $row->{'id'} ); + + warn "$update : ". join(', ', @param). "\n"; + $dbh->do($update, {}, @param ); + + } + +} + +$dbh->commit; + diff --git a/bin/sendmail.import b/bin/sendmail.import new file mode 100644 index 000000000..ef745fc46 --- /dev/null +++ b/bin/sendmail.import @@ -0,0 +1,178 @@ +#!/usr/bin/perl -w + +use strict; +use Term::Query qw(query); +use Net::SCP qw(iscp); +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(qsearch qsearchs); +##use FS::svc_acct_sm; +#use FS::svc_domain; +#use FS::domain_record; +use FS::svc_acct; +##use FS::part_svc; +use FS::svc_forward; +use FS::svc_domain; + +my $user = shift or die &usage; +adminsuidsetup $user; + +#$FS::svc_Common::noexport_hack = 1; +#$FS::domain_record::noserial_hack = 1; + +use vars qw($defaultdomain); +$defaultdomain = '295.ca'; + +use vars qw(@svcpart $forward_svcpart); +@svcpart = qw( 2 4 ); +$forward_svcpart = 7; + +use vars qw($spooldir); +$spooldir = "/usr/local/etc/freeside/export.". datasrc. "/sendmail"; +mkdir($spooldir, 0755) unless -d $spooldir; + +print "\n\n", <<END; +Enter the location and name of your Sendmail aliases file, for example +"mail.isp.com:/etc/mail/aliases" +END +my($aliases)=&getvalue(":"); + +use vars qw($aliases_machine $aliases_prefix); +$aliases_machine = (split(/:/, $aliases))[0]; +$aliases_prefix = "$spooldir/$aliases_machine"; +mkdir($aliases_prefix, 0755) unless -d $aliases_prefix; + +#iscp("root\@$aliases","$aliases_prefix/aliases.import"); +iscp("ivan\@$aliases","$aliases_prefix/aliases.import"); + +print "\n\n", <<END; +Enter the location and name of your Sendmail virtusertable directory, for example +"mail.isp.com:/etc/mail/virtusertable" +END +my($virtusertable)=&getvalue(":"); + +use vars qw($virtusertable_machine $virtusertable_prefix); +$virtusertable_machine = (split(/:/, $virtusertable))[0]; +$virtusertable_prefix = "$spooldir/$virtusertable_machine"; +mkdir($virtusertable_prefix, 0755) unless -d $virtusertable_prefix; +mkdir("$virtusertable_prefix/virtusertable.import", 0755) + unless -d "$virtusertable_prefix/virtusertable.import"; + +#iscp("root\@$virtusertable/*","$aliases_prefix/virtusertable.import/"); +iscp("ivan\@$virtusertable/*","$aliases_prefix/virtusertable.import/"); + +sub getvalue { + my $prompt = shift; + $^W=0; # Term::Query isn't -w-safe + my $return = query $prompt, ''; + $^W=1; + $return; +} + +print "\n\n"; + +## + +foreach my $file ( + "$aliases_prefix/aliases.import", + glob("$aliases_prefix/virtusertable.import/*"), +) { + + warn "importing $file\n"; + + open(FILE,"<$file") or die $!; + while (<FILE>) { + next if /^\s*#/ || /^\s*$/; #skip comments & blank lines + + unless ( /^([\w\@\.\-]+)[:\s]\s*(.*\S)\s*$/ ) { + warn "Unparsable line: $_"; + next; + } + my($rawusername, $rawdest) = ($1, $2); + + my($username, $domain); + if ( $rawusername =~ /^([\w\-\.\&]*)\@([\w\.\-]+)$/ ) { + $username = $1; + $domain = $2; + } elsif ( $rawusername =~ /\@/ ) { + die "Unparsable username: $rawusername\n"; + } else { + $username = $rawusername; + $domain = $defaultdomain; + } + + #find svc_acct record or set $src + my($srcsvc, $src) = &svcnum_or_literal($username, $domain); + + foreach my $dest ( split(/,/, $rawdest) ) { + + my($dusername, $ddomain); + if ( $dest =~ /^([\w\-\.\&]+)\@([\w\.\-]+)$/ ) { + $dusername = $1; + $ddomain = $2; + } elsif ( $dest =~ /\@/ ) { + die "Unparsable username: $dest\n"; + } else { + $dusername = $dest; + $ddomain = $defaultdomain; + } + my($dstsvc, $dst) = &svcnum_or_literal($dusername, $ddomain); + + my $svc_forward = new FS::svc_forward ({ + svcpart => $forward_svcpart, + srcsvc => $srcsvc, + src => $src, + dstsvc => $dstsvc, + dst => $dst, + }); + my $error = $svc_forward->insert; + #my $error = $svc_forward->check; + if ( $error ) { + die "$rawusername: $rawdest: $error\n"; + } + } + + + } #next entry + +} #next file + +## + +sub svcnum_or_literal { + my($username, $domain) = @_; + + my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ); + my $domsvc = $svc_domain ? $svc_domain->svcnum : ''; + + my @svc_acct = grep { my $svc_acct = $_; + grep { $svc_acct->cust_svc->svcpart == $_ } @svcpart + } + qsearch('svc_acct', { + 'username' => $username, + 'domsvc' => $domsvc, + }); + + if ( scalar(@svc_acct) > 1 ) { + die "multiple sources found for $username\@$domain !\n"; + } + + my( $svcnum, $literal ) = ('', ''); + if ( @svc_acct ) { + my $svc_acct = $svc_acct[0]; + $svcnum = $svc_acct->svcnum; + } else { + $literal = "$username\@$domain"; + } + + return( $svcnum, $literal ); + +} + +sub usage { + die "Usage:\n\n sendmail.import user\n"; +} + + + + + diff --git a/bin/sequences.reset b/bin/sequences.reset new file mode 100644 index 000000000..2dc1d3bb2 --- /dev/null +++ b/bin/sequences.reset @@ -0,0 +1,32 @@ +#!/usr/bin/perl + +use FS::UID qw(adminsuidsetup); +use FS::Record qw(dbdef dbh); + +my $user = shift; +adminsuidsetup $user or die; + +foreach my $table ( dbdef->tables ) { + my $primary_key = dbdef->table($table)->primary_key; + next unless $primary_key; + #my $local = dbdef->table($table)->column($primary_key)->local; + ##next unless $default =~ /nextval/; + #print "$local\n"; + + my $statement = "select setval('${table}_${primary_key}_seq', ( select max($primary_key) from $table ) )"; + + print "$statement;\n"; + next; + + my $sth = dbh->prepare($statement) or do { + warn dbh->errstr. " preparing $statement\n"; + next; + }; + $sth->execute or do { + warn dbh->errstr. " executing $statement\n"; + dbh->commit; + next; + } + +} + diff --git a/bin/shadow.reimport b/bin/shadow.reimport new file mode 100755 index 000000000..7957011eb --- /dev/null +++ b/bin/shadow.reimport @@ -0,0 +1,125 @@ +#!/usr/bin/perl -w +# +# -d: dry-run: make no changes +# -r: replace: overwrite existing passwords (otherwise only "*" passwords will +# be changed) +# -b: blowfish replace: overwrite existing passwords only if they are +# blowfish-encrypted + +use strict; +use vars qw(%part_svc); +use Getopt::Std; +use Term::Query qw(query); +use Net::SCP qw(iscp); +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(qsearch qsearchs); +use FS::svc_acct; +use FS::part_svc; + +use vars qw($opt_d $opt_r $opt_b); +getopts("drb"); + +my $user = shift or die &usage; +adminsuidsetup $user; + +push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others? + +my($spooldir)="/usr/local/etc/freeside/export.". datasrc; + +#$FS::svc_acct::nossh_hack = 1; +$FS::svc_Common::noexport_hack = 1; + +### + +%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'}); + +die "No services with svcdb svc_acct!\n" unless %part_svc; + +print "\n\n", &menu_svc, "\n", <<END; +Enter part number or part numbers to import. +END +my($shell_svcpart)=&getvalue; +my @shell_svcpart = split(/[,\s]+/, $shell_svcpart); + +print "\n\n", <<END; +Enter the location and name of your _user_ shadow file, for example +"mail.isp.com:/etc/shadow" or "bsd.isp.com:/etc/master.passwd" +END +my($loc_shadow)=&getvalue(":"); +iscp("root\@$loc_shadow", "$spooldir/shadow.import"); + +sub menu_svc { + ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n"; +} +sub getpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %part_svc ]; + $^W=1; + $return; +} +sub getvalue { + my $prompt = shift; + $^W=0; # Term::Query isn't -w-safe + my $return = query $prompt, ''; + $^W=1; + $return; +} + +print "\n\n"; + +### + +open(SHADOW,"<$spooldir/shadow.import"); + +my($line, $updated); +while (<SHADOW>) { + $line++; + chop; + my($username,$password)=split(/:/); + +# my @svc_acct = grep { $_->cust_svc->svcpart == $shell_svcpart } +# qsearch('svc_acct', { 'username' => $username } ); + my @svc_acct = grep { + my $svcpart = $_->cust_svc->svcpart; + grep { $_ == $svcpart } @shell_svcpart; + } qsearch('svc_acct', { 'username' => $username } ); + + next unless @svc_acct; + + if ( scalar(@svc_acct) > 1 ) { + die "more than one $username found!\n"; + next; + } + + my $svc_acct = shift @svc_acct; + + next unless $svc_acct->_password eq '*' + || $opt_r + || ( $opt_b && $svc_acct->_password =~ /^\$2a?\$/ ); + + next if $svc_acct->username eq 'root'; + + next if $password eq 'NP' || $password eq '*LK*'; + + next if $svc_acct->_password eq $password; + next if $svc_acct->_password =~ /^\*SUSPENDED\*/; + + my $new_svc_acct = new FS::svc_acct( { $svc_acct->hash } ); + $new_svc_acct->_password($password); + #warn "$username: ". $svc_acct->_password. " -> $password\n"; + warn "changing password for $username\n"; + unless ( $opt_d ) { + my $error = $new_svc_acct->replace($svc_acct); + die "$username: $error" if $error; + } + + $updated++; + +} + +warn "$updated of $line passwords changed\n"; + +sub usage { + die "Usage:\n\n shadow.reimport [ -d ] [ -r ] user\n"; +} + diff --git a/bin/slony-setup b/bin/slony-setup new file mode 100755 index 000000000..0798c1a03 --- /dev/null +++ b/bin/slony-setup @@ -0,0 +1,109 @@ +#!/usr/bin/perl +# +# slony replication setup +# +# usage: slony-setup freesideuser + +use strict; +use DBI; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(dbdef); + +my $user = shift or die "usage: slony-setup username\n"; +adminsuidsetup($user); + +#--- + +my $MASTERHOST = '192.168.20.10'; +my $SLAVEHOST = '192.168.20.50'; +#my $REPLICATIONUSER='pgsql'; +my $REPLICATIONUSER='postgres'; + +#-------- + +print <<END; + +#on slave: +useradd freeside +cp -pr /etc/skel /home/freeside +chown -R freeside /home/freeside + +su postgres -c 'createuser freeside' #n y n +su freeside -c 'createdb freeside' + +#on master: +su postgres -c 'createlang plpgsql freeside' + +pg_dump -s -U $REPLICATIONUSER -h $MASTERHOST freeside | psql -U $REPLICATIONUSER -h $SLAVEHOST freeside + +END + +#-------- + +#drop set ( id = 1, origin = 1); + +print <<END; +#on master: +slonik <<_EOF_ + +cluster name = freeside; +node 1 admin conninfo = 'dbname=freeside host=$MASTERHOST user=$REPLICATIONUSER'; +node 2 admin conninfo = 'dbname=freeside host=$SLAVEHOST user=$REPLICATIONUSER'; +init cluster ( id=1, comment = 'Master Node'); + +create set (id=1, origin=1, comment='All freeside tables'); + +END + +my $id = 1; + +foreach my $table ( dbdef->tables ) { + #next if $table =~ /^sql_/i; + print "set add table (set id=1, origin=1, id=". $id++. ", fully qualified name = 'public.$table' );\n"; + +} + +print <<END; + +store node (id=2, comment = 'Slave node'); +store path (server = 1, client = 2, conninfo='dbname=freeside host=$MASTERHOST user=$REPLICATIONUSER'); +store path (server = 2, client = 1, conninfo='dbname=freeside host=$SLAVEHOST user=$REPLICATIONUSER'); +store listen (origin=1, provider = 1, receiver =2); +store listen (origin=2, provider = 2, receiver =1); + +_EOF_ +END + +print <<END; + +### start slon processes (both machines) (this is debian-specific) +mkdir /etc/slony1/freeside + +cat >/etc/slony1/freeside/slon.conf <<_EOF_ +# Set the cluster name that this instance of slon is running against +# default is to read it off the command line +cluster_name='freeside' + +# Set slon's connection info, default is to read it off the command line +conn_info='host=localhost port=5432 dbname=freeside user=postgres' +_EOF_ + +/etc/init.d/slony1 start + +END + + +print <<END; +#on master: +slonik <<_EOF_ + +cluster name = freeside; + +node 1 admin conninfo = 'dbname=freeside host=$MASTERHOST user=$REPLICATIONUSER'; +node 2 admin conninfo = 'dbname=freeside host=$SLAVEHOST user=$REPLICATIONUSER'; + +subscribe set ( id = 1, provider = 1, receiver = 2, forward = no); + +_EOF_ +END + diff --git a/bin/sqlradius-norealm.reimport b/bin/sqlradius-norealm.reimport new file mode 100755 index 000000000..b7d016609 --- /dev/null +++ b/bin/sqlradius-norealm.reimport @@ -0,0 +1,113 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw(%part_svc); +#use Date::Parse; +use DBI; +use Term::Query qw(query); +use FS::UID qw(adminsuidsetup); #datasrc +use FS::Record qw(qsearch qsearchs); +use FS::svc_acct; +use FS::part_svc; + +my $user = shift or die &usage; +adminsuidsetup $user; + +#push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others? + +$FS::svc_Common::noexport_hack = 1; + +### + +%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'}); + +die "No services with svcdb svc_acct!\n" unless %part_svc; + +print "\n\n", &menu_svc, "\n", <<END; +Enter part number to import. +END +my $sqlradius_svcpart = &getpart; + +my $datasrc = &getvalue("\n\nEnter the DBI datasource:"); +my $db_user = &getvalue("\n\nEnter the database user:"); +my $db_pass = &getvalue("\n\nEnter the database password:"); + +sub menu_svc { + ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n"; +} +sub getpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %part_svc ]; + $^W=1; + $return; +} +sub getvalue { + my $prompt = shift; + $^W=0; # Term::Query isn't -w-safe + my $return = query $prompt, ''; + $^W=1; + $return; +} + +print "\n\n"; + +### + +my $dbh = DBI->connect( $datasrc, $db_user, $db_pass ) + or die $DBI::errstr; + +my $sth = $dbh->prepare('SELECT DISTINCT UserName FROM radcheck') + or die $dbh->errstr; +$sth->execute or die $sth->errstr; + +my $row; +while ( defined ( $row = $sth->fetchrow_arrayref ) ) { + my( $username ) = @$row; + + my( $password, $group ) = ( '', '', '' ); + + my $rc_sth = $dbh->prepare( + 'SELECT Attribute, Value'. + ' FROM radcheck'. + ' WHERE UserName = ?' + ) or die $dbh->errstr; + $rc_sth->execute($username) or die $rc_sth->errstr; + + foreach my $rc_row ( @{$rc_sth->fetchall_arrayref} ) { + my($attribute, $value) = @$rc_row; + if ( $attribute =~ /^((Crypt|User)-)?Password$/ ) { + $password = $value unless $password && !$1; + } else { + #handle other params! + } + } + + my @svc_acct = grep { $_->cust_svc->svcpart == $sqlradius_svcpart } + qsearch('svc_acct', { 'username' => $username, } ); + + #print "$r_username / $realm: $password / $finger: "; + print "$username: $password: "; + if ( scalar(@svc_acct) == 0 ) { + print "not found\n"; + next; + } elsif ( scalar(@svc_acct) > 1 ) { + print "multiple matches found?!?!\n"; + next; + } else { + #print "correcting password and name\n"; + print "correcting password\n"; + } + + my $svc_acct = $svc_acct[0]; + #my $new = new FS::svc_acct { $svc_acct->hash, '_password' => $password, 'finger' => $finger }; + my $new = new FS::svc_acct { $svc_acct->hash, '_password' => $password }; + my $error = $new->replace($svc_acct); + #my $error = $new->check; + die "$username: $error" if $error; + +} + +sub usage { + die "Usage:\n\n sqlradius-norealm.reimport user\n"; +} + diff --git a/bin/sqlradius.import b/bin/sqlradius.import new file mode 100644 index 000000000..e75f65b17 --- /dev/null +++ b/bin/sqlradius.import @@ -0,0 +1,152 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw(%part_svc %domain_part_svc); +#use Date::Parse; +use DBI; +use Term::Query qw(query); +use FS::UID qw(adminsuidsetup); #datasrc +use FS::Record qw(qsearch qsearchs); +use FS::svc_acct; +use FS::part_svc; +use FS::svc_domain; + +my $user = shift or die &usage; +adminsuidsetup $user; + +#push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others? + +$FS::svc_Common::noexport_hack = 1; +$FS::svc_domain::whois_hack = 1; + +### + +%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'}); + +die "No services with svcdb svc_acct!\n" unless %part_svc; + +print "\n\n", &menu_svc, "\n", <<END; +Enter part number to import. +END +my $sqlradius_svcpart = &getpart; + +%domain_part_svc = map { $_->svcpart, $_ } + qsearch('part_svc', { 'svcdb' => 'svc_domain'} ); + +die "No services with svcdb svc_domain!\n" unless %domain_part_svc; + +print "\n\n", &menu_domain_svc, "\n", <<END; +Enter part number for domains. +END +my $domain_svcpart = &getdomainpart; + +my $datasrc = &getvalue("\n\nEnter the DBI datasource:"); +my $db_user = &getvalue("\n\nEnter the database user:"); +my $db_pass = &getvalue("\n\nEnter the database password:"); + +sub menu_svc { + ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n"; +} +sub menu_domain_svc { + ( join "\n", map "$_: ".$domain_part_svc{$_}->svc, sort keys %domain_part_svc ). "\n"; +} +sub getpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %part_svc ]; + $^W=1; + $return; +} +sub getdomainpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %domain_part_svc ]; + $^W=1; + $return; +} +sub getvalue { + my $prompt = shift; + $^W=0; # Term::Query isn't -w-safe + my $return = query $prompt, ''; + $^W=1; + $return; +} + +print "\n\n"; + +### + +my $dbh = DBI->connect( $datasrc, $db_user, $db_pass ) + or die $DBI::errstr; + +my $sth = $dbh->prepare('SELECT DISTINCT UserName, Realm FROM radcheck') + or die $dbh->errstr; +$sth->execute or die $sth->errstr; + +my $row; +while ( defined ( $row = $sth->fetchrow_arrayref ) ) { + my( $r_username, $realm ) = @$row; + + my( $username, $domain ); + if ( $r_username =~ /^([^@]+)\@([^@]+)$/ ) { + $username = $1; + $domain = $2; + } else { + $username = $r_username; + $domain = $realm; + } + my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ) + || new FS::svc_domain { + 'domain' => $domain, + 'svcpart' => $domain_svcpart, + 'action' => 'N', + }; + unless ( $svc_domain->svcnum ) { + my $error = $svc_domain->insert; + if ( $error ) { + die "can't insert domain $domain: $error\n"; + } + } + + my( $password, $finger, $group ) = ( '', '', '' ); + + my $rc_sth = $dbh->prepare( + 'SELECT Attribute, Value, Name, GroupName'. + ' FROM radcheck'. + ' WHERE UserName = ? and Realm = ?' + ) or die $dbh->errstr; + $rc_sth->execute($r_username, $realm) or die $rc_sth->errstr; + + foreach my $rc_row ( @{$rc_sth->fetchall_arrayref} ) { + my($attribute, $value, $name, $groupname) = @$rc_row; + if ( $attribute =~ /^((User|Crypt)-)?Password$/ ) { + $password = $value; + $finger = $name; + $group = $groupname; + } else { + #handle other params! + } + } + + my $svc_acct = new FS::svc_acct { + 'svcpart' => $sqlradius_svcpart, + 'username' => $username, + 'domsvc' => $svc_domain->svcnum, + '_password' => $password, + 'finger' => $finger, + }; + + my $error = $svc_acct->insert; + #my $error = $svc_acct->check; + if ( $error ) { + if ( $error =~ /duplicate/i ) { + warn "$r_username / $realm: $error"; + } else { + die "$r_username / $realm: $error"; + } + } + +} + +sub usage { + die "Usage:\n\n sqlradius.import user\n"; +} + diff --git a/bin/sqlradius.reimport b/bin/sqlradius.reimport new file mode 100755 index 000000000..2218a3f13 --- /dev/null +++ b/bin/sqlradius.reimport @@ -0,0 +1,160 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw(%part_svc %domain_part_svc); +#use Date::Parse; +use DBI; +use Term::Query qw(query); +use FS::UID qw(adminsuidsetup); #datasrc +use FS::Record qw(qsearch qsearchs); +use FS::svc_acct; +use FS::part_svc; +use FS::svc_domain; + +my $user = shift or die &usage; +adminsuidsetup $user; + +#push @FS::svc_acct::shells, qw(/bin/sync /sbin/shutdown /bin/halt /sbin/halt); #others? + +$FS::svc_Common::noexport_hack = 1; +$FS::svc_domain::whois_hack = 1; + +### + +%part_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'}); + +die "No services with svcdb svc_acct!\n" unless %part_svc; + +print "\n\n", &menu_svc, "\n", <<END; +Enter part number to import. +END +my $sqlradius_svcpart = &getpart; + +%domain_part_svc = map { $_->svcpart, $_ } + qsearch('part_svc', { 'svcdb' => 'svc_domain'} ); + +die "No services with svcdb svc_domain!\n" unless %domain_part_svc; + +print "\n\n", &menu_domain_svc, "\n", <<END; +Enter part number for domains. +END +my $domain_svcpart = &getdomainpart; + +my $datasrc = &getvalue("\n\nEnter the DBI datasource:"); +my $db_user = &getvalue("\n\nEnter the database user:"); +my $db_pass = &getvalue("\n\nEnter the database password:"); + +sub menu_svc { + ( join "\n", map "$_: ".$part_svc{$_}->svc, sort keys %part_svc ). "\n"; +} +sub menu_domain_svc { + ( join "\n", map "$_: ".$domain_part_svc{$_}->svc, sort keys %domain_part_svc ). "\n"; +} +sub getpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %part_svc ]; + $^W=1; + $return; +} +sub getdomainpart { + $^W=0; # Term::Query isn't -w-safe + my $return = query "Enter part number:", 'irk', [ keys %domain_part_svc ]; + $^W=1; + $return; +} +sub getvalue { + my $prompt = shift; + $^W=0; # Term::Query isn't -w-safe + my $return = query $prompt, ''; + $^W=1; + $return; +} + +print "\n\n"; + +### + +my $dbh = DBI->connect( $datasrc, $db_user, $db_pass ) + or die $DBI::errstr; + +my $sth = $dbh->prepare('SELECT DISTINCT UserName, Realm FROM radcheck') + or die $dbh->errstr; +$sth->execute or die $sth->errstr; + +my $row; +while ( defined ( $row = $sth->fetchrow_arrayref ) ) { + my( $r_username, $realm ) = @$row; + + my( $username, $domain ); + if ( $r_username =~ /^([^@]+)\@([^@]+)$/ ) { + $username = $1; + $domain = $2; + } else { + $username = $r_username; + $domain = $realm; + } + my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ) + || new FS::svc_domain { + 'domain' => $domain, + 'svcpart' => $domain_svcpart, + 'action' => 'N', + }; + unless ( $svc_domain->svcnum ) { + die "new domain? wtf"; + my $error = $svc_domain->insert; + if ( $error ) { + die "can't insert domain $domain: $error\n"; + } + } + + #my( $password, $finger, $group ) = ( '', '', '' ); + my( $password, $group ) = ( '', '', '' ); + + my $rc_sth = $dbh->prepare( + 'SELECT Attribute, Value, Name, GroupName'. + ' FROM radcheck'. + ' WHERE UserName = ? and Realm = ?' + ) or die $dbh->errstr; + $rc_sth->execute($r_username, $realm) or die $rc_sth->errstr; + + foreach my $rc_row ( @{$rc_sth->fetchall_arrayref} ) { + my($attribute, $value, $name, $groupname) = @$rc_row; + if ( $attribute =~ /^((Crypt|User)-)?Password$/ ) { + $password = $value; + #$finger = $name; + $group = $groupname; + } else { + #handle other params! + } + } + + my @svc_acct = grep { $_->cust_svc->svcpart == $sqlradius_svcpart } + qsearch('svc_acct', { 'username' => $username, + 'domsvc' => $svc_domain->svcnum, } ); + + #print "$r_username / $realm: $password / $finger: "; + print "$r_username / $realm: $password: "; + if ( scalar(@svc_acct) == 0 ) { + print "not found\n"; + next; + } elsif ( scalar(@svc_acct) > 1 ) { + print "multiple matches found?!?!\n"; + next; + } else { + #print "correcting password and name\n"; + print "correcting password\n"; + } + + my $svc_acct = $svc_acct[0]; + #my $new = new FS::svc_acct { $svc_acct->hash, '_password' => $password, 'finger' => $finger }; + my $new = new FS::svc_acct { $svc_acct->hash, '_password' => $password }; + my $error = $new->replace($svc_acct); + #my $error = $new->check; + die "$r_username / $realm: $error" if $error; + +} + +sub usage { + die "Usage:\n\n sqlradius.reimport user\n"; +} + diff --git a/bin/strip-eps b/bin/strip-eps new file mode 100755 index 000000000..2c2d124d7 --- /dev/null +++ b/bin/strip-eps @@ -0,0 +1,20 @@ +#!/usr/bin/perl -w + +# Author: Andy Turner <andrew.turner@acadia.net> + +use strict; + +# The first line has some binary magic for file identification +# purposes. GhostScript doesn't like it. Strip it. +scalar <>; + +# Add a header so that we can use magic to determine the file type. +print "%!PS-Adobe-3.0 EPSF-3.0\n"; + +while (<>) { + print; + + # Illustrator Version 7 format EPS files have a bunch of binary gook + # after the "%%EOF" line. (% is a comment in PostScript, right?) + last if /^%%EOF/; +} diff --git a/bin/svc_acct-recalculate_usage b/bin/svc_acct-recalculate_usage new file mode 100644 index 000000000..1b3955b21 --- /dev/null +++ b/bin/svc_acct-recalculate_usage @@ -0,0 +1,110 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($opt_s $opt_u $opt_p $opt_k); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::svc_acct; +use FS::cust_svc; + +my %field2sub = ( + 'seconds' => sub { + my($svc_acct, $cust_pkg) = @_; + $svc_acct->seconds_since_sqlradacct( $cust_pkg->last_bill, time ); + }, + 'upbytes' => sub { + my($svc_acct, $cust_pkg) = @_; + $svc_acct->attribute_since_sqlradacct( + $cust_pkg->last_bill, time, 'AcctInputOctets' ); + }, + 'downbytes' => sub { + my($svc_acct, $cust_pkg) = @_; + $svc_acct->attribute_since_sqlradacct( + $cust_pkg->last_bill, time, 'AcctOutputOctets' ); + }, + 'totalbytes' => sub { + my($svc_acct, $cust_pkg) = @_; + $svc_acct->attribute_since_sqlradacct( + $cust_pkg->last_bill, time, 'AcctInputOctets' ) + + + $svc_acct->attribute_since_sqlradacct( + $cust_pkg->last_bill, time, 'AcctOutputOctets' ) + ; + }, +); + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $field = shift; +die "can only reset seconds, upbytes, downbytes or totalbytes" + unless $field2sub{$field}; + +my $value = shift; + +#false laziness w/freeside-reexport +getopts('s:u:p:k:'); + +my @svc_x = (); +if ( $opt_s ) { + my $cust_svc = qsearchs('cust_svc', { svcnum=>$opt_s } ) + or die "svcnum $opt_s not found\n"; + push @svc_x, $cust_svc->svc_x; +} elsif ( $opt_u ) { + my $svc_x = qsearchs('svc_acct', { username=>$opt_u } ) + or die "username $opt_u not found\n"; + push @svc_x, $svc_x; +} elsif ( $opt_p ) { + push @svc_x, map { $_->svc_x } qsearch('cust_svc', { svcpart=>$opt_p } ); + die "no services with svcpart $opt_p found\n" unless @svc_x; +} elsif ( $opt_k ) { + push @svc_x, + map { $_->svc_x } + qsearch({ + table => 'cust_svc', + addl_from => 'LEFT JOIN cust_pkg USING ( pkgnum )', + extra_sql => "WHERE pkgpart = $opt_k", + }); + die "no services with pkgpart $opt_k found\n" unless @svc_x; +} + +warn "setting $field to $value before usage\n"; +foreach my $svc_x ( @svc_x ) { + my $cust_pkg = $svc_x->cust_svc->cust_pkg; + my $cust_usage = $value - &{ $field2sub{$field} }( $svc_x, $cust_pkg ); +# warn "resetting ". $svc_x->svcnum.':'.$svc_x->username. " to $cust_usage\n"; + warn "$field for ". $svc_x->svcnum.':'.$svc_x->username. " reached limit\n" + if $cust_usage <= 0; + $svc_x->$field($cust_usage); + + my $error = $svc_x->replace; + die $error if $error; +} + +sub usage { + die "Usage:\n\n svc_acct-recalculate_usage user [ -s svcnum | -u username | -p svcpart ]\n"; +} + +=head1 NAME + +svc-acct-recalculate_usage - Command line tool to recalculate usage for existing services + +=head1 SYNOPSIS + + svc_acct-recalculate_usage user usagefield initialvalue [ -s svcnum | -u username | -p svcpart ] + + #recalculate a 1gb totalbytes limit for pkgpart 2 + svc_acct-recalculate_usage ivan totalbytes 1073741824 -k 2 + +=head1 DESCRIPTION + +Re-calculates the specified usage field for the specified service(s) (selected +by svcnum, username or svcpart). + +=head1 SEE ALSO + +L<FS::svc_acct>, L<freeside-reexport>, L<FS::part_export> + +=cut + diff --git a/bin/svc_acct.import b/bin/svc_acct.import new file mode 100755 index 000000000..aff26b943 --- /dev/null +++ b/bin/svc_acct.import @@ -0,0 +1,237 @@ +#!/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 new file mode 100755 index 000000000..9e3d38bfe --- /dev/null +++ b/bin/svc_acct_pop.import @@ -0,0 +1,59 @@ +#!/usr/bin/perl + +use strict; +use Text::CSV_XS; +use FS::UID qw(adminsuidsetup); +use FS::svc_acct_pop; + +my @fields = qw( ac loc state city exch ); +my $fixup = sub { + my $hash = shift; + $hash->{ac} =~ /^\s*(\d{3})\s*$/; + $hash->{ac} = $1; + $hash->{loc} =~ /^\s*(\d{3})(\d{4})\s*$/; + $hash->{exch} = $1; + $hash->{loc} = $2; + $hash->{state} =~ /^\s*(\S{0,2})\s*$/; + $hash->{state} = $1; + $hash->{city} =~ /^\s*(.*?)\s*$/; + $hash->{city} = $1; + + }; + +my $user = shift or usage(); +adminsuidsetup $user; + +my $file = shift or usage(); +my $csv = new Text::CSV_XS; + +open(FH, $file) or die "cannot open $file: $!"; + +sub usage { + die "Usage:\n\n svc_acct_pop.import user popfile.csv\n\n"; +} + +### + +my $line; +while ( defined($line=<FH>) ) { + chomp $line; + + $line &= "\177" x length($line); # i hope this isn't really necessary + $csv->parse($line) + or die "cannot parse: " . $csv->error_input(); + + my @values = $csv->fields(); + my %hash; + foreach my $field (@fields) { + $hash{$field} = shift @values; + } + + &{$fixup}(\%hash); + + my $svc_acct_pop = new FS::svc_acct_pop { %hash }; + + #my $error = $svc_acct_pop->check; + my $error = $svc_acct_pop->insert; + die $error if $error; + +} diff --git a/bin/svc_broadband.renumber b/bin/svc_broadband.renumber new file mode 100755 index 000000000..980fa0099 --- /dev/null +++ b/bin/svc_broadband.renumber @@ -0,0 +1,84 @@ +#!/usr/bin/perl + +use strict; + +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::svc_Common; +use FS::part_svc_router; +use FS::svc_broadband; +use FS::router; +use FS::addr_block; + +$FS::svc_Common::noexport_hack = 1; #Disable exports! + +my $user = shift if $ARGV[0] or die &usage; +adminsuidsetup($user); + +my $remapfile = shift if $ARGV[0] or die &usage; +my $old_blocknum = shift if $ARGV[0] or die &usage; +my $new_blocknum = shift if $ARGV[0] or die &usage; +my $old_svcnum = shift if $ARGV[0]; + +my %ipmap; + +open(REMAP, "<$remapfile") or die $!; +while (<REMAP>) { + next unless (/^([0-9\.]+)\s+([0-9\.]+)$/); + my ($old_ip, $new_ip) = ($1, $2); + $ipmap{$old_ip} = $new_ip; +} +close(REMAP); + +my @svcs; +if ($old_svcnum) { + @svcs = ( qsearchs('svc_broadband', { svcnum => $old_svcnum, + blocknum => $old_blocknum }) ); +} else { + @svcs = qsearch('svc_broadband', { blocknum => $old_blocknum }); +} + +foreach my $old_sb (@svcs) { + + my $old_ip = $old_sb->ip_addr; + my $new_ip = $ipmap{$old_ip}; + print "Renumbering ${old_ip} (${old_blocknum}) => ${new_ip} (${new_blocknum})...\n"; + + + my $new_sb = new FS::svc_broadband + { $old_sb->hash, + ip_addr => $new_ip, + blocknum => $new_blocknum, + svcpart => $old_sb->cust_svc->svcpart, + }; + + my $error = $new_sb->replace($old_sb); + die $error if $error; + +} + + + +exit(0); + +sub usage { + + my $usage = <<EOT; +Usage: + svc_broadband.renumber user remapfile old_blocknum new_blocknum [ svcnum ] + +remapfile format: +old_ip_address new_ip_address +... + +Example remapfile: +10.0.0.5 192.168.0.5 +10.0.0.20 192.168.0.20 +10.0.0.32 192.168.0.3 + +Warning: This assumes your routers have already been reconfigured with the + new addresses. Exports will not be run! + +EOT + +} diff --git a/bin/svc_domain.erase b/bin/svc_domain.erase new file mode 100755 index 000000000..435dd5fdd --- /dev/null +++ b/bin/svc_domain.erase @@ -0,0 +1,15 @@ +#!/usr/bin/perl -w + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); + +use FS::domain_record; +use FS::svc_domain; + +adminsuidsetup(shift @ARGV) or die "Usage: svc_domain.erase user\n"; + +foreach my $record ( qsearch('domain_record',{}), qsearch('svc_domain', {} ) ) { + my $error = $record->delete; + die $error if $error; +} diff --git a/bin/sysvshell.export b/bin/sysvshell.export new file mode 100755 index 000000000..c13912c3f --- /dev/null +++ b/bin/sysvshell.export @@ -0,0 +1,112 @@ +#!/usr/bin/perl -w + +# sysvshell export + +use strict; +use File::Rsync; +use Net::SSH qw(ssh); +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(qsearch qsearchs); +use FS::part_export; +use FS::cust_svc; +use FS::svc_acct; + +my @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $spooldir = "/usr/local/etc/freeside/export.". datasrc; +#my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/shell"; + +my @sysv_exports = qsearch('part_export', { 'exporttype' => 'sysvshell' } ); + +my $rsync = File::Rsync->new({ + rsh => 'ssh', +# dry_run => 1, +}); + +foreach my $export ( @sysv_exports ) { + my $machine = $export->machine; + my $prefix = "$spooldir/$machine"; + mkdir $prefix, 0700 unless -d $prefix; + + #LOCKING!!! + + ( open(SHADOW,">$prefix/shadow") + #!!! and flock(SHADOW,LOCK_EX|LOCK_NB) + ) or die "Can't open $prefix/shadow: $!"; + ( open(PASSWD,">$prefix/passwd") + #!!! and flock(PASSWD,LOCK_EX|LOCK_NB) + ) or die "Can't open $prefix/passwd: $!"; + + chmod 0644, "$prefix/passwd"; + chmod 0600, "$prefix/shadow"; + + my @svc_acct = $export->svc_x; + + next unless @svc_acct; + + foreach my $svc_acct ( sort { $a->uid <=> $b->uid } @svc_acct ) { + + my $password = $svc_acct->_password; + my $cpassword; + #if ( ( length($password) <= 8 ) + if ( ( length($password) <= 12 ) + && ( $password ne '*' ) + && ( $password ne '!!' ) + && ( $password ne '' ) + ) { + $cpassword=crypt($password, + $saltset[int(rand(64))].$saltset[int(rand(64))] + ); + # MD5 !!!! + } else { + $cpassword=$password; + } + + ### + # FORMAT OF THE PASSWD FILE HERE + print PASSWD join(":", + $svc_acct->username, + 'x', # "##". $username, + $svc_acct->uid, + $svc_acct->gid, + $svc_acct->finger, + $svc_acct->dir, + $svc_acct->shell, + ), "\n"; + + ### + # FORMAT OF THE SHADOW FILE HERE + print SHADOW join(":", + $svc_acct->username, + $cpassword, + '', + '', + '', + '', + '', + '', + '', + ), "\n"; + + } + + #!!! flock(SHADOW,LOCK_UN); + #!!! flock(PASSWD,LOCK_UN); + close SHADOW; + close PASSWD; + + $rsync->exec( { + src => "$prefix/shadow", + dest => "root\@$machine:/etc/shadow" + } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err); + + $rsync->exec( { + src => "$prefix/passwd", + dest => "root\@$machine:/etc/passwd" + } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err); + + # UNLOCK!! +} diff --git a/bin/tax_rate_location.import b/bin/tax_rate_location.import new file mode 100755 index 000000000..439d27cc9 --- /dev/null +++ b/bin/tax_rate_location.import @@ -0,0 +1,48 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw($opt_g $opt_f); +use vars qw($DEBUG); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Conf; +use FS::tax_rate_location; + +getopts('f:g:'); + +my $user = shift or die &usage; +my $dbh = adminsuidsetup $user; + +my ($format) = $opt_f =~ /^([-\w]+)$/; + +my @list = ( + 'GEOCODE', $opt_g, \&FS::tax_rate_location::batch_import, +); + +my $oldAutoCommit = $FS::UID::AutoCommit; +local $FS::UID::AutoCommit = 0; + +my $error = ''; + +while(@list) { + my ($name, $file, $method) = splice(@list, 0, 3); + + my $fh; + + $file =~ /^([\s\d\w.]+)$/ or die "Illegal filename: $file\n"; + $file = $1; + + open $fh, '<', $file or die "can't open $name file: $!\n"; + $error ||= &{$method}( { filehandle => $fh, 'format' => $format, } ); + + die "error while processing $file: $error" if $error; + close $fh; +} + +if ($error) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; +}else{ + $dbh->commit or die $dbh->errstr if $oldAutoCommit; +} + +sub usage { die "Usage:\ntax_rates_location.import -f FORMAT -g GEOCODEFILE user\n\n"; } diff --git a/bin/test_scrub b/bin/test_scrub new file mode 100644 index 000000000..5766925a6 --- /dev/null +++ b/bin/test_scrub @@ -0,0 +1,48 @@ +#!/usr/bin/perl -w + +#This drops anything from the database that could cause live things to happen. +#You'd want to do this on a test copy of your live database but NEVER on the +#live database itself. + +#-all exports (all records in part_export, part_export_option export_svc) +#-all non-POST invoice destinations (cust_main_invoice) +#-all payment gateways and agent payment gw overrides (payment_gateway, +# payment_gateway_option, agent_payment_gateway) +#-everything in the job queue (queue and queue_arg) +#-business-onlinepayment and business-onlinepayment-ach config + +use strict; +use FS::UID qw(adminsuidsetup dbh); +use FS::Conf; + +adminsuidsetup shift; + +foreach my $table (qw( + part_export + part_export_option + export_svc + payment_gateway + payment_gateway_option + agent_payment_gateway + queue + queue_arg +)) { + + my $sth = dbh->prepare("DELETE FROM $table") or die dbh->errstr; + $sth->execute or die $sth->errstr; + +} + +my $dsth = dbh->prepare("DELETE FROM cust_main_invoice WHERE dest != 'POST'") + or die dbh->errstr; +$dsth->execute or die $dsth->errstr; + +my $conf = new FS::Conf; +foreach my $item (qw( + business-onlinepayment + business-onlinepayment-ach +)) { + $conf->delete($item); +} + +dbh->commit or die dbh->errstr; diff --git a/bin/tron-scan b/bin/tron-scan new file mode 100755 index 000000000..914d6d407 --- /dev/null +++ b/bin/tron-scan @@ -0,0 +1,24 @@ +#!/usr/bin/perl + +use FS::UID qw(adminsuidsetup); +use FS::Conf; +use FS::Record qw(qsearch); +use FS::Tron qw(tron_scan tron_lint); +use FS::cust_svc; + +adminsuidsetup shift; + +my $conf = new FS::Conf; +my $mcp_svcpart = $conf->config('mcp_svcpart') or die "no mcp_svcpart"; + +#tron_scan($_) foreach qsearch('cust_svc', { 'svcpart' => $mcp_svcpart } ); +foreach my $svc ( qsearch('cust_svc', { 'svcpart' => $mcp_svcpart } ) ) { + my $error = tron_scan($svc); + warn $error if $error; + + my @lint = tron_lint($svc); + print $svc->svc_x->title. "\n". join('', map " $_\n", @lint ) + if @lint; +} + +1; |