diff options
Diffstat (limited to 'FS')
83 files changed, 2056 insertions, 3651 deletions
@@ -54,8 +54,6 @@ L<FS::svc_Common> - Service base class L<FS::svc_acct> - Account (shell, RADIUS, POP3) class -L<FS::acct_snarf> - External mail account class - L<FS::radius_usergroup> - RADIUS groups L<FS::svc_domain> - Domain class @@ -64,11 +62,9 @@ L<FS::domain_record> - DNS zone entries L<FS::svc_forward> - Mail forwarding class -L<FS::svc_www> - Web virtual host class. - -L<FS::svc_broadband> - DSL, wireless and other broadband class. +L<FS::svc_acct_sm> - (Depreciated) Vitual mail alias class -L<FS::svc_external> - Externally tracked service class. +L<FS::svc_www> - Web virtual host class. L<FS::part_svc> - Service definition class @@ -108,8 +104,6 @@ L<FS::cust_bill> - Invoice class L<FS::cust_bill_pkg> - Invoice line item class -L<FS::cust_bill_pkg_detail> - Invoice line item detail class - L<FS::part_bill_event> - Invoice event definition class L<FS::cust_bill_event> - Completed invoice event class @@ -193,7 +187,7 @@ first time, the suggested order will tend to reduce the number of forward references." If you've never used OO modules before, -http://www.perl.com/doc/FMTEYEWTK/easy_objects.html might help you out. +http://www.cpan.org/doc/FMTEYEWTK/easy_objects.html might help you out. =head1 DESCRIPTION diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index a3286299b..25f0de7b3 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -44,10 +44,8 @@ Returns an HTML header. =cut sub header { - use Carp; - carp 'FS::CGI::header deprecated; include /elements/header.html instead'; - my($title,$menubar,$etc)=@_; #$etc is for things like onLoad= etc. + #use Carp; $etc = '' unless defined $etc; my $x = <<END; @@ -109,9 +107,6 @@ Returns an HTML menubar. =cut sub menubar { #$menubar=menubar('Main Menu', '../', 'Item', 'url', ... ); - use Carp; - carp 'FS::CGI::menubar deprecated; include /elements/menubar.html instead'; - my($item,$url,@html); while (@_) { ($item,$url)=splice(@_,0,2); @@ -232,9 +227,6 @@ Returns HTML tag for beginning a table. =cut sub table { - use Carp; - carp 'FS::CGI::table deprecated; include /elements/table.html instead'; - my $col = shift; if ( $col ) { qq!<TABLE BGCOLOR="$col" BORDER=1 WIDTH="100%" CELLSPACING=0 CELLPADDING=2 BORDERCOLOR="#999999">!; diff --git a/FS/FS/ClientAPI.pm b/FS/FS/ClientAPI.pm index 7cbbdbf67..f7b8eb028 100644 --- a/FS/FS/ClientAPI.pm +++ b/FS/FS/ClientAPI.pm @@ -1,13 +1,13 @@ package FS::ClientAPI; use strict; -use vars qw(%handler $domain); +use vars qw(%handler); %handler = (); #find modules foreach my $INC ( @INC ) { - foreach my $file ( glob("$INC/FS/ClientAPI/*.pm") ) { + foreach my $file ( glob("$INC/FS/ClientAPI/*") ) { $file =~ /\/(\w+)\.pm$/ or do { warn "unrecognized ClientAPI file: $file"; next diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index d2b6e0450..a42c306ce 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -4,17 +4,14 @@ use strict; use vars qw($cache); use Digest::MD5 qw(md5_hex); use Date::Format; -use Business::CreditCard; use Cache::SharedMemoryCache; #store in db? use FS::CGI qw(small_custview); #doh use FS::Conf; -use FS::Record qw(qsearch qsearchs); -use FS::Msgcat qw(gettext); +use FS::Record qw(qsearchs); use FS::svc_acct; use FS::svc_domain; use FS::cust_main; use FS::cust_bill; -use FS::cust_main_county; use FS::cust_pkg; use FS::ClientAPI; #hmm @@ -24,8 +21,6 @@ FS::ClientAPI->register_handlers( 'MyAccount/edit_info' => \&edit_info, 'MyAccount/invoice' => \&invoice, 'MyAccount/cancel' => \&cancel, - 'MyAccount/payment_info' => \&payment_info, - 'MyAccount/process_payment' => \&process_payment, 'MyAccount/list_pkgs' => \&list_pkgs, 'MyAccount/order_pkg' => \&order_pkg, 'MyAccount/cancel_pkg' => \&cancel_pkg, @@ -38,7 +33,6 @@ use vars qw( @cust_main_editable_fields ); county state zip country daytime night fax ship_first ship_last ship_company ship_address1 ship_address2 ship_city ship_state ship_zip ship_country ship_daytime ship_night ship_fax - payby payinfo payname ); #store in db? @@ -117,16 +111,6 @@ sub customer_info { $return{$_} = $cust_main->get($_); } - if ( $cust_main->payby =~ /^(CARD|DCRD)$/ ) { - $return{payinfo} = $cust_main->payinfo_masked; - @return{'month', 'year'} = $cust_main->paydate_monthyear; - } - - $return{'invoicing_list'} = - join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list ); - $return{'postal_invoicing'} = - 0 < ( grep { $_ eq 'POST' } $cust_main->invoicing_list ); - } else { #no customer record my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $session->{'svcnum'} } ) @@ -135,6 +119,7 @@ sub customer_info { } + return { 'error' => '', 'custnum' => $custnum, %return, @@ -156,183 +141,13 @@ sub edit_info { my $new = new FS::cust_main { $cust_main->hash }; $new->set( $_ => $p->{$_} ) foreach grep { exists $p->{$_} } @cust_main_editable_fields; - - if ( $p->{'payby'} =~ /^(CARD|DCRD)$/ ) { - $new->paydate($p->{'year'}. '-'. $p->{'month'}. '-01'); - if ( $new->payinfo eq $cust_main->payinfo_masked ) { - $new->payinfo($cust_main->payinfo); - } else { - $new->paycvv($p->{'paycvv'}); - } - } - - my @invoicing_list; - if ( exists $p->{'invoicing_list'} || exists $p->{'postal_invoicing'} ) { - #false laziness with httemplate/edit/process/cust_main.cgi - @invoicing_list = split( /\s*\,\s*/, $p->{'invoicing_list'} ); - push @invoicing_list, 'POST' if $p->{'postal_invoicing'}; - } else { - @invoicing_list = $cust_main->invoicing_list; - } - - my $error = $new->replace($cust_main, \@invoicing_list); + my $error = $new->replace($cust_main); return { 'error' => $error } if $error; #$cust_main = $new; return { 'error' => '' }; } -sub payment_info { - my $p = shift; - my $session = $cache->get($p->{'session_id'}) - or return { 'error' => "Can't resume session" }; #better error message - - my %return; - - my $custnum = $session->{'custnum'}; - - my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) - or return { 'error' => "unknown custnum $custnum" }; - - $return{balance} = $cust_main->balance; - - $return{payname} = $cust_main->payname - || ( $cust_main->first. ' '. $cust_main->get('last') ); - - $return{$_} = $cust_main->get($_) for qw(address1 address2 city state zip); - - $return{payby} = $cust_main->payby; - - if ( $cust_main->payby =~ /^(CARD|DCRD)$/ ) { - #warn $return{card_type} = cardtype($cust_main->payinfo); - $return{payinfo} = $cust_main->payinfo; - - @return{'month', 'year'} = $cust_main->paydate_monthyear; - - } - - #list all counties/states/countries - $return{'cust_main_county'} = - [ map { $_->hashref } qsearch('cust_main_county', {}) ], - - #shortcut for one-country folks - my $conf = new FS::Conf; - my %states = map { $_->state => 1 } - qsearch('cust_main_county', { - 'country' => $conf->config('defaultcountry') || 'US' - } ); - $return{'states'} = [ sort { $a cmp $b } keys %states ]; - - $return{card_types} = { - 'VISA' => 'VISA card', - 'MasterCard' => 'MasterCard', - 'Discover' => 'Discover card', - 'American Express' => 'American Express card', - }; - - my $_date = time; - $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32; - - return { 'error' => '', - %return, - }; - -}; - -#some false laziness with httemplate/process/payment.cgi - look there for -#ACH and CVV support stuff -sub process_payment { - - my $p = shift; - - my $session = $cache->get($p->{'session_id'}) - or return { 'error' => "Can't resume session" }; #better error message - - my %return; - - my $custnum = $session->{'custnum'}; - - my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) - or return { 'error' => "unknown custnum $custnum" }; - - $p->{'payname'} =~ /^([\w \,\.\-\']+)$/ - or return { 'error' => gettext('illegal_name'). " payname: ". $p->{'payname'} }; - my $payname = $1; - - $p->{'paybatch'} =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]*)$/ - or return { 'error' => gettext('illegal_text'). " paybatch: ". $p->{'paybatch'} }; - my $paybatch = $1; - - my $payinfo; - my $paycvv = ''; - #if ( $payby eq 'CHEK' ) { - # - # $p->{'payinfo1'} =~ /^(\d+)$/ - # or return { 'error' => "illegal account number ". $p->{'payinfo1'} }; - # my $payinfo1 = $1; - # $p->{'payinfo2'} =~ /^(\d+)$/ - # or return { 'error' => "illegal ABA/routing number ". $p->{'payinfo2'} }; - # my $payinfo2 = $1; - # $payinfo = $payinfo1. '@'. $payinfo2; - # - #} elsif ( $payby eq 'CARD' ) { - - $payinfo = $p->{'payinfo'}; - $payinfo =~ s/\D//g; - $payinfo =~ /^(\d{13,16})$/ - or return { 'error' => gettext('invalid_card') }; # . ": ". $self->payinfo - $payinfo = $1; - validate($payinfo) - or return { 'error' => gettext('invalid_card') }; # . ": ". $self->payinfo - return { 'error' => gettext('unknown_card_type') } - if cardtype($payinfo) eq "Unknown"; - - if ( defined $cust_main->dbdef_table->column('paycvv') ) { - if ( length($p->{'paycvv'} ) ) { - if ( cardtype($payinfo) eq 'American Express card' ) { - $p->{'paycvv'} =~ /^(\d{4})$/ - or return { 'error' => "CVV2 (CID) for American Express cards is four digits." }; - $paycvv = $1; - } else { - $p->{'paycvv'} =~ /^(\d{3})$/ - or return { 'error' => "CVV2 (CVC2/CID) is three digits." }; - $paycvv = $1; - } - } - } - - #} else { - # die "unknown payby $payby"; - #} - - my $error = $cust_main->realtime_bop( 'CC', $p->{'amount'}, - 'quiet' => 1, - 'payinfo' => $payinfo, - 'paydate' => $p->{'year'}. '-'. $p->{'month'}. '-01', - 'payname' => $payname, - 'paybatch' => $paybatch, - 'paycvv' => $paycvv, - map { $_ => $p->{$_} } qw( address1 address2 city state zip ) - ); - return { 'error' => $error } if $error; - - $cust_main->apply_payments; - - if ( $p->{'save'} ) { - my $new = new FS::cust_main { $cust_main->hash }; - $new->set( $_ => $p->{$_} ) - foreach qw( payname address1 address2 city state zip payinfo ); - $new->set( 'paydate' => $p->{'year'}. '-'. $p->{'month'}. '-01' ); - $new->set( 'payby' => $p->{'auto'} ? 'CARD' : 'DCRD' ); - my $error = $new->replace($cust_main); - return { 'error' => $error } if $error; - $cust_main = $new; - } - - return { 'error' => '' }; - -} - sub invoice { my $p = shift; my $session = $cache->get($p->{'session_id'}) diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 905c60d2b..eedac3fc2 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -309,6 +309,13 @@ httemplate/docs/config.html }, { + 'key' => 'cybercash3.2', + 'section' => 'deprecated', + 'description' => '<b>DEPRECATED</b>, CyberCash no longer exists. Used to enable <a href="http://www.cybercash.com/cashregister/">CyberCash Cashregister v3.2</a> support. Two lines: the full path and name of your merchant_conf file, and the transaction type (`mauthonly\' or `mauthcapture\').', + 'type' => 'textarea', + }, + + { 'key' => 'cyrus', 'section' => 'deprecated', 'description' => '<b>DEPRECATED</b>, add a <i>cyrus</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to integrate with <a href="http://asg.web.cmu.edu/cyrus/imapd/">Cyrus IMAP Server</a>, three lines: IMAP server, admin username, and admin password. Cyrus::IMAP::Admin should be installed locally and the connection to the server secured.', @@ -372,6 +379,13 @@ httemplate/docs/config.html }, { + 'key' => 'domain', + 'section' => 'deprecated', + 'description' => 'Your domain name.', + 'type' => 'text', + }, + + { 'key' => 'editreferrals', 'section' => 'UI', 'description' => 'Enable advertising source modification for existing customers', @@ -400,13 +414,6 @@ httemplate/docs/config.html }, { - 'key' => 'exclude_ip_addr', - 'section' => '', - 'description' => 'Exclude these from the list of available broadband service IP addresses. (One per line)', - 'type' => 'textarea', - }, - - { 'key' => 'erpcdmachines', 'section' => 'deprecated', 'description' => '<b>DEPRECATED</b>, ERPCD is no longer supported. Used to be ERPCD authenticaion machines, one per line. This enables export of `/usr/annex/acp_passwd\' and `/usr/annex/acp_dialup\'', @@ -981,7 +988,7 @@ httemplate/docs/config.html 'section' => '', 'description' => 'Acceptable payment types for the signup server', 'type' => 'selectmultiple', - 'select_enum' => [ qw(CARD DCRD CHEK DCHK LECB PREPAY BILL COMP) ], + 'select_enum' => [ qw(CARD CHEK LECB PREPAY BILL COMP) ], }, { @@ -1109,7 +1116,7 @@ httemplate/docs/config.html 'section' => 'UI', 'description' => 'Default payment type. HIDE disables display of billing information and sets customers to BILL.', 'type' => 'select', - 'select_enum' => [ '', qw(CARD DCRD CHEK DCHK LECB BILL COMP HIDE) ], + 'select_enum' => [ '', qw(CARD CHEK LECB BILL COMP HIDE) ], }, { @@ -1178,12 +1185,6 @@ httemplate/docs/config.html 'description' => 'Allow negative charges. Normally not used unless importing data from a legacy system that requires this.', 'type' => 'checkbox', }, - { - 'key' => 'auto_unset_catchall', - 'section' => '', - 'description' => 'When canceling a svc_acct that is the email catchall for one or more svc_domains, automatically set their catchall fields to null. If this option is not set, the attempt will simply fail.', - 'type' => 'checkbox', - }, { 'key' => 'system_usernames', @@ -1193,13 +1194,6 @@ httemplate/docs/config.html }, { - 'key' => 'cust_pkg-change_svcpart', - 'section' => '', - 'description' => "When changing packages, move services even if svcparts don't match between old and new pacakge definitions. Use with caution! No provision is made for export differences between the old and new service definitions. Probably only should be used when your exports for all service definitions of a given svcdb are identical.", - 'type' => 'checkbox', - }, - - { 'key' => 'disable_autoreverse', 'section' => 'BIND', 'description' => 'Disable automatic synchronization of reverse-ARPA entries.', diff --git a/FS/FS/InitHandler.pm b/FS/FS/InitHandler.pm index 5038cf352..87f507c22 100644 --- a/FS/FS/InitHandler.pm +++ b/FS/FS/InitHandler.pm @@ -1,9 +1,5 @@ package FS::InitHandler; -# this leaks memory under graceful restarts and i wouldn't use it on any -# modern server. useful for very slow machines with memory to spare, just -# always do a full restart - use strict; use vars qw($DEBUG); use FS::UID qw(adminsuidsetup); @@ -52,6 +48,7 @@ sub handler { use FS::session; use FS::svc_acct; use FS::svc_acct_pop; + use FS::svc_acct_sm; use FS::svc_domain; use FS::svc_forward; use FS::svc_www; diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 801b89daf..292b30b5d 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -2,7 +2,7 @@ package FS::Record; use strict; use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG - $me %dbdef_cache %virtual_fields_cache ); + $me %dbdef_cache ); use subs qw(reload_dbdef); use Exporter; use Carp qw(carp cluck croak confess); @@ -10,14 +10,10 @@ use File::CounterFile; use Locale::Country; use DBI qw(:sql_types); use DBIx::DBSchema 0.23; -use FS::UID qw(dbh getotaker datasrc driver_name); +use FS::UID qw(dbh checkruid getotaker datasrc driver_name); use FS::SearchCache; use FS::Msgcat qw(gettext); -use FS::part_virtual_field; - -use Tie::IxHash; - @ISA = qw(Exporter); @EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch); @@ -64,12 +60,14 @@ FS::Record - Database record objects $hashref = $record->hashref; $error = $record->insert; + #$error = $record->add; #deprecated $error = $record->delete; + #$error = $record->del; #deprecated $error = $new_record->replace($old_record); + #$error = $new_record->rep($old_record); #deprecated - # external use deprecated - handled by the database (at least for Pg, mysql) $value = $record->unique('column'); $error = $record->ut_float('column'); @@ -90,7 +88,7 @@ FS::Record - Database record objects $quoted_value = _quote($value,'table','field'); - #deprecated + #depriciated $fields = hfields('table'); if ( $fields->{Field} ) { # etc. @@ -169,7 +167,7 @@ sub create { my $self = {}; bless ($self, $class); if ( defined $self->table ) { - cluck "create constructor is deprecated, use new!"; + cluck "create constructor is depriciated, use new!"; $self->new(@_); } else { croak "FS::Record::create called (not from a subclass)!"; @@ -204,21 +202,18 @@ sub qsearch { my $dbh = dbh; my $table = $cache ? $cache->table : $stable; - my $pkey = $dbdef->table($table)->primary_key; - my @real_fields = grep exists($record->{$_}), real_fields($table); - my @virtual_fields = grep exists($record->{$_}), "FS::$table"->virtual_fields; + my @fields = grep exists($record->{$_}), fields($table); my $statement = "SELECT $select FROM $stable"; - if ( @real_fields or @virtual_fields ) { - $statement .= ' WHERE '. join(' AND ', - ( map { + if ( @fields ) { + $statement .= ' WHERE '. join(' AND ', map { my $op = '='; my $column = $_; if ( ref($record->{$_}) ) { $op = $record->{$_}{'op'} if $record->{$_}{'op'}; - #$op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name ne 'Pg'; + #$op = 'LIKE' if $op =~ /^ILIKE$/i && driver_name !~ /^Pg$/i; if ( uc($op) eq 'ILIKE' ) { $op = 'LIKE'; $record->{$_}{'value'} = lc($record->{$_}{'value'}); @@ -260,45 +255,8 @@ sub qsearch { } else { "$column $op ?"; } - } @real_fields ), - ( map { - my $op = '='; - my $column = $_; - if ( ref($record->{$_}) ) { - $op = $record->{$_}{'op'} if $record->{$_}{'op'}; - if ( uc($op) eq 'ILIKE' ) { - $op = 'LIKE'; - $record->{$_}{'value'} = lc($record->{$_}{'value'}); - $column = "LOWER($_)"; - } - $record->{$_} = $record->{$_}{'value'}; - } - - # ... EXISTS ( SELECT name, value FROM part_virtual_field - # JOIN virtual_field - # ON part_virtual_field.vfieldpart = virtual_field.vfieldpart - # WHERE recnum = svc_acct.svcnum - # AND (name, value) = ('egad', 'brain') ) - - my $value = $record->{$_}; - - my $subq; - - $subq = ($value ? 'EXISTS ' : 'NOT EXISTS ') . - "( SELECT part_virtual_field.name, virtual_field.value ". - "FROM part_virtual_field JOIN virtual_field ". - "ON part_virtual_field.vfieldpart = virtual_field.vfieldpart ". - "WHERE virtual_field.recnum = ${table}.${pkey} ". - "AND part_virtual_field.name = '${column}'". - ($value ? - " AND virtual_field.value ${op} '${value}'" - : "") . ")"; - $subq; - - } @virtual_fields ) ); - + } @fields ); } - $statement .= " $extra_sql" if defined($extra_sql); warn "[debug]$me $statement\n" if $DEBUG > 1; @@ -308,7 +266,7 @@ sub qsearch { my $bind = 1; foreach my $field ( - grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields + grep defined( $record->{$_} ) && $record->{$_} ne '', @fields ) { if ( $record->{$field} =~ /^\d+(\.\d+)?$/ && $dbdef->table($table)->column($field)->type =~ /(int|serial)/i @@ -325,64 +283,31 @@ sub qsearch { $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr; - my %result; - tie %result, "Tie::IxHash"; - @virtual_fields = "FS::$table"->virtual_fields; + $dbh->commit or croak $dbh->errstr if $FS::UID::AutoCommit; - my @stuff = @{ $sth->fetchall_arrayref( {} ) }; - if($pkey) { - %result = map { $_->{$pkey}, $_ } @stuff; - } else { - @result{@stuff} = @stuff; - } - - $sth->finish; - if ( keys(%result) and @virtual_fields ) { - $statement = - "SELECT virtual_field.recnum, part_virtual_field.name, ". - "virtual_field.value ". - "FROM part_virtual_field JOIN virtual_field USING (vfieldpart) ". - "WHERE part_virtual_field.dbtable = '$table' AND ". - "virtual_field.recnum IN (". - join(',', keys(%result)). ") AND part_virtual_field.name IN ('". - join(q!', '!, @virtual_fields) . "')"; - warn "[debug]$me $statement\n" if $DEBUG > 1; - $sth = $dbh->prepare($statement) or croak "$dbh->errstr doing $statement"; - $sth->execute or croak "Error executing \"$statement\": ". $sth->errstr; - - foreach (@{ $sth->fetchall_arrayref({}) }) { - my $recnum = $_->{recnum}; - my $name = $_->{name}; - my $value = $_->{value}; - if (exists($result{$recnum})) { - $result{$recnum}->{$name} = $value; - } - } - } - if ( eval 'scalar(@FS::'. $table. '::ISA);' ) { if ( eval 'FS::'. $table. '->can(\'new\')' eq \&new ) { #derivied class didn't override new method, so this optimization is safe if ( $cache ) { map { new_or_cached( "FS::$table", { %{$_} }, $cache ) - } values(%result); + } @{$sth->fetchall_arrayref( {} )}; } else { map { new( "FS::$table", { %{$_} } ) - } values(%result); + } @{$sth->fetchall_arrayref( {} )}; } } else { warn "untested code (class FS::$table uses custom new method)"; map { eval 'FS::'. $table. '->new( { %{$_} } )'; - } values(%result); + } @{$sth->fetchall_arrayref( {} )}; } } else { cluck "warning: FS::$table not loaded; returning FS::Record objects"; map { FS::Record->new( $table, { %{$_} } ); - } values(%result); + } @{$sth->fetchall_arrayref( {} )}; } } @@ -438,7 +363,7 @@ Returns the table name. =cut sub table { -# cluck "warning: FS::Record::table deprecated; supply one in subclass!"; +# cluck "warning: FS::Record::table depriciated; supply one in subclass!"; my $self = shift; $self -> {'Table'}; } @@ -565,41 +490,25 @@ sub insert { return $error if $error; #single-field unique keys are given a value if false - #(like MySQL's AUTO_INCREMENT or Pg SERIAL) + #(like MySQL's AUTO_INCREMENT) foreach ( $self->dbdef_table->unique->singles ) { $self->unique($_) unless $self->getfield($_); } - - #and also the primary key, if the database isn't going to + #and also the primary key my $primary_key = $self->dbdef_table->primary_key; - my $db_seq = 0; - if ( $primary_key ) { - my $col = $self->dbdef_table->column($primary_key); - - $db_seq = - 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 - ); - $self->unique($primary_key) unless $self->getfield($primary_key) || $db_seq; - } + $self->unique($primary_key) + if $primary_key && ! $self->getfield($primary_key); - my $table = $self->table; #false laziness w/delete - my @real_fields = + my @fields = grep defined($self->getfield($_)) && $self->getfield($_) ne "", - real_fields($table) + $self->fields ; - my @values = map { _quote( $self->getfield($_), $table, $_) } @real_fields; + my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields; #eslaf - my $statement = "INSERT INTO $table ( ". - join( ', ', @real_fields ). + my $statement = "INSERT INTO ". $self->table. " ( ". + join( ', ', @fields ). ") VALUES (". join( ', ', @values ). ")" @@ -607,6 +516,15 @@ sub insert { warn "[debug]$me $statement\n" if $DEBUG > 1; my $sth = dbh->prepare($statement) or return dbh->errstr; + my $h_sth; + if ( defined $dbdef->table('h_'. $self->table) ) { + my $h_statement = $self->_h_statement('insert'); + warn "[debug]$me $h_statement\n" if $DEBUG > 2; + $h_sth = dbh->prepare($h_statement) or return dbh->errstr; + } else { + $h_sth = ''; + } + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -615,92 +533,7 @@ sub insert { local $SIG{PIPE} = 'IGNORE'; $sth->execute or return $sth->errstr; - - my $insertid = ''; - if ( $db_seq ) { # get inserted id from the database, if applicable - warn "[debug]$me retreiving sequence from database\n" if $DEBUG; - if ( driver_name eq 'Pg' ) { - - my $oid = $sth->{'pg_oid_status'}; - my $i_sql = "SELECT $primary_key FROM $table WHERE oid = ?"; - my $i_sth = dbh->prepare($i_sql) or do { - dbh->rollback if $FS::UID::AutoCommit; - return dbh->errstr; - }; - $i_sth->execute($oid) or do { - dbh->rollback if $FS::UID::AutoCommit; - return $i_sth->errstr; - }; - $insertid = $i_sth->fetchrow_arrayref->[0]; - - } elsif ( driver_name eq 'mysql' ) { - - $insertid = dbh->{'mysql_insertid'}; - # work around mysql_insertid being null some of the time, ala RT :/ - unless ( $insertid ) { - warn "WARNING: DBD::mysql didn't return mysql_insertid; ". - "using SELECT LAST_INSERT_ID();"; - my $i_sql = "SELECT LAST_INSERT_ID()"; - my $i_sth = dbh->prepare($i_sql) or do { - dbh->rollback if $FS::UID::AutoCommit; - return dbh->errstr; - }; - $i_sth->execute or do { - dbh->rollback if $FS::UID::AutoCommit; - return $i_sth->errstr; - }; - $insertid = $i_sth->fetchrow_arrayref->[0]; - } - - } else { - dbh->rollback if $FS::UID::AutoCommit; - return "don't know how to retreive inserted ids from ". driver_name. - ", try using counterfiles (maybe run dbdef-create?)"; - } - $self->setfield($primary_key, $insertid); - } - - my @virtual_fields = - grep defined($self->getfield($_)) && $self->getfield($_) ne "", - $self->virtual_fields; - if (@virtual_fields) { - my %v_values = map { $_, $self->getfield($_) } @virtual_fields; - - my $vfieldpart = $self->vfieldpart_hashref; - - my $v_statement = "INSERT INTO virtual_field(recnum, vfieldpart, value) ". - "VALUES (?, ?, ?)"; - - my $v_sth = dbh->prepare($v_statement) or do { - dbh->rollback if $FS::UID::AutoCommit; - return dbh->errstr; - }; - - foreach (keys(%v_values)) { - $v_sth->execute($self->getfield($primary_key), - $vfieldpart->{$_}, - $v_values{$_}) - or do { - dbh->rollback if $FS::UID::AutoCommit; - return $v_sth->errstr; - }; - } - } - - - my $h_sth; - if ( defined $dbdef->table('h_'. $table) ) { - my $h_statement = $self->_h_statement('insert'); - warn "[debug]$me $h_statement\n" if $DEBUG > 2; - $h_sth = dbh->prepare($h_statement) or do { - dbh->rollback if $FS::UID::AutoCommit; - return dbh->errstr; - }; - } else { - $h_sth = ''; - } $h_sth->execute or return $h_sth->errstr if $h_sth; - dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit; ''; @@ -713,7 +546,7 @@ Depriciated (use insert instead). =cut sub add { - cluck "warning: FS::Record::add deprecated!"; + cluck "warning: FS::Record::add depriciated!"; insert @_; #call method in this scope } @@ -731,14 +564,14 @@ sub delete { map { $self->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" - ? ( driver_name eq 'Pg' + ? ( driver_name =~ /^Pg$/i ? "$_ IS NULL" : "( $_ IS NULL OR $_ = \"\" )" ) : "$_ = ". _quote($self->getfield($_),$self->table,$_) } ( $self->dbdef_table->primary_key ) ? ( $self->dbdef_table->primary_key) - : real_fields($self->table) + : $self->fields ); warn "[debug]$me $statement\n" if $DEBUG > 1; my $sth = dbh->prepare($statement) or return dbh->errstr; @@ -752,19 +585,6 @@ sub delete { $h_sth = ''; } - my $primary_key = $self->dbdef_table->primary_key; - my $v_sth; - my @del_vfields; - my $vfp = $self->vfieldpart_hashref; - foreach($self->virtual_fields) { - next if $self->getfield($_) eq ''; - unless(@del_vfields) { - my $st = "DELETE FROM virtual_field WHERE recnum = ? AND vfieldpart = ?"; - $v_sth = dbh->prepare($st) or return dbh->errstr; - } - push @del_vfields, $_; - } - local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -775,10 +595,6 @@ sub delete { my $rc = $sth->execute or return $sth->errstr; #not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0"; $h_sth->execute or return $h_sth->errstr if $h_sth; - $v_sth->execute($self->getfield($primary_key), $vfp->{$_}) - or return $v_sth->errstr - foreach (@del_vfields); - dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit; #no need to needlessly destoy the data either (causes problems actually) @@ -794,7 +610,7 @@ Depriciated (use delete instead). =cut sub del { - cluck "warning: FS::Record::del deprecated!"; + cluck "warning: FS::Record::del depriciated!"; &delete(@_); #call method in this scope } @@ -836,11 +652,8 @@ sub replace { my $error = $new->check; return $error if $error; - #my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields; - my %diff = map { ($new->getfield($_) ne $old->getfield($_)) - ? ($_, $new->getfield($_)) : () } $old->fields; - - unless ( keys(%diff) ) { + my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields; + unless ( @diff ) { carp "[warning]$me $new -> replace $old: records identical"; return ''; } @@ -848,18 +661,18 @@ sub replace { my $statement = "UPDATE ". $old->table. " SET ". join(', ', map { "$_ = ". _quote($new->getfield($_),$old->table,$_) - } real_fields($old->table) + } @diff ). ' WHERE '. join(' AND ', map { $old->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" - ? ( driver_name eq 'Pg' - ? "( $_ IS NULL OR $_ = '' )" + ? ( driver_name =~ /^Pg$/i + ? "( $_ IS NULL OR $_ = '' ) " : "( $_ IS NULL OR $_ = \"\" )" ) : "$_ = ". _quote($old->getfield($_),$old->table,$_) - } ( $primary_key ? ( $primary_key ) : real_fields($old->table) ) + } ( $primary_key ? ( $primary_key ) : $old->fields ) ) ; warn "[debug]$me $statement\n" if $DEBUG > 1; @@ -883,44 +696,6 @@ sub replace { $h_new_sth = ''; } - # For virtual fields we have three cases with different SQL - # statements: add, replace, delete - my $v_add_sth; - my $v_rep_sth; - my $v_del_sth; - my (@add_vfields, @rep_vfields, @del_vfields); - my $vfp = $old->vfieldpart_hashref; - foreach(grep { exists($diff{$_}) } $new->virtual_fields) { - if($diff{$_} eq '') { - # Delete - unless(@del_vfields) { - my $st = "DELETE FROM virtual_field WHERE recnum = ? ". - "AND vfieldpart = ?"; - warn "[debug]$me $st\n" if $DEBUG > 2; - $v_del_sth = dbh->prepare($st) or return dbh->errstr; - } - push @del_vfields, $_; - } elsif($old->getfield($_) eq '') { - # Add - unless(@add_vfields) { - my $st = "INSERT INTO virtual_field (value, recnum, vfieldpart) ". - "VALUES (?, ?, ?)"; - warn "[debug]$me $st\n" if $DEBUG > 2; - $v_add_sth = dbh->prepare($st) or return dbh->errstr; - } - push @add_vfields, $_; - } else { - # Replace - unless(@rep_vfields) { - my $st = "UPDATE virtual_field SET value = ? ". - "WHERE recnum = ? AND vfieldpart = ?"; - warn "[debug]$me $st\n" if $DEBUG > 2; - $v_rep_sth = dbh->prepare($st) or return dbh->errstr; - } - push @rep_vfields, $_; - } - } - local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -932,24 +707,6 @@ sub replace { #not portable #return "Record not found (or records identical)." if $rc eq "0E0"; $h_old_sth->execute or return $h_old_sth->errstr if $h_old_sth; $h_new_sth->execute or return $h_new_sth->errstr if $h_new_sth; - - $v_del_sth->execute($old->getfield($primary_key), - $vfp->{$_}) - or return $v_del_sth->errstr - foreach(@del_vfields); - - $v_add_sth->execute($new->getfield($_), - $old->getfield($primary_key), - $vfp->{$_}) - or return $v_add_sth->errstr - foreach(@add_vfields); - - $v_rep_sth->execute($new->getfield($_), - $old->getfield($primary_key), - $vfp->{$_}) - or return $v_rep_sth->errstr - foreach(@rep_vfields); - dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit; ''; @@ -963,34 +720,18 @@ Depriciated (use replace instead). =cut sub rep { - cluck "warning: FS::Record::rep deprecated!"; + cluck "warning: FS::Record::rep depriciated!"; replace @_; #call method in this scope } =item check -Checks virtual fields (using check_blocks). Subclasses should still provide -a check method to validate real fields, foreign keys, etc., and call this -method via $self->SUPER::check. - -(FIXME: Should this method try to make sure that it I<is> being called from -a subclass's check method, to keep the current semantics as far as possible?) +Not yet implemented, croaks. Derived classes should provide a check method. =cut sub check { - #confess "FS::Record::check not implemented; supply one in subclass!"; - my $self = shift; - - foreach my $field ($self->virtual_fields) { - for ($self->getfield($field)) { - # See notes on check_block in FS::part_virtual_field. - eval $self->pvf($field)->check_block; - return $@ if $@; - $self->setfield($field, $_); - } - } - ''; + confess "FS::Record::check not implemented; supply one in subclass!"; } sub _h_statement { @@ -998,7 +739,7 @@ sub _h_statement { my @fields = grep defined($self->getfield($_)) && $self->getfield($_) ne "", - real_fields($self->table); + $self->fields ; my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields; @@ -1012,13 +753,8 @@ sub _h_statement { =item unique COLUMN -B<Warning>: External use is B<deprecated>. - -Replaces COLUMN in record with a unique number, using counters in the -filesystem. Used by the B<insert> method on single-field unique columns -(see L<DBIx::DBSchema::Table>) and also as a fallback for primary keys -that aren't SERIAL (Pg) or AUTO_INCREMENT (mysql). - +Replaces COLUMN in record with a unique number. Called by the B<add> method +on primary keys and single-field unique columns (see L<DBIx::DBSchema::Table>). Returns the new value. =cut @@ -1027,6 +763,8 @@ sub unique { my($self,$field) = @_; my($table)=$self->table; + #croak("&FS::UID::checkruid failed") unless &checkruid; + croak "Unique called on field $field, but it is ", $self->getfield($field), ", not null!" @@ -1042,8 +780,9 @@ sub unique { # my($counter) = new File::CounterFile "$user/$table.$field",0; # endhack - my $index = $counter->inc; - $index = $counter->inc while qsearchs($table, { $field=>$index } ); + my($index)=$counter->inc; + $index=$counter->inc + while qsearchs($table,{$field=>$index}); #just in case $index =~ /^(\d*)$/; $index=$1; @@ -1394,94 +1133,36 @@ sub ut_foreign_keyn { : ''; } - -=item virtual_fields [ TABLE ] - -Returns a list of virtual fields defined for the table. This should not -be exported, and should only be called as an instance or class method. - -=cut - -sub virtual_fields { - my $self = shift; - my $table; - $table = $self->table or confess "virtual_fields called on non-table"; - - confess "Unknown table $table" unless $dbdef->table($table); - - return () unless $self->dbdef->table('part_virtual_field'); - - unless ( $virtual_fields_cache{$table} ) { - my $query = 'SELECT name from part_virtual_field ' . - "WHERE dbtable = '$table'"; - my $dbh = dbh; - my $result = $dbh->selectcol_arrayref($query); - confess $dbh->errstr if $dbh->err; - $virtual_fields_cache{$table} = $result; - } - - @{$virtual_fields_cache{$table}}; - -} - - =item fields [ TABLE ] -This is a wrapper for real_fields and virtual_fields. Code that called -fields before should probably continue to call fields. +This can be used as both a subroutine and a method call. It returns a list +of the columns in this record's table, or an explicitly specified table. +(See L<DBIx::DBSchema::Table>). =cut +# Usage: @fields = fields($table); +# @fields = $record->fields; sub fields { my $something = shift; my $table; - if($something->isa('FS::Record')) { + if ( ref($something) ) { $table = $something->table; } else { $table = $something; - $something = "FS::$table"; } - return (real_fields($table), $something->virtual_fields()); + #croak "Usage: \@fields = fields(\$table)\n or: \@fields = \$record->fields" unless $table; + my($table_obj) = $dbdef->table($table); + confess "Unknown table $table" unless $table_obj; + $table_obj->columns; } =back -=item pvf FIELD_NAME - -Returns the FS::part_virtual_field object corresponding to a field in the -record (specified by FIELD_NAME). - -=cut - -sub pvf { - my ($self, $name) = (shift, shift); - - if(grep /^$name$/, $self->virtual_fields) { - return qsearchs('part_virtual_field', { dbtable => $self->table, - name => $name } ); - } - '' -} - =head1 SUBROUTINES =over 4 -=item real_fields [ TABLE ] - -Returns a list of the real columns in the specified table. Called only by -fields() and other subroutines elsewhere in FS::Record. - -=cut - -sub real_fields { - my $table = shift; - - my($table_obj) = $dbdef->table($table); - confess "Unknown table $table" unless $table_obj; - $table_obj->columns; -} - =item reload_dbdef([FILENAME]) Load a database definition (see L<DBIx::DBSchema>), optionally from a @@ -1540,40 +1221,16 @@ sub _quote { } } -=item vfieldpart_hashref TABLE - -Returns a hashref of virtual field names and vfieldparts applicable to the given -TABLE. - -=cut - -sub vfieldpart_hashref { - my $self = shift; - my $table = $self->table; - - return {} unless $self->dbdef->table('part_virtual_field'); - - my $dbh = dbh; - my $statement = "SELECT vfieldpart, name FROM part_virtual_field WHERE ". - "dbtable = '$table'"; - my $sth = $dbh->prepare($statement); - $sth->execute or croak "Execution of '$statement' failed: ".$dbh->errstr; - return { map { $_->{name}, $_->{vfieldpart} } - @{$sth->fetchall_arrayref({})} }; - -} - - =item hfields TABLE -This is deprecated. Don't use it. +This is depriciated. Don't use it. It returns a hash-type list with the fields of this record's table set true. =cut sub hfields { - carp "warning: hfields is deprecated"; + carp "warning: hfields is depriciated"; my($table)=@_; my(%hash); foreach (fields($table)) { @@ -1609,7 +1266,7 @@ sub DESTROY { return; } This module should probably be renamed, since much of the functionality is of general use. It is not completely unlike Adapter::DBI (see below). -Exported qsearch and qsearchs should be deprecated in favor of method calls +Exported qsearch and qsearchs should be depriciated in favor of method calls (against an FS::Record object like the old search and searchs that qsearch and qsearchs were on top of.) @@ -1617,7 +1274,7 @@ The whole fields / hfields mess should be removed. The various WHERE clauses should be subroutined. -table string should be deprecated in favor of DBIx::DBSchema::Table. +table string should be depriciated in favor of DBIx::DBSchema::Table. No doubt we could benefit from a Tied hash. Documenting how exists / defined true maps to the database (and WHERE clauses) would also help. diff --git a/FS/FS/Report.pm b/FS/FS/Report.pm deleted file mode 100644 index 181fea2f6..000000000 --- a/FS/FS/Report.pm +++ /dev/null @@ -1,46 +0,0 @@ -package FS::Report; - -use strict; - -=head1 NAME - -FS::Report - Report data objects - -=head1 SYNOPSIS - - #see the more speicific report objects, currently only FS::Report::Table - -=head1 DESCRIPTION - -See the more specific report objects, currently only FS::Report::Table - -=head1 METHODS - -=over 4 - -=item new [ OPTION => VALUE ... ] - -Constructor. Takes a list of options and their values. - -=cut - -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = @_ ? ( ref($_[0]) ? shift : { @_ } ) : {}; - bless( $self, $class ); -} - -=back - -=head1 BUGS - -Documentation. - -=head1 SEE ALSO - -L<FS::Report::Table>, reports in the web interface. - -=cut - -1; diff --git a/FS/FS/Report/Table.pm b/FS/FS/Report/Table.pm deleted file mode 100644 index 9f636fa43..000000000 --- a/FS/FS/Report/Table.pm +++ /dev/null @@ -1,27 +0,0 @@ -package FS::Report::Table; - -use strict; -use vars qw( @ISA ); -use FS::Report; - -@ISA = qw( FS::Report ); - -=head1 NAME - -FS::Report::Table - Tables of report data - -=head1 SYNOPSIS - -See the more specific report objects, currently only FS::Report::Table::Monthly - -=head1 BUGS - -Documentation. - -=head1 SEE ALSO - -L<FS::Report::Table::Monthly>, reports in the web interface. - -=cut - -1; diff --git a/FS/FS/Report/Table/Monthly.pm b/FS/FS/Report/Table/Monthly.pm deleted file mode 100644 index d3ff5d1db..000000000 --- a/FS/FS/Report/Table/Monthly.pm +++ /dev/null @@ -1,172 +0,0 @@ -package FS::Report::Table::Monthly; - -use strict; -use vars qw( @ISA $expenses_kludge ); -use Time::Local; -use FS::UID qw( dbh ); -use FS::Report::Table; - -@ISA = qw( FS::Report::Table ); - -$expenses_kludge = 0; - -=head1 NAME - -FS::Report::Table::Monthly - Tables of report data, indexed monthly - -=head1 SYNOPSIS - - use FS::Report::Table::Monthly; - - my $report = new FS::Report::Table::Monthly ( - 'items' => [ 'invoiced', 'netsales', 'credits', 'receipts', ], - 'start_month' => 4, - 'start_year' => 2000, - 'end_month' => 4, - 'end_year' => 2020, - ); - - my $data = $report->data; - -=head1 METHODS - -=over 4 - -=item data - -Returns a hashref of data (!! describe) - -=cut - -sub data { - my $self = shift; - - my $smonth = $self->{'start_month'}; - my $syear = $self->{'start_year'}; - my $emonth = $self->{'end_month'}; - my $eyear = $self->{'end_year'}; - - my %data; - - while ( $syear < $eyear || ( $syear == $eyear && $smonth < $emonth+1 ) ) { - - push @{$data{label}}, "$smonth/$syear"; - - my $speriod = timelocal(0,0,0,1,$smonth-1,$syear); - push @{$data{speriod}}, $speriod; - if ( ++$smonth == 13 ) { $syear++; $smonth=1; } - my $eperiod = timelocal(0,0,0,1,$smonth-1,$syear); - push @{$data{eperiod}}, $eperiod; - - foreach my $item ( @{$self->{'items'}} ) { - push @{$data{$item}}, $self->$item($speriod, $eperiod); - } - - } - - \%data; - -} - -sub invoiced { #invoiced - my( $self, $speriod, $eperiod ) = ( shift, shift, shift ); - $self->scalar_sql(" - SELECT SUM(charged) FROM cust_bill - WHERE ". $self->in_time_period($speriod, $eperiod) - ); -} - -sub netsales { #net sales - my( $self, $speriod, $eperiod ) = ( shift, shift, shift ); - - my $credited = $self->scalar_sql(" - SELECT SUM(cust_credit_bill.amount) - FROM cust_credit_bill, cust_bill - WHERE cust_bill.invnum = cust_credit_bill.invnum - AND ". $self->in_time_period($speriod, $eperiod, 'cust_bill') - ); - - #horrible local kludge - my $expenses = !$expenses_kludge ? 0 : $self->scalar_sql(" - SELECT SUM(cust_bill_pkg.setup) - FROM cust_bill_pkg, cust_bill, cust_pkg, part_pkg - WHERE cust_bill.invnum = cust_bill_pkg.invnum - AND ". $self->in_time_period($speriod, $eperiod, 'cust_bill'). " - AND cust_pkg.pkgnum = cust_bill_pkg.pkgnum - AND cust_pkg.pkgpart = part_pkg.pkgpart - AND LOWER(part_pkg.pkg) LIKE 'expense _%' - "); - - $self->invoiced($speriod,$eperiod) - $credited - $expenses; -} - -#deferred revenue - -sub receipts { #cashflow - my( $self, $speriod, $eperiod ) = ( shift, shift, shift ); - - my $refunded = $self->scalar_sql(" - SELECT SUM(refund) FROM cust_refund - WHERE ". $self->in_time_period($speriod, $eperiod) - ); - - #horrible local kludge that doesn't even really work right - my $expenses = !$expenses_kludge ? 0 : $self->scalar_sql(" - SELECT SUM(cust_bill_pay.amount) - FROM cust_bill_pay, cust_bill - WHERE cust_bill_pay.invnum = cust_bill.invnum - AND ". $self->in_time_period($speriod, $eperiod, 'cust_bill_pay'). " - AND 0 < ( SELECT COUNT(*) from cust_bill_pkg, cust_pkg, part_pkg - WHERE cust_bill.invnum = cust_bill_pkg.invnum - AND cust_pkg.pkgnum = cust_bill_pkg.pkgnum - AND cust_pkg.pkgpart = part_pkg.pkgpart - AND LOWER(part_pkg.pkg) LIKE 'expense _%' - ) - "); - # my $expenses_sql2 = "SELECT SUM(cust_bill_pay.amount) FROM cust_bill_pay, cust_bill_pkg, cust_bill, cust_pkg, part_pkg WHERE cust_bill_pay.invnum = cust_bill.invnum AND cust_bill.invnum = cust_bill_pkg.invnum AND cust_bill_pay._date >= $speriod AND cust_bill_pay._date < $eperiod AND cust_pkg.pkgnum = cust_bill_pkg.pkgnum AND cust_pkg.pkgpart = part_pkg.pkgpart AND LOWER(part_pkg.pkg) LIKE 'expense _%'"; - - $self->payments($speriod, $eperiod) - $refunded - $expenses; -} - -sub payments { - my( $self, $speriod, $eperiod ) = ( shift, shift, shift ); - $self->scalar_sql(" - SELECT SUM(paid) FROM cust_pay - WHERE ". $self->in_time_period($speriod, $eperiod) - ); -} - -sub credits { - my( $self, $speriod, $eperiod ) = ( shift, shift, shift ); - $self->scalar_sql(" - SELECT SUM(amount) FROM cust_credit - WHERE ". $self->in_time_period($speriod, $eperiod) - ); -} - -sub in_time_period { - my( $self, $speriod, $eperiod ) = ( shift, shift, shift ); - my $table = @_ ? shift().'.' : ''; - "${table}_date >= $speriod AND ${table}_date < $eperiod"; -} - -sub scalar_sql { - my( $self, $sql ) = ( shift, shift ); - my $sth = dbh->prepare($sql) or die dbh->errstr; - $sth->execute - or die "Unexpected error executing statement $sql: ". $sth->errstr; - $sth->fetchrow_arrayref->[0] || 0; -} - -=back - -=head1 BUGS - -Documentation. - -=head1 SEE ALSO - -=cut - -1; - diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index 8271f89f2..f56ba3915 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -195,7 +195,9 @@ Returns the current Freeside user. =cut sub getotaker { - $user; + #$user; + #stupid kludge until schema otaker fields are not 8 chars + substr($user,0,8); } =item cgisetotaker diff --git a/FS/FS/addr_block.pm b/FS/FS/addr_block.pm deleted file mode 100755 index 1fb60606d..000000000 --- a/FS/FS/addr_block.pm +++ /dev/null @@ -1,331 +0,0 @@ -package FS::addr_block; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearchs qsearch dbh ); -use FS::router; -use FS::svc_broadband; -use FS::Conf; -use NetAddr::IP; - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::addr_block - Object methods for addr_block records - -=head1 SYNOPSIS - - use FS::addr_block; - - $record = new FS::addr_block \%hash; - $record = new FS::addr_block { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::addr_block record describes an address block assigned for broadband -access. FS::addr_block inherits from FS::Record. The following fields are -currently supported: - -=over 4 - -=item blocknum - primary key, used in FS::svc_broadband to associate -services to the block. - -=item routernum - the router (see FS::router) to which this -block is assigned. - -=item ip_gateway - the gateway address used by customers within this block. - -=item ip_netmask - the netmask of the block, expressed as an integer. - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Create a new record. To add the record to the database, see "insert". - -=cut - -sub table { 'addr_block'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Deletes this record from the database. If there is an error, returns the -error, otherwise returns false. - -sub delete { - my $self = shift; - return 'Block must be deallocated before deletion' - if $self->router; - - $self->SUPER::delete; -} - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -Checks all fields to make sure this is a valid record. If there is an error, -returns the error, otherwise returns false. Called by the insert and replace -methods. - -=cut - -sub check { - my $self = shift; - - my $error = - $self->ut_number('routernum') - || $self->ut_ip('ip_gateway') - || $self->ut_number('ip_netmask') - ; - return $error if $error; - - - # A routernum of 0 indicates an unassigned block and is allowed - return "Unknown routernum" - if ($self->routernum and not $self->router); - - my $self_addr = $self->NetAddr; - return "Cannot parse address: ". $self->ip_gateway . '/' . $self->ip_netmask - unless $self_addr; - - if (not $self->blocknum) { - my @block = grep { - my $block_addr = $_->NetAddr; - if($block_addr->contains($self_addr) - or $self_addr->contains($block_addr)) { $_; }; - } qsearch( 'addr_block', {}); - foreach(@block) { - return "Block intersects existing block ".$_->ip_gateway."/".$_->ip_netmask; - } - } - - $self->SUPER::check; -} - - -=item router - -Returns the FS::router object corresponding to this object. If the -block is unassigned, returns undef. - -=cut - -sub router { - my $self = shift; - return qsearchs('router', { routernum => $self->routernum }); -} - -=item svc_broadband - -Returns a list of FS::svc_broadband objects associated -with this object. - -=cut - -sub svc_broadband { - my $self = shift; - return qsearch('svc_broadband', { blocknum => $self->blocknum }); -} - -=item NetAddr - -Returns a NetAddr::IP object for this block's address and netmask. - -=cut - -sub NetAddr { - my $self = shift; - - return new NetAddr::IP ($self->ip_gateway, $self->ip_netmask); -} - -=item next_free_addr - -Returns a NetAddr::IP object corresponding to the first unassigned address -in the block (other than the network, broadcast, or gateway address). If -there are no free addresses, returns false. - -=cut - -sub next_free_addr { - my $self = shift; - - my $conf = new FS::Conf; - my @excludeaddr = $conf->config('exclude_ip_addr'); - -my @used = -( (map { $_->NetAddr->addr } - ($self, - qsearch('svc_broadband', { blocknum => $self->blocknum })) - ), @excludeaddr -); - - my @free = $self->NetAddr->hostenum; - while (my $ip = shift @free) { - if (not grep {$_ eq $ip->addr;} @used) { return $ip; }; - } - - ''; - -} - -=item allocate - -Allocates this address block to a router. Takes an FS::router object -as an argument. - -At present it's not possible to reallocate a block to a different router -except by deallocating it first, which requires that none of its addresses -be assigned. This is probably as it should be. - -=cut - -sub allocate { - my ($self, $router) = @_; - - return 'Block is already allocated' - if($self->router); - - return 'Block must be allocated to a router' - unless(ref $router eq 'FS::router'); - - my @svc = $self->svc_broadband; - if (@svc) { - return 'Block has assigned addresses: '. join ', ', map {$_->ip_addr} @svc; - } - - my $new = new FS::addr_block {$self->hash}; - $new->routernum($router->routernum); - return $new->replace($self); - -} - -=item deallocate - -Deallocates the block (i.e. sets the routernum to 0). If any addresses in the -block are assigned to services, it fails. - -=cut - -sub deallocate { - my $self = shift; - - my @svc = $self->svc_broadband; - if (@svc) { - return 'Block has assigned addresses: '. join ', ', map {$_->ip_addr} @svc; - } - - my $new = new FS::addr_block {$self->hash}; - $new->routernum(0); - return $new->replace($self); -} - -=item split_block - -Splits this address block into two equal blocks, occupying the same space as -the original block. The first of the two will also have the same blocknum. -The gateway address of each block will be set to the first usable address, i.e. -(network address)+1. Since this method is designed for use on unallocated -blocks, this is probably the correct behavior. - -(At present, splitting allocated blocks is disallowed. Anyone who wants to -implement this is reminded that each split costs three addresses, and any -customers who were using these addresses will have to be moved; depending on -how full the block was before being split, they might have to be moved to a -different block. Anyone who I<still> wants to implement it is asked to tie it -to a configuration switch so that site admins can disallow it.) - -=cut - -sub split_block { - - # We should consider using Attribute::Handlers/Aspect/Hook::LexWrap/ - # something to atomicize functions, so that we can say - # - # sub split_block : atomic { - # - # instead of repeating all this AutoCommit verbage in every - # sub that does more than one database operation. - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $self = shift; - my $error; - - if ($self->router) { - return 'Block is already allocated'; - } - - #TODO: Smallest allowed block should be a config option. - if ($self->NetAddr->masklen() ge 30) { - return 'Cannot split blocks with a mask length >= 30'; - } - - my (@new, @ip); - $ip[0] = $self->NetAddr; - @ip = map {$_->first()} $ip[0]->split($self->ip_netmask + 1); - - foreach (0,1) { - $new[$_] = new FS::addr_block {$self->hash}; - $new[$_]->ip_gateway($ip[$_]->addr); - $new[$_]->ip_netmask($ip[$_]->masklen); - } - - $new[1]->blocknum(''); - - $error = $new[0]->replace($self); - if ($error) { - $dbh->rollback; - return $error; - } - - $error = $new[1]->insert; - if ($error) { - $dbh->rollback; - return $error; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - return ''; -} - -=item merge - -To be implemented. - -=back - -=head1 BUGS - -Minimum block size should be a config option. It's hardcoded at /30 right -now because that's the smallest block that makes any sense at all. - -=cut - -1; - diff --git a/FS/FS/agent.pm b/FS/FS/agent.pm index 2f70d654d..9b7492d07 100644 --- a/FS/FS/agent.pm +++ b/FS/FS/agent.pm @@ -137,7 +137,8 @@ sub check { return "Unknown typenum!" unless $self->agent_type; - $self->SUPER::check; + ''; + } =item agent_type @@ -168,7 +169,7 @@ sub pkgpart_hashref { =head1 VERSION -$Id: agent.pm,v 1.6 2003-09-30 15:01:46 ivan Exp $ +$Id: agent.pm,v 1.3.4.2 2003-09-30 15:01:42 ivan Exp $ =head1 BUGS diff --git a/FS/FS/agent_type.pm b/FS/FS/agent_type.pm index 5ba5ef291..988533ae3 100644 --- a/FS/FS/agent_type.pm +++ b/FS/FS/agent_type.pm @@ -102,8 +102,7 @@ sub check { my $self = shift; $self->ut_numbern('typenum') - or $self->ut_text('atype') - or $self->SUPER::check; + or $self->ut_text('atype'); } @@ -151,7 +150,7 @@ sub pkgpart { =head1 VERSION -$Id: agent_type.pm,v 1.2 2003-08-05 00:20:40 khoff Exp $ +$Id: agent_type.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 7e2c8fb55..2639abfae 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -2,12 +2,19 @@ package FS::cust_bill; use strict; use vars qw( @ISA $conf $money_char ); +use vars qw( $lpr $invoice_from $smtpmachine ); +use vars qw( $cybercash ); +use vars qw( $xaction $E_NoErr ); +use vars qw( $bop_processor $bop_login $bop_password $bop_action @bop_options ); +use vars qw( $ach_processor $ach_login $ach_password $ach_action @ach_options ); use vars qw( $invoice_lines @buf ); #yuck +use vars qw( $realtime_bop_decline_quiet ); use Date::Format; +use Mail::Internet 1.44; +use Mail::Header; use Text::Template; use FS::UID qw( datasrc ); use FS::Record qw( qsearch qsearchs ); -use FS::Misc qw( send_email ); use FS::cust_main; use FS::cust_bill_pkg; use FS::cust_credit; @@ -19,11 +26,70 @@ use FS::cust_bill_event; @ISA = qw( FS::Record ); +$realtime_bop_decline_quiet = 0; + #ask FS::UID to run this stuff for us later -FS::UID->install_callback( sub { +$FS::UID::callback{'FS::cust_bill'} = sub { + $conf = new FS::Conf; + $money_char = $conf->config('money_char') || '$'; -} ); + + $lpr = $conf->config('lpr'); + $invoice_from = $conf->config('invoice_from'); + $smtpmachine = $conf->config('smtpmachine'); + + ( $bop_processor,$bop_login, $bop_password, $bop_action ) = ( '', '', '', ''); + @bop_options = (); + ( $ach_processor,$ach_login, $ach_password, $ach_action ) = ( '', '', '', ''); + @ach_options = (); + + if ( $conf->exists('cybercash3.2') ) { + require CCMckLib3_2; + #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2); + require CCMckDirectLib3_2; + #qw(SendCC2_1Server); + require CCMckErrno3_2; + #qw(MCKGetErrorMessage $E_NoErr); + import CCMckErrno3_2 qw($E_NoErr); + + my $merchant_conf; + ($merchant_conf,$xaction)= $conf->config('cybercash3.2'); + my $status = &CCMckLib3_2::InitConfig($merchant_conf); + if ( $status != $E_NoErr ) { + warn "CCMckLib3_2::InitConfig error:\n"; + foreach my $key (keys %CCMckLib3_2::Config) { + warn " $key => $CCMckLib3_2::Config{$key}\n" + } + my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status); + die "CCMckLib3_2::InitConfig fatal error: $errmsg\n"; + } + $cybercash='cybercash3.2'; + } elsif ( $conf->exists('business-onlinepayment') ) { + ( $bop_processor, + $bop_login, + $bop_password, + $bop_action, + @bop_options + ) = $conf->config('business-onlinepayment'); + $bop_action ||= 'normal authorization'; + ( $ach_processor, $ach_login, $ach_password, $ach_action, @ach_options ) = + ( $bop_processor, $bop_login, $bop_password, $bop_action, @bop_options ); + eval "use Business::OnlinePayment"; + } + + if ( $conf->exists('business-onlinepayment-ach') ) { + ( $ach_processor, + $ach_login, + $ach_password, + $ach_action, + @ach_options + ) = $conf->config('business-onlinepayment-ach'); + $ach_action ||= 'normal authorization'; + eval "use Business::OnlinePayment"; + } + +}; =head1 NAME @@ -161,7 +227,7 @@ sub check { $self->printed(0) if $self->printed eq ''; - $self->SUPER::check; + ''; #no error } =item previous @@ -328,18 +394,32 @@ sub send { my @print_text = $self->print_text('', $template); my @invoicing_list = $self->cust_main->invoicing_list; - if ( grep { $_ ne 'POST' } @invoicing_list or !@invoicing_list ) { #email + if ( grep { $_ ne 'POST' } @invoicing_list or !@invoicing_list ) { #email #better to notify this person than silence - @invoicing_list = ($conf->config('invoice_from')) unless @invoicing_list; - - my $error = send_email( - 'from' => $conf->config('invoice_from'), - 'to' => [ grep { $_ ne 'POST' } @invoicing_list ], - 'subject' => 'Invoice', - 'body' => \@print_text, + @invoicing_list = ($invoice_from) unless @invoicing_list; + + #false laziness w/FS::cust_pay::delete & fs_signup_server && ::realtime_card + #$ENV{SMTPHOSTS} = $smtpmachine; + $ENV{MAILADDRESS} = $invoice_from; + my $header = new Mail::Header ( [ + "From: $invoice_from", + "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ), + "Sender: $invoice_from", + "Reply-To: $invoice_from", + "Date: ". time2str("%a, %d %b %Y %X %z", time), + "Subject: Invoice", + ] ); + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => [ @print_text ], #( date) ); - die "can't email invoice: $error\n" if $error; + $!=0; + $message->smtpsend( Host => $smtpmachine ) + or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) + or die "(customer # ". $self->custnum. ") can't send invoice email". + " to ". join(', ', grep { $_ ne 'POST' } @invoicing_list ). + " via server $smtpmachine with SMTP: $!\n"; } @@ -348,7 +428,6 @@ sub send { } if ( grep { $_ eq 'POST' } @invoicing_list ) { #postal - my $lpr = $conf->config('lpr'); open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!\n"; print LPR @print_text; @@ -481,13 +560,10 @@ sub send_csv { time2str("%x", $cust_bill_pkg->edate), ); - } else { #pkgnum tax + } else { #pkgnum Tax next unless $cust_bill_pkg->setup != 0; - my $itemdesc = defined $cust_bill_pkg->dbdef_table->column('itemdesc') - ? ( $cust_bill_pkg->itemdesc || 'Tax' ) - : 'Tax'; ($pkg, $setup, $recur, $sdate, $edate) = - ( $itemdesc, sprintf("%10.2f",$cust_bill_pkg->setup), '', '', '' ); + ( 'Tax', sprintf("%10.2f",$cust_bill_pkg->setup), '', '', '' ); } $csv->combine( @@ -559,7 +635,15 @@ for supported processors. sub realtime_card { my $self = shift; - $self->realtime_bop( 'CC', @_ ); + $self->realtime_bop( + 'CC', + $bop_processor, + $bop_login, + $bop_password, + $bop_action, + \@bop_options, + @_ + ); } =item realtime_ach @@ -573,7 +657,15 @@ for supported processors. sub realtime_ach { my $self = shift; - $self->realtime_bop( 'ECHECK', @_ ); + $self->realtime_bop( + 'ECHECK', + $ach_processor, + $ach_login, + $ach_password, + $ach_action, + \@ach_options, + @_ + ); } =item realtime_lec @@ -587,11 +679,22 @@ for supported processors. sub realtime_lec { my $self = shift; - $self->realtime_bop( 'LEC', @_ ); + $self->realtime_bop( + 'LEC', + $bop_processor, + $bop_login, + $bop_password, + $bop_action, + \@bop_options, + @_ + ); } sub realtime_bop { - my( $self, $method ) = @_; + my( $self, $method, $processor, $login, $password, $action, $options ) = @_; + + #trim an extraneous blank line + pop @$options if scalar(@$options) % 2 && $options->[-1] =~ /^\s*$/; my $cust_main = $self->cust_main; my $balance = $cust_main->balance; @@ -599,6 +702,33 @@ sub realtime_bop { $amount = sprintf("%.2f", $amount); return "not run (balance $balance)" unless $amount > 0; + my $address = $cust_main->address1; + $address .= ", ". $cust_main->address2 if $cust_main->address2; + + my($payname, $payfirst, $paylast); + if ( $cust_main->payname && $method ne 'ECHECK' ) { + $payname = $cust_main->payname; + $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ + or do { + #$dbh->rollback if $oldAutoCommit; + return "Illegal payname $payname"; + }; + ($payfirst, $paylast) = ($1, $2); + } else { + $payfirst = $cust_main->getfield('first'); + $paylast = $cust_main->getfield('last'); + $payname = "$payfirst $paylast"; + } + + my @invoicing_list = grep { $_ ne 'POST' } $cust_main->invoicing_list; + if ( $conf->exists('emailinvoiceauto') + || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { + push @invoicing_list, $cust_main->all_emails; + } + my $email = $invoicing_list[0]; + + my( $action1, $action2 ) = split(/\s*\,\s*/, $action ); + my $description = 'Internet Services'; if ( $conf->exists('business-onlinepayment-description') ) { my $dtempl = $conf->config('business-onlinepayment-description'); @@ -612,13 +742,282 @@ sub realtime_bop { grep { $_->pkgnum } $self->cust_bill_pkg ); $description = eval qq("$dtempl"); + + } + + my %content; + if ( $method eq 'CC' ) { + + $content{card_number} = $cust_main->payinfo; + $cust_main->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + $content{expiration} = "$2/$1"; + + $content{cvv2} = $cust_main->paycvv + if defined $cust_main->dbdef_table->column('paycvv') + && length($cust_main->paycvv); + + $content{recurring_billing} = 'YES' + if qsearch('cust_pay', { 'custnum' => $cust_main->custnum, + 'payby' => 'CARD', + 'payinfo' => $cust_main->payinfo, } ); + + } elsif ( $method eq 'ECHECK' ) { + my($account_number,$routing_code) = $cust_main->payinfo; + ( $content{account_number}, $content{routing_code} ) = + split('@', $cust_main->payinfo); + $content{bank_name} = $cust_main->payname; + $content{account_type} = 'CHECKING'; + $content{account_name} = $payname; + $content{customer_org} = $self->company ? 'B' : 'I'; + $content{customer_ssn} = $self->ss; + } elsif ( $method eq 'LEC' ) { + $content{phone} = $cust_main->payinfo; + } + + my $transaction = + new Business::OnlinePayment( $processor, @$options ); + $transaction->content( + 'type' => $method, + 'login' => $login, + 'password' => $password, + 'action' => $action1, + 'description' => $description, + 'amount' => $amount, + 'invoice_number' => $self->invnum, + 'customer_id' => $self->custnum, + 'last_name' => $paylast, + 'first_name' => $payfirst, + 'name' => $payname, + 'address' => $address, + 'city' => $cust_main->city, + 'state' => $cust_main->state, + 'zip' => $cust_main->zip, + 'country' => $cust_main->country, + 'referer' => 'http://cleanwhisker.420.am/', + 'email' => $email, + 'phone' => $cust_main->daytime || $cust_main->night, + %content, #after + ); + $transaction->submit(); + + if ( $transaction->is_success() && $action2 ) { + my $auth = $transaction->authorization; + my $ordernum = $transaction->can('order_number') + ? $transaction->order_number + : ''; + + #warn "********* $auth ***********\n"; + #warn "********* $ordernum ***********\n"; + my $capture = + new Business::OnlinePayment( $processor, @$options ); + + my %capture = ( + %content, + type => $method, + action => $action2, + login => $login, + password => $password, + order_number => $ordernum, + amount => $amount, + authorization => $auth, + description => $description, + ); + + foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code + transaction_sequence_num local_transaction_date + local_transaction_time AVS_result_code )) { + $capture{$field} = $transaction->$field() if $transaction->can($field); + } + + $capture->content( %capture ); + + $capture->submit(); + + unless ( $capture->is_success ) { + my $e = "Authorization sucessful but capture failed, invnum #". + $self->invnum. ': '. $capture->result_code. + ": ". $capture->error_message; + warn $e; + return $e; + } + + } + + #remove paycvv after initial transaction + #make this disable-able via a config option if anyone insists? + # (though that probably violates cardholder agreements) + use Business::CreditCard; + if ( defined $cust_main->dbdef_table->column('paycvv') + && length($cust_main->paycvv) + && ! grep { $_ eq cardtype($cust_main->payinfo) } $conf->config('cvv-save') + + ) { + my $new = new FS::cust_main { $cust_main->hash }; + $new->paycvv(''); + my $error = $new->replace($cust_main); + if ( $error ) { + warn "error removing cvv: $error\n"; + } } - $cust_main->realtime_bop($method, $amount, - 'description' => $description, - 'invnum' => $self->invnum, + #result handling + if ( $transaction->is_success() ) { + + my %method2payby = ( + 'CC' => 'CARD', + 'ECHECK' => 'CHEK', + 'LEC' => 'LECB', + ); + + my $cust_pay = new FS::cust_pay ( { + 'invnum' => $self->invnum, + 'paid' => $amount, + '_date' => '', + 'payby' => $method2payby{$method}, + 'payinfo' => $cust_main->payinfo, + 'paybatch' => "$processor:". $transaction->authorization, + } ); + my $error = $cust_pay->insert; + if ( $error ) { + $cust_pay->invnum(''); #try again with no specific invnum + my $error2 = $cust_pay->insert; + if ( $error2 ) { + # gah, even with transactions. + my $e = 'WARNING: Card/ACH debited but database not updated - '. + "error inserting payment ($processor): $error2". + ' (previously tried insert with invnum #' . $self->invnum. + ": $error )"; + warn $e; + return $e; + } + } + return ''; #no error + + #} elsif ( $options{'report_badcard'} ) { + } else { + + my $perror = "$processor error, invnum #". $self->invnum. ': '. + $transaction->result_code. ": ". $transaction->error_message; + + if ( !$realtime_bop_decline_quiet && $conf->exists('emaildecline') + && grep { $_ ne 'POST' } $cust_main->invoicing_list + && ! grep { $transaction->error_message =~ /$_/ } + $conf->config('emaildecline-exclude') + ) { + my @templ = $conf->config('declinetemplate'); + my $template = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", @templ ], + ) or return "($perror) can't create template: $Text::Template::ERROR"; + $template->compile() + or return "($perror) can't compile template: $Text::Template::ERROR"; + + my $templ_hash = { error => $transaction->error_message }; + + #false laziness w/FS::cust_pay::delete & fs_signup_server && ::send + $ENV{MAILADDRESS} = $invoice_from; + my $header = new Mail::Header ( [ + "From: $invoice_from", + "To: ". join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list ), + "Sender: $invoice_from", + "Reply-To: $invoice_from", + "Date: ". time2str("%a, %d %b %Y %X %z", time), + "Subject: Your payment could not be processed", + ] ); + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => [ $template->fill_in(HASH => $templ_hash) ], + ); + $!=0; + $message->smtpsend( Host => $smtpmachine ) + or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) + or return "($perror) (customer # ". $self->custnum. + ") can't send card decline email to ". + join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list ). + " via server $smtpmachine with SMTP: $!"; + } + + return $perror; + } + +} + +=item realtime_card_cybercash + +Attempts to pay this invoice with the CyberCash CashRegister realtime gateway. + +=cut + +sub realtime_card_cybercash { + my $self = shift; + my $cust_main = $self->cust_main; + my $amount = $self->owed; + + return "CyberCash CashRegister real-time card processing not enabled!" + unless $cybercash eq 'cybercash3.2'; + + my $address = $cust_main->address1; + $address .= ", ". $cust_main->address2 if $cust_main->address2; + + #fix exp. date + #$cust_main->paydate =~ /^(\d+)\/\d*(\d{2})$/; + $cust_main->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + my $exp = "$2/$1"; + + # + + my $paybatch = $self->invnum. + '-' . time2str("%y%m%d%H%M%S", time); + + my $payname = $cust_main->payname || + $cust_main->getfield('first').' '.$cust_main->getfield('last'); + + my $country = $cust_main->country eq 'US' ? 'USA' : $cust_main->country; + + my @full_xaction = ( $xaction, + 'Order-ID' => $paybatch, + 'Amount' => "usd $amount", + 'Card-Number' => $cust_main->getfield('payinfo'), + 'Card-Name' => $payname, + 'Card-Address' => $address, + 'Card-City' => $cust_main->getfield('city'), + 'Card-State' => $cust_main->getfield('state'), + 'Card-Zip' => $cust_main->getfield('zip'), + 'Card-Country' => $country, + 'Card-Exp' => $exp, ); + my %result; + %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction); + + if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3 + my $cust_pay = new FS::cust_pay ( { + 'invnum' => $self->invnum, + 'paid' => $amount, + '_date' => '', + 'payby' => 'CARD', + 'payinfo' => $cust_main->payinfo, + 'paybatch' => "$cybercash:$paybatch", + } ); + my $error = $cust_pay->insert; + if ( $error ) { + # gah, even with transactions. + my $e = 'WARNING: Card debited but database not updated - '. + 'error applying payment, invnum #' . $self->invnum. + " (CyberCash Order-ID $paybatch): $error"; + warn $e; + return $e; + } else { + return ''; + } +# } elsif ( $result{'Mstatus'} ne 'failure-bad-money' +# || $options{'report_badcard'} +# ) { + } else { + return 'Cybercash error, invnum #' . + $self->invnum. ':'. $result{'MErrMsg'}; + } + } =item batch_card @@ -729,8 +1128,6 @@ sub print_text { map { [ " ". $_->[0]. ": ". $_->[1], '' ] } $cust_pkg->labels; } - push @buf, map { [ " $_", '' ] } $cust_bill_pkg->details; - } else { #pkgnum tax or one-shot line item my $itemdesc = defined $cust_bill_pkg->dbdef_table->column('itemdesc') ? ( $cust_bill_pkg->itemdesc || 'Tax' ) diff --git a/FS/FS/cust_bill_event.pm b/FS/FS/cust_bill_event.pm index ddd676281..c97734780 100644 --- a/FS/FS/cust_bill_event.pm +++ b/FS/FS/cust_bill_event.pm @@ -122,7 +122,7 @@ sub check { return "Unknown eventpart ". $self->eventpart unless qsearchs( 'part_bill_event' ,{ 'eventpart' => $self->eventpart } ); - $self->SUPER::check; + ''; #no error } =item part_bill_event diff --git a/FS/FS/cust_bill_pay.pm b/FS/FS/cust_bill_pay.pm index c8b5525ea..ea0236deb 100644 --- a/FS/FS/cust_bill_pay.pm +++ b/FS/FS/cust_bill_pay.pm @@ -181,7 +181,7 @@ sub check { $self->_date(time) unless $self->_date; - $self->SUPER::check; + ''; #no error } =item cust_pay diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm index 6800707fe..72f9ce4a9 100644 --- a/FS/FS/cust_bill_pkg.pm +++ b/FS/FS/cust_bill_pkg.pm @@ -2,12 +2,11 @@ package FS::cust_bill_pkg; use strict; use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs dbdef dbh ); +use FS::Record qw( qsearchs ); use FS::cust_pkg; use FS::cust_bill; -use FS::cust_bill_pkg_detail; -@ISA = qw( FS::Record ); +@ISA = qw(FS::Record ); =head1 NAME @@ -48,8 +47,6 @@ supported: =item edate - ending date of recurring fee -=item itemdesc - Line item description (currentlty used only when pkgnum is 0) - =back sdate and edate are specified as UNIX timestamps; see L<perlfunc/"time">. Also @@ -74,51 +71,6 @@ sub table { 'cust_bill_pkg'; } Adds this line item to the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub insert { - my $self = shift; - - 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; - - my $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - unless ( defined dbdef->table('cust_bill_pkg_detail') && $self->get('details') ) { - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - return ''; - } - - foreach my $detail ( @{$self->get('details')} ) { - my $cust_bill_pkg_detail = new FS::cust_bill_pkg_detail { - 'pkgnum' => $self->pkgnum, - 'invnum' => $self->invnum, - 'detail' => $detail, - }; - $error = $cust_bill_pkg_detail->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; - -} - =item delete Currently unimplemented. I don't remove line items because there would then be @@ -159,7 +111,6 @@ sub check { || $self->ut_money('recur') || $self->ut_numbern('sdate') || $self->ut_numbern('edate') - || $self->ut_textn('itemdesc') ; return $error if $error; @@ -171,7 +122,7 @@ sub check { return "Unknown invnum" unless qsearchs( 'cust_bill' ,{ 'invnum' => $self->invnum } ); - $self->SUPER::check; + ''; #no error } =item cust_pkg @@ -185,22 +136,11 @@ sub cust_pkg { qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); } -=item details - -Returns an array of detail information for the invoice line item. - -=cut +=back -sub details { - my $self = shift; - return () unless defined dbdef->table('cust_bill_pkg_detail'); - map { $_->detail } - qsearch ( 'cust_bill_pkg_detail', { 'pkgnum' => $self->pkgnum, - 'invnum' => $self->invnum, } ); - #qsearch ( 'cust_bill_pkg_detail', { 'lineitemnum' => $self->lineitemnum }); -} +=head1 VERSION -=back +$Id: cust_bill_pkg.pm,v 1.3 2002-04-06 22:32:43 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_bill_pkg_detail.pm b/FS/FS/cust_bill_pkg_detail.pm deleted file mode 100644 index 261aa80ea..000000000 --- a/FS/FS/cust_bill_pkg_detail.pm +++ /dev/null @@ -1,124 +0,0 @@ -package FS::cust_bill_pkg_detail; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); - -@ISA = qw(FS::Record); - -=head1 NAME - -FS::cust_bill_pkg_detail - Object methods for cust_bill_pkg_detail records - -=head1 SYNOPSIS - - use FS::cust_bill_pkg_detail; - - $record = new FS::cust_bill_pkg_detail \%hash; - $record = new FS::cust_bill_pkg_detail { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::cust_bill_pkg_detail object represents additional detail information for -an invoice line item (see L<FS::cust_bill_pkg>). FS::cust_bill_pkg_detail -inherits from FS::Record. The following fields are currently supported: - -=over 4 - -=item detailnum - primary key - -=item pkgnum - - -=item invnum - - -=item detail - detail description - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new line item detail. To add the line item detail to the database, -see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -# the new method can be inherited from FS::Record, if a table method is defined - -sub table { 'cust_bill_pkg_detail'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -# the insert method can be inherited from FS::Record - -=item delete - -Delete this record from the database. - -=cut - -# the delete method can be inherited from FS::Record - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -# the replace method can be inherited from FS::Record - -=item check - -Checks all fields to make sure this is a valid line item detail. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -# the check method should currently be supplied - FS::Record contains some -# data checking routines - -sub check { - my $self = shift; - - $self->ut_numbern('detailnum') - || $self->ut_foreign_key('pkgnum', 'cust_pkg', 'pkgnum') - || $self->ut_foreign_key('invnum', 'cust_pkg', 'invnum') - || $self->ut_text('detail') - || $self->SUPER::check - ; - -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::cust_bill_pkg>, L<FS::Record>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index 8ec255b95..8f783d9a5 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -236,7 +236,7 @@ sub check { $self->otaker(getotaker); - $self->SUPER::check; + ''; #no error } =item cust_refund @@ -300,18 +300,6 @@ sub credited { sprintf( "%.2f", $amount ); } -=item cust_main - -Returns the customer (see L<FS::cust_main>) for this credit. - -=cut - -sub cust_main { - my $self = shift; - qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); -} - - =back =head1 BUGS diff --git a/FS/FS/cust_credit_bill.pm b/FS/FS/cust_credit_bill.pm index bd76c2e1a..449f01149 100644 --- a/FS/FS/cust_credit_bill.pm +++ b/FS/FS/cust_credit_bill.pm @@ -150,7 +150,7 @@ sub check { return "Cannot apply more than remaining value of invoice" unless $self->amount <= $cust_bill->owed; - $self->SUPER::check; + ''; #no error } =item sub cust_credit diff --git a/FS/FS/cust_credit_refund.pm b/FS/FS/cust_credit_refund.pm index d0deae2f3..cc3b32cdb 100644 --- a/FS/FS/cust_credit_refund.pm +++ b/FS/FS/cust_credit_refund.pm @@ -156,7 +156,7 @@ sub check { return "unknown cust_credit.crednum: ". $self->crednum unless qsearchs( 'cust_credit', { 'crednum' => $self->crednum } ); - $self->SUPER::check; + ''; #no error } =item cust_refund @@ -185,7 +185,7 @@ sub cust_credit { =head1 VERSION -$Id: cust_credit_refund.pm,v 1.10 2003-08-05 00:20:41 khoff Exp $ +$Id: cust_credit_refund.pm,v 1.9 2002-01-26 01:52:31 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 2f01111ef..47fd082dc 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -2,7 +2,6 @@ package FS::cust_main; use strict; use vars qw( @ISA $conf $DEBUG $import ); -use vars qw( $realtime_bop_decline_quiet ); #ugh use Safe; use Carp; BEGIN { @@ -16,7 +15,6 @@ use Date::Format; use Business::CreditCard; use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearchs qsearch dbdef ); -use FS::Misc qw( send_email ); use FS::cust_pkg; use FS::cust_bill; use FS::cust_bill_pkg; @@ -40,16 +38,13 @@ use FS::Msgcat qw(gettext); @ISA = qw( FS::Record ); -$realtime_bop_decline_quiet = 0; - $DEBUG = 0; #$DEBUG = 1; $import = 0; #ask FS::UID to run this stuff for us later -#$FS::UID::callback{'FS::cust_main'} = sub { -install_callback FS::UID sub { +$FS::UID::callback{'FS::cust_main'} = sub { $conf = new FS::Conf; #yes, need it for stuff below (prolly should be cached) }; @@ -169,12 +164,10 @@ FS::Record. The following fields are currently supported: =item ship_fax - phone (optional) -=item payby - I<CARD> (credit card - automatic), I<DCRD> (credit card - on-demand), I<CHEK> (electronic check - automatic), I<DCHK> (electronic check - on-demand), I<LECB> (Phone bill billing), I<BILL> (billing), I<COMP> (free), or I<PREPAY> (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to I<BILL>) +=item payby - `CARD' (credit cards), `CHEK' (electronic check), `LECB' (Phone bill billing), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL) =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>) -=item paycvv - Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card - =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy =item payname - name on card or billing name @@ -185,8 +178,6 @@ FS::Record. The following fields are currently supported: =item comments - comments (optional) -=item referral_custnum - referring customer number - =back =head1 METHODS @@ -807,11 +798,11 @@ sub check { } } - $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/ + $self->payby =~ /^(CARD|CHEK|LECB|BILL|COMP|PREPAY)$/ or return "Illegal payby: ". $self->payby; $self->payby($1); - if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) { + if ( $self->payby eq 'CARD' ) { my $payinfo = $self->payinfo; $payinfo =~ s/\D//g; @@ -839,7 +830,7 @@ sub check { } } - } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) { + } elsif ( $self->payby eq 'CHEK' ) { my $payinfo = $self->payinfo; $payinfo =~ s/[^\d\@]//g; @@ -892,24 +883,17 @@ sub check { unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/; $self->paydate(''); } else { - my( $m, $y ); - if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) { - ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" ); - } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) { - ( $m, $y ) = ( $3, "20$2" ); - } else { - return "Illegal expiration date: ". $self->paydate; - } - $self->paydate("$y-$m-01"); + $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ + or return "Illegal expiration date: ". $self->paydate; + my $y = length($2) == 4 ? $2 : "20$2"; + $self->paydate("$y-$1-01"); my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900; return gettext('expired_card') if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) ); } - if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ && - ( ! $conf->exists('require_cardname') - || $self->payby !~ /^(CARD|DCRD)$/ ) - ) { + if ( $self->payname eq '' && $self->payby ne 'CHEK' && + ( ! $conf->exists('require_cardname') || $self->payby ne 'CARD' ) ) { $self->payname( $self->first. " ". $self->getfield('last') ); } else { $self->payname =~ /^([\w \,\.\-\']+)$/ @@ -924,7 +908,7 @@ sub check { #warn "AFTER: \n". $self->_dump; - $self->SUPER::check; + ''; #no error } =item all_pkgs @@ -1130,8 +1114,6 @@ sub bill { my %hash = $cust_pkg->hash; my $old_cust_pkg = new FS::cust_pkg \%hash; - my @details = (); - # bill setup my $setup = 0; if ( !$cust_pkg->setup || $options{'resetup'} ) { @@ -1239,12 +1221,11 @@ sub bill { } if ( $setup != 0 || $recur != 0 ) { my $cust_bill_pkg = new FS::cust_bill_pkg ({ - 'pkgnum' => $cust_pkg->pkgnum, - 'setup' => $setup, - 'recur' => $recur, - 'sdate' => $sdate, - 'edate' => $cust_pkg->bill, - 'details' => \@details, + 'pkgnum' => $cust_pkg->pkgnum, + 'setup' => $setup, + 'recur' => $recur, + 'sdate' => $sdate, + 'edate' => $cust_pkg->bill, }); push @cust_bill_pkg, $cust_bill_pkg; $total_setup += $setup; @@ -1285,7 +1266,7 @@ sub bill { join('/', ( map $self->$_(), qw(state county country) ), $part_pkg->taxclass ). "\n"; } - + foreach my $tax ( @taxes ) { my $taxable_charged = 0; @@ -1452,9 +1433,8 @@ sub bill { (Attempt to) collect money for this customer's outstanding invoices (see L<FS::cust_bill>). Usually used after the bill method. -Depending on the value of `payby', this may print or email an invoice (I<BILL>, -I<DCRD>, or I<DCHK>), charge a credit card (I<CARD>), charge via electronic -check/ACH (I<CHEK>), or just add any necessary (pseudo-)payment (I<COMP>). +Depending on the value of `payby', this may print an invoice (`BILL'), charge +a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP'). Most actions are now triggered by invoice events; see L<FS::part_bill_event> and the invoice events web interface. @@ -1556,7 +1536,10 @@ sub collect { my $error; { - local $realtime_bop_decline_quiet = 1 if $options{'quiet'}; + #supress "used only once" warning + $FS::cust_bill::realtime_bop_decline_quiet += 0; + local $FS::cust_bill::realtime_bop_decline_quiet = 1 + if $options{'quiet'}; $error = eval $part_bill_event->eventcode; } @@ -1660,276 +1643,6 @@ sub retry_realtime { } -=item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ] - -Runs a realtime credit card, ACH (electronic check) or phone bill transaction -via a Business::OnlinePayment realtime gateway. See -L<http://420.am/business-onlinepayment> for supported gateways. - -Available methods are: I<CC>, I<ECHECK> and I<LEC> - -Available options are: I<description>, I<invnum>, I<quiet> - -The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>, -I<zip>, I<payinfo> and I<paydate> are also available. Any of these options, -if set, will override the value from the customer record. - -I<description> is a free-text field passed to the gateway. It defaults to -"Internet services". - -If an I<invnum> is specified, this payment (if sucessful) is applied to the -specified invoice. If you don't specify an I<invnum> you might want to -call the B<apply_payments> method. - -I<quiet> can be set true to surpress email decline notices. - -(moved from cust_bill) (probably should get realtime_{card,ach,lec} here too) - -=cut - -sub realtime_bop { - my( $self, $method, $amount, %options ) = @_; - if ( $DEBUG ) { - warn "$self $method $amount\n"; - warn " $_ => $options{$_}\n" foreach keys %options; - } - - $options{'description'} ||= 'Internet services'; - - #pre-requisites - die "Real-time processing not enabled\n" - unless $conf->exists('business-onlinepayment'); - eval "use Business::OnlinePayment"; - die $@ if $@; - - #overrides - $self->set( $_ => $options{$_} ) - foreach grep { exists($options{$_}) } - qw( payname address1 address2 city state zip payinfo paydate paycvv); - - #load up config - my $bop_config = 'business-onlinepayment'; - $bop_config .= '-ach' - if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach'); - my ( $processor, $login, $password, $action, @bop_options ) = - $conf->config($bop_config); - $action ||= 'normal authorization'; - pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/; - die "No real-time processor is enabled - ". - "did you set the business-onlinepayment configuration value?\n" - unless $processor; - - #massage data - - my $address = $self->address1; - $address .= ", ". $self->address2 if $self->address2; - - my($payname, $payfirst, $paylast); - if ( $self->payname && $method ne 'ECHECK' ) { - $payname = $self->payname; - $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ - or return "Illegal payname $payname"; - ($payfirst, $paylast) = ($1, $2); - } else { - $payfirst = $self->getfield('first'); - $paylast = $self->getfield('last'); - $payname = "$payfirst $paylast"; - } - - my @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list; - if ( $conf->exists('emailinvoiceauto') - || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { - push @invoicing_list, $self->all_emails; - } - my $email = $invoicing_list[0]; - - my %content; - if ( $method eq 'CC' ) { - - $content{card_number} = $self->payinfo; - $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; - $content{expiration} = "$2/$1"; - - $content{cvv2} = $self->paycvv - if defined $self->dbdef_table->column('paycvv') - && length($self->paycvv); - - $content{recurring_billing} = 'YES' - if qsearch('cust_pay', { 'custnum' => $self->custnum, - 'payby' => 'CARD', - 'payinfo' => $self->payinfo, } ); - - } elsif ( $method eq 'ECHECK' ) { - my($account_number,$routing_code) = $self->payinfo; - ( $content{account_number}, $content{routing_code} ) = - split('@', $self->payinfo); - $content{bank_name} = $self->payname; - $content{account_type} = 'CHECKING'; - $content{account_name} = $payname; - $content{customer_org} = $self->company ? 'B' : 'I'; - $content{customer_ssn} = $self->ss; - } elsif ( $method eq 'LEC' ) { - $content{phone} = $self->payinfo; - } - - #transaction(s) - - my( $action1, $action2 ) = split(/\s*\,\s*/, $action ); - - my $transaction = - new Business::OnlinePayment( $processor, @bop_options ); - $transaction->content( - 'type' => $method, - 'login' => $login, - 'password' => $password, - 'action' => $action1, - 'description' => $options{'description'}, - 'amount' => $amount, - 'invoice_number' => $options{'invnum'}, - 'customer_id' => $self->custnum, - 'last_name' => $paylast, - 'first_name' => $payfirst, - 'name' => $payname, - 'address' => $address, - 'city' => $self->city, - 'state' => $self->state, - 'zip' => $self->zip, - 'country' => $self->country, - 'referer' => 'http://cleanwhisker.420.am/', - 'email' => $email, - 'phone' => $self->daytime || $self->night, - %content, #after - ); - $transaction->submit(); - - if ( $transaction->is_success() && $action2 ) { - my $auth = $transaction->authorization; - my $ordernum = $transaction->can('order_number') - ? $transaction->order_number - : ''; - - my $capture = - new Business::OnlinePayment( $processor, @bop_options ); - - my %capture = ( - %content, - type => $method, - action => $action2, - login => $login, - password => $password, - order_number => $ordernum, - amount => $amount, - authorization => $auth, - description => $options{'description'}, - ); - - foreach my $field (qw( authorization_source_code returned_ACI transaction_identifier validation_code - transaction_sequence_num local_transaction_date - local_transaction_time AVS_result_code )) { - $capture{$field} = $transaction->$field() if $transaction->can($field); - } - - $capture->content( %capture ); - - $capture->submit(); - - unless ( $capture->is_success ) { - my $e = "Authorization sucessful but capture failed, custnum #". - $self->custnum. ': '. $capture->result_code. - ": ". $capture->error_message; - warn $e; - return $e; - } - - } - - #remove paycvv after initial transaction - #false laziness w/misc/process/payment.cgi - check both to make sure working - # correctly - if ( defined $self->dbdef_table->column('paycvv') - && length($self->paycvv) - && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save') - && ! length($options{'paycvv'}) - ) { - my $new = new FS::cust_main { $self->hash }; - $new->paycvv(''); - my $error = $new->replace($self); - if ( $error ) { - warn "error removing cvv: $error\n"; - } - } - - #result handling - if ( $transaction->is_success() ) { - - my %method2payby = ( - 'CC' => 'CARD', - 'ECHECK' => 'CHEK', - 'LEC' => 'LECB', - ); - - my $cust_pay = new FS::cust_pay ( { - 'custnum' => $self->custnum, - 'invnum' => $options{'invnum'}, - 'paid' => $amount, - '_date' => '', - 'payby' => $method2payby{$method}, - 'payinfo' => $self->payinfo, - 'paybatch' => "$processor:". $transaction->authorization, - } ); - my $error = $cust_pay->insert; - if ( $error ) { - $cust_pay->invnum(''); #try again with no specific invnum - my $error2 = $cust_pay->insert; - if ( $error2 ) { - # gah, even with transactions. - my $e = 'WARNING: Card/ACH debited but database not updated - '. - "error inserting payment ($processor): $error2". - " (previously tried insert with invnum #$options{'invnum'}" . - ": $error )"; - warn $e; - return $e; - } - } - return ''; #no error - - } else { - - my $perror = "$processor error: ". $transaction->error_message; - - if ( !$options{'quiet'} && !$realtime_bop_decline_quiet - && $conf->exists('emaildecline') - && grep { $_ ne 'POST' } $self->invoicing_list - && ! grep { $transaction->error_message =~ /$_/ } - $conf->config('emaildecline-exclude') - ) { - my @templ = $conf->config('declinetemplate'); - my $template = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", @templ ], - ) or return "($perror) can't create template: $Text::Template::ERROR"; - $template->compile() - or return "($perror) can't compile template: $Text::Template::ERROR"; - - my $templ_hash = { error => $transaction->error_message }; - - my $error = send_email( - 'from' => $conf->config('invoice_from'), - 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ], - 'subject' => 'Your payment could not be processed', - 'body' => [ $template->fill_in(HASH => $templ_hash) ], - ); - - $perror .= " (also received error sending decline notification: $error)" - if $error; - - } - - return $perror; - } - -} - =item total_owed Returns the total owed for this customer on all invoices @@ -2133,37 +1846,6 @@ sub balance_date { ); } -=item paydate_monthyear - -Returns a two-element list consisting of the month and year of this customer's -paydate (credit card expiration date for CARD customers) - -=cut - -sub paydate_monthyear { - my $self = shift; - if ( $self->paydate =~ /^(\d{4})-(\d{2})-\d{2}$/ ) { #Pg date format - ( $2, $1 ); - } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) { - ( $1, $3 ); - } else { - ('', ''); - } -} - -=item payinfo_masked - -Returns a "masked" payinfo field with all but the last four characters replaced -by 'x'es. Useful for displaying credit cards. - -=cut - -sub payinfo_masked { - my $self = shift; - my $payinfo = $self->payinfo; - 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4)); -} - =item invoicing_list [ ARRAYREF ] If an arguement is given, sets these email addresses as invoice recipients @@ -2857,8 +2539,6 @@ card types. No multiple currency support (probably a larger project than just this module). -payinfo_masked false laziness with cust_pay.pm and cust_refund.pm - =head1 SEE ALSO L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit> diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm index ef2793ad1..e50e510a9 100644 --- a/FS/FS/cust_main_county.pm +++ b/FS/FS/cust_main_county.pm @@ -61,8 +61,6 @@ currently supported: =item exempt_amount -=item taxname - if defined, printed on invoices instead of "Tax" - =item setuptax - if 'Y', this tax does not apply to setup fees =item recurtax - if 'Y', this tax does not apply to recurring fees @@ -119,8 +117,7 @@ sub check { || $self->ut_textn('taxname') || $self->ut_enum('setuptax', [ '', 'Y' ] ) || $self->ut_enum('recurtax', [ '', 'Y' ] ) - || $self->SUPER::check - ; + ; } diff --git a/FS/FS/cust_main_invoice.pm b/FS/FS/cust_main_invoice.pm index add0ccab1..a5533a088 100644 --- a/FS/FS/cust_main_invoice.pm +++ b/FS/FS/cust_main_invoice.pm @@ -107,7 +107,7 @@ sub check { return "Unknown customer" unless qsearchs('cust_main',{ 'custnum' => $self->custnum }); - $self->SUPER::check; + ''; #noerror } =item checkdest @@ -134,6 +134,13 @@ sub checkdest { unless qsearchs( 'svc_acct', { 'svcnum' => $self->dest } ); } elsif ( $self->dest =~ /^([\w\.\-\&\+]+)\@(([\w\.\-]+\.)+\w+)$/ ) { my($user, $domain) = ($1, $2); +# if ( $domain eq $mydomain ) { +# my $svc_acct = qsearchs( 'svc_acct', { 'username' => $user } ); +# return "Unknown local account: $user\@$domain (specified literally)" +# unless $svc_acct; +# $svc_acct->svcnum =~ /^(\d+)$/ or die "Non-numeric svcnum?!"; +# $self->dest($1); +# } $self->dest("$1\@$2"); } else { return gettext("illegal_email_invoice_address"); @@ -163,7 +170,7 @@ sub address { =head1 VERSION -$Id: cust_main_invoice.pm,v 1.14 2003-08-05 00:20:42 khoff Exp $ +$Id: cust_main_invoice.pm,v 1.12 2002-04-12 13:22:02 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index ba9924f99..1afd22a43 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -1,12 +1,13 @@ package FS::cust_pay; use strict; -use vars qw( @ISA $conf $unsuspendauto ); +use vars qw( @ISA $conf $unsuspendauto $smtpmachine $invoice_from ); use Date::Format; +use Mail::Header; +use Mail::Internet 1.44; use Business::CreditCard; use FS::UID qw( dbh ); use FS::Record qw( dbh qsearch qsearchs dbh ); -use FS::Misc qw(send_email); use FS::cust_bill; use FS::cust_bill_pay; use FS::cust_main; @@ -14,10 +15,14 @@ use FS::cust_main; @ISA = qw( FS::Record ); #ask FS::UID to run this stuff for us later -FS::UID->install_callback( sub { +$FS::UID::callback{'FS::cust_pay'} = sub { + $conf = new FS::Conf; $unsuspendauto = $conf->exists('unsuspendauto'); -} ); + $smtpmachine = $conf->config('smtpmachine'); + $invoice_from = $conf->config('invoice_from'); + +}; =head1 NAME @@ -260,12 +265,19 @@ sub delete { if ( $conf->config('deletepayments') ne '' ) { my $cust_main = qsearchs('cust_main',{ 'custnum' => $self->custnum }); - - my $error = send_email( - 'from' => $conf->config('invoice_from'), #??? well as good as any - 'to' => $conf->config('deletepayments'), - 'subject' => 'FREESIDE NOTIFICATION: Payment deleted', - 'body' => [ + #false laziness w/FS::cust_bill::send & fs_signup_server + $ENV{MAILADDRESS} = $invoice_from; #??? well as good as any + my $header = new Mail::Header ( [ + "From: $invoice_from", + "To: ". $conf->config('deletepayments'), + "Sender: $invoice_from", + "Reply-To: $invoice_from", + "Date: ". time2str("%a, %d %b %Y %X %z", time), + "Subject: FREESIDE NOTIFICATION: Payment deleted", + ] ); + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => [ "This is an automatic message from your Freeside installation\n", "informing you that the following payment has been deleted:\n", "\n", @@ -279,12 +291,16 @@ sub delete { 'paybatch: '. $self->paybatch. "\n", ], ); - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't send payment deletion notification: $error"; - } - + $!=0; + $message->smtpsend( Host => $smtpmachine ) + or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) + or do { + $dbh->rollback if $oldAutoCommit; + return "(customer # ". $self->custnum. + ") can't send payment deletion email to ". + $conf->config('deletepayments'). + " via server $smtpmachine with SMTP: $!"; + }; } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -354,7 +370,8 @@ sub check { return $error if $error; } - $self->SUPER::check; + ''; #no error + } =item cust_bill_pay @@ -396,25 +413,16 @@ sub cust_main { qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); } -=item payinfo_masked -Returns a "masked" payinfo field with all but the last four characters replaced -by 'x'es. Useful for displaying credit cards. +=back -=cut +=head1 VERSION -sub payinfo_masked { - my $self = shift; - my $payinfo = $self->payinfo; - 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4)); -} - -=back +$Id: cust_pay.pm,v 1.21.4.3 2003-09-10 10:54:47 ivan Exp $ =head1 BUGS -Delete and replace methods. payinfo_masked false laziness with cust_main.pm -and cust_refund.pm +Delete and replace methods. =head1 SEE ALSO diff --git a/FS/FS/cust_pay_batch.pm b/FS/FS/cust_pay_batch.pm index 8059f1ca2..b58e772ce 100644 --- a/FS/FS/cust_pay_batch.pm +++ b/FS/FS/cust_pay_batch.pm @@ -185,7 +185,7 @@ sub check { #check invnum, custnum, ? - $self->SUPER::check; + ''; #no error } =item cust_main diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index db0f7d423..a62c44e00 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,10 +1,9 @@ package FS::cust_pkg; use strict; -use vars qw(@ISA $disable_agentcheck @SVCDB_CANCEL_SEQ $DEBUG); +use vars qw(@ISA $disable_agentcheck $DEBUG); use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearch qsearchs ); -use FS::Misc qw( send_email ); use FS::cust_svc; use FS::part_pkg; use FS::cust_main; @@ -16,12 +15,17 @@ use FS::cust_bill_pkg; # setup } # because they load configuraion by setting FS::UID::callback (see TODO) use FS::svc_acct; +use FS::svc_acct_sm; use FS::svc_domain; use FS::svc_www; use FS::svc_forward; -# for sending cancel emails in sub cancel +# need all this for sending cancel emails in sub cancel + use FS::Conf; +use Date::Format; +use Mail::Internet 1.44; +use Mail::Header; @ISA = qw( FS::Record ); @@ -29,14 +33,6 @@ $DEBUG = 0; $disable_agentcheck = 0; -# The order in which to unprovision services. -@SVCDB_CANCEL_SEQ = qw( svc_external - svc_www - svc_forward - svc_acct - svc_domain - svc_broadband ); - sub _cache { my $self = shift; my ( $hashref, $cache ) = @_; @@ -109,8 +105,6 @@ inherits from FS::Record. The following fields are currently supported: =item bill - date (next bill date) -=item last_bill - last bill date - =item susp - date =item expire - date @@ -260,7 +254,7 @@ sub check { $self->manual_flag($1); } - $self->SUPER::check; + ''; #no error } =item cancel [ OPTION => VALUE ... ] @@ -292,22 +286,16 @@ sub cancel { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my %svc; foreach my $cust_svc ( - qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) + qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ) { - push @{ $svc{$cust_svc->part_svc->svcdb} }, $cust_svc; - } - - foreach my $svcdb (@SVCDB_CANCEL_SEQ) { - foreach my $cust_svc (@{ $svc{$svcdb} }) { - my $error = $cust_svc->cancel; + my $error = $cust_svc->cancel; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error cancelling cust_svc: $error"; - } + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error cancelling cust_svc: $error"; } + } unless ( $self->getfield('cancel') ) { @@ -324,16 +312,38 @@ sub cancel { $dbh->commit or die $dbh->errstr if $oldAutoCommit; my $conf = new FS::Conf; - my @invoicing_list = grep { $_ ne 'POST' } $self->cust_main->invoicing_list; - if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) { - my $conf = new FS::Conf; - my $error = send_email( - 'from' => $conf->config('invoice_from'), - 'to' => \@invoicing_list, - 'subject' => $conf->config('cancelsubject'), - 'body' => [ map "$_\n", $conf->config('cancelmessage') ], - ); - #should this do something on errors? + + if ( !$options{'quiet'} && $conf->exists('emailcancel') + && grep { $_ ne 'POST' } $self->cust_main->invoicing_list) { + + my @invoicing_list = $self->cust_main->invoicing_list; + + my $invoice_from = $conf->config('invoice_from'); + my @print_text = map "$_\n", $conf->config('cancelmessage'); + my $subject = $conf->config('cancelsubject'); + my $smtpmachine = $conf->config('smtpmachine'); + + if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice + #false laziness w/FS::cust_pay::delete & fs_signup_server && ::realtime_card + #$ENV{SMTPHOSTS} = $smtpmachine; + $ENV{MAILADDRESS} = $invoice_from; + my $header = new Mail::Header ( [ + "From: $invoice_from", + "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ), + "Sender: $invoice_from", + "Reply-To: $invoice_from", + "Date: ". time2str("%a, %d %b %Y %X %z", time), + "Subject: $subject", + ] ); + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => [ @print_text ], + ); + $!=0; + $message->smtpsend( Host => $smtpmachine ) + or $message->smtpsend( Host => $smtpmachine, Debug => 1 ); + #should this return an error? + } } ''; #no errors @@ -476,7 +486,7 @@ Useful for billing metered services. sub last_bill { my $self = shift; if ( $self->dbdef_table->column('last_bill') ) { - return $self->setfield('last_bill', $_[0]) if @_; + return $self->setfield('last_bill', $_[1]) if @_; return $self->getfield('last_bill') if $self->getfield('last_bill'); } my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum, @@ -508,21 +518,11 @@ L<FS::cust_svc>) sub cust_svc { my $self = shift; - #if ( $self->{'_svcnum'} ) { - # values %{ $self->{'_svcnum'}->cache }; - #} else { - map { $_->[0] } - sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] } - map { - my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart, - 'svcpart' => $_->svcpart } ); - [ $_, - $pkg_svc ? $pkg_svc->primary_svc : '', - $pkg_svc ? $pkg_svc->quantity : 0, - ]; - } + if ( $self->{'_svcnum'} ) { + values %{ $self->{'_svcnum'}->cache }; + } else { qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } ); - #} + } } =item labels @@ -608,8 +608,7 @@ sub seconds_since_sqlradacct { Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>) in this package for sessions ending between TIMESTAMP_START (inclusive) and -TIMESTAMP_END -(exclusive). +TIMESTAMP_END (exclusive). TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion @@ -636,123 +635,6 @@ sub attribute_since_sqlradacct { } -=item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ] - -Transfers as many services as possible from this package to another package. - -The destination package can be specified by pkgnum by passing an FS::cust_pkg -object. The destination package must already exist. - -Services are moved only if the destination allows services with the correct -I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use -this option with caution! No provision is made for export differences -between the old and new service definitions. Probably only should be used -when your exports for all service definitions of a given svcdb are identical. -(attempt a transfer without it first, to move all possible svcpart-matching -services) - -Any services that can't be moved remain in the original package. - -Returns an error, if there is one; otherwise, returns the number of services -that couldn't be moved. - -=cut - -sub transfer { - my ($self, $dest_pkgnum, %opt) = @_; - - my $remaining = 0; - my $dest; - my %target; - - if (ref ($dest_pkgnum) eq 'FS::cust_pkg') { - $dest = $dest_pkgnum; - $dest_pkgnum = $dest->pkgnum; - } else { - $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum }); - } - - return ('Package does not exist: '.$dest_pkgnum) unless $dest; - - foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) { - $target{$pkg_svc->svcpart} = $pkg_svc->quantity; - } - - foreach my $cust_svc ($dest->cust_svc) { - $target{$cust_svc->svcpart}--; - } - - my %svcpart2svcparts = (); - if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) { - warn "change_svcpart option received, creating alternates list\n" if $DEBUG; - foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) { - next if exists $svcpart2svcparts{$svcpart}; - my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } ); - $svcpart2svcparts{$svcpart} = [ - map { $_->[0] } - sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] } - map { - my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart, - 'svcpart' => $_ } ); - [ $_, - $pkg_svc ? $pkg_svc->primary_svc : '', - $pkg_svc ? $pkg_svc->quantity : 0, - ]; - } - - grep { $_ != $svcpart } - map { $_->svcpart } - qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } ) - ]; - warn "alternates for svcpart $svcpart: ". - join(', ', @{$svcpart2svcparts{$svcpart}}). "\n" - if $DEBUG; - } - } - - foreach my $cust_svc ($self->cust_svc) { - if($target{$cust_svc->svcpart} > 0) { - $target{$cust_svc->svcpart}--; - my $new = new FS::cust_svc { - svcnum => $cust_svc->svcnum, - svcpart => $cust_svc->svcpart, - pkgnum => $dest_pkgnum, - }; - my $error = $new->replace($cust_svc); - return $error if $error; - } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) { - if ( $DEBUG ) { - warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n"; - warn "alternates to consider: ". - join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n"; - } - my @alternate = grep { - warn "considering alternate svcpart $_: ". - "$target{$_} available in new package\n" - if $DEBUG; - $target{$_} > 0; - } @{$svcpart2svcparts{$cust_svc->svcpart}}; - if ( @alternate ) { - warn "alternate(s) found\n" if $DEBUG; - my $change_svcpart = $alternate[0]; - $target{$change_svcpart}--; - my $new = new FS::cust_svc { - svcnum => $cust_svc->svcnum, - svcpart => $change_svcpart, - pkgnum => $dest_pkgnum, - }; - my $error = $new->replace($cust_svc); - return $error if $error; - } else { - $remaining++; - } - } else { - $remaining++ - } - } - return $remaining; -} - =item reexport This method is deprecated. See the I<depend_jobnum> option to the insert and @@ -817,81 +699,186 @@ newly-created cust_pkg objects. =cut sub order { - my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg) = @_; - - my $conf = new FS::Conf; - - # Transactionize this whole mess - 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($custnum, $pkgparts, $remove_pkgnums, $return_cust_pkg) = @_; + $remove_pkgnums = [] unless defined($remove_pkgnums); my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error; - my $cust_main = qsearchs('cust_main', { custnum => $custnum }); - return "Customer not found: $custnum" unless $cust_main; - - # Create the new packages. - my $cust_pkg; - foreach (@$pkgparts) { - $cust_pkg = new FS::cust_pkg { custnum => $custnum, - pkgpart => $_ }; - $error = $cust_pkg->insert; - if ($error) { + # generate %part_pkg + # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart + # + my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum}); + my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum }); + my %part_pkg = %{ $agent->pkgpart_hashref }; + + my(%svcnum); + # generate %svcnum + # for those packages being removed: + #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::cust_svc objects + my($pkgnum); + foreach $pkgnum ( @{$remove_pkgnums} ) { + foreach my $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) { + push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc; + } + } + if ( $DEBUG ) { + foreach my $svcpart ( keys %svcnum ) { + warn "initial svcpart $svcpart: existing svcnums ". + join(', ', map { $_->svcnum } @{$svcnum{$svcpart}} ). "\n"; + } + } + + my @cust_svc; + #generate @cust_svc + # for those packages the customer is purchasing: + # @{$pkgparts} is a list of said packages, by pkgpart + # @cust_svc is a corresponding list of lists of FS::Record objects + foreach my $pkgpart ( @{$pkgparts} ) { + unless ( $part_pkg{$pkgpart} ) { $dbh->rollback if $oldAutoCommit; - return $error; + return "Customer not permitted to purchase pkgpart $pkgpart!"; } - push @$return_cust_pkg, $cust_pkg; + push @cust_svc, [ + map { + my $svcnum = $svcnum{$_->{svcpart}}; + if ( $svcnum && @$svcnum ) { + my $num = ( $_->{quantity} < scalar(@$svcnum) ) + ? $_->{quantity} + : scalar(@$svcnum); + splice @$svcnum, 0, $num; + } else { + (); + } + } map { { 'svcpart' => $_->svcpart, + 'quantity' => $_->quantity } } + qsearch('pkg_svc', { pkgpart => $pkgpart, + quantity => { op=>'>', value=>'0', } } ) + ]; } - # $return_cust_pkg now contains refs to all of the newly - # created packages. - - # Transfer services and cancel old packages. - foreach my $old_pkgnum (@$remove_pkgnum) { - my $old_pkg = qsearchs ('cust_pkg', { pkgnum => $old_pkgnum }); - - foreach my $new_pkg (@$return_cust_pkg) { - $error = $old_pkg->transfer($new_pkg); - if ($error and $error == 0) { - # $old_pkg->transfer failed. - $dbh->rollback if $oldAutoCommit; - return $error; - } + + if ( $DEBUG ) { + foreach my $svcpart ( keys %svcnum ) { + warn "after regular move svcpart $svcpart: existing svcnums ". + join(', ', map { $_->svcnum } @{$svcnum{$svcpart}} ). "\n"; } + } - if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) { - warn "trying transfer again with change_svcpart option\n" if $DEBUG; - foreach my $new_pkg (@$return_cust_pkg) { - $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 ); - if ($error and $error == 0) { - # $old_pkg->transfer failed. - $dbh->rollback if $oldAutoCommit; - return $error; - } + #special-case until this can be handled better + # move services to new svcparts - even if the svcparts don't match (svcdb + # needs to...) + # looks like they're moved in no particular order, ewwwwwwww + # and looks like just one of each svcpart can be moved... o well + + #start with still-leftover services + #foreach my $svcpart ( grep { scalar(@{ $svcnum{$_} }) } keys %svcnum ) { + foreach my $svcpart ( keys %svcnum ) { + next unless @{ $svcnum{$svcpart} }; + + my $svcdb = $svcnum{$svcpart}->[0]->part_svc->svcdb; + + #find an empty place to put one + my $i = 0; + foreach my $pkgpart ( @{$pkgparts} ) { + my @pkg_svc = + qsearch('pkg_svc', { pkgpart => $pkgpart, + quantity => { op=>'>', value=>'0', } } ); + #my @pkg_svc = + # grep { $_->quantity > 0 } qsearch('pkg_svc', { pkgpart=>$pkgpart } ); + if ( ! @{$cust_svc[$i]} #find an empty place to put them with + && grep { $svcdb eq $_->part_svc->svcdb } #with appropriate svcdb + @pkg_svc + ) { + my $new_svcpart = + ( grep { $svcdb eq $_->part_svc->svcdb } @pkg_svc )[0]->svcpart; + my $cust_svc = shift @{$svcnum{$svcpart}}; + $cust_svc->svcpart($new_svcpart); + #warn "changing from $svcpart to $new_svcpart!!!\n"; + $cust_svc[$i] = [ $cust_svc ]; } + $i++; } - if ($error > 0) { - # Transfers were successful, but we went through all of the - # new packages and still had services left on the old package. - # We can't cancel the package under the circumstances, so abort. + } + + if ( $DEBUG ) { + foreach my $svcpart ( keys %svcnum ) { + warn "after special-case move svcpart $svcpart: existing svcnums ". + join(', ', map { $_->svcnum } @{$svcnum{$svcpart}} ). "\n"; + } + } + + + #check for leftover services + foreach (keys %svcnum) { + next unless @{ $svcnum{$_} }; + $dbh->rollback if $oldAutoCommit; + return "Leftover services, svcpart $_: svcnum ". + join(', ', map { $_->svcnum } @{ $svcnum{$_} } ); + } + + #no leftover services, let's make changes. + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + #first cancel old packages + foreach my $pkgnum ( @{$remove_pkgnums} ) { + my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum}); + unless ( $old ) { $dbh->rollback if $oldAutoCommit; - return "Unable to transfer all services from package ".$old_pkg->pkgnum; + return "Package $pkgnum not found to remove!"; } - $error = $old_pkg->cancel; - if ($error) { - $dbh->rollback; - return $error; + my(%hash) = $old->hash; + $hash{'cancel'}=time; + my($new) = new FS::cust_pkg ( \%hash ); + my($error)=$new->replace($old); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Couldn't update package $pkgnum: $error"; } } + + #now add new packages, changing cust_svc records if necessary + my $pkgpart; + while ($pkgpart=shift @{$pkgparts} ) { + + my $new = new FS::cust_pkg { + 'custnum' => $custnum, + 'pkgpart' => $pkgpart, + }; + my $error = $new->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Couldn't insert new cust_pkg record: $error"; + } + push @{$return_cust_pkg}, $new if $return_cust_pkg; + my $pkgnum = $new->pkgnum; + + foreach my $cust_svc ( @{ shift @cust_svc } ) { + my(%hash) = $cust_svc->hash; + $hash{'pkgnum'}=$pkgnum; + my $new = new FS::cust_svc ( \%hash ); + + #avoid Record diffing missing changed svcpart field from above. + my $old = qsearchs('cust_svc', { 'svcnum' => $cust_svc->svcnum } ); + + my $error = $new->replace($old); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Couldn't link old service to new package: $error"; + } + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; + + ''; #no errors } =back @@ -905,12 +892,11 @@ In sub order, the @pkgparts array (passed by reference) is clobbered. Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard method to pass dates to the recur_prog expression, it should do so. -FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are -loaded via 'use' at compile time, rather than via 'require' in sub { setup, -suspend, unsuspend, cancel } because they use %FS::UID::callback to load -configuration values. Probably need a subroutine which decides what to do -based on whether or not we've fetched the user yet, rather than a hash. See -FS::UID and the TODO. +FS::svc_acct, FS::svc_acct_sm, and FS::svc_domain are loaded via 'use' at +compile time, rather than via 'require' in sub { setup, suspend, unsuspend, +cancel } because they use %FS::UID::callback to load configuration values. +Probably need a subroutine which decides what to do based on whether or not +we've fetched the user yet, rather than a hash. See FS::UID and the TODO. Now that things are transactional should the check in the insert method be moved to check ? diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm index d60c01061..aa81003b1 100644 --- a/FS/FS/cust_refund.pm +++ b/FS/FS/cust_refund.pm @@ -260,30 +260,18 @@ sub check { $self->otaker(getotaker); - $self->SUPER::check; + ''; #no error } -=item payinfo_masked - -Returns a "masked" payinfo field with all but the last four characters replaced -by 'x'es. Useful for displaying credit cards. - -=cut - - -sub payinfo_masked { - my $self = shift; - my $payinfo = $self->payinfo; - 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4)); -} +=back +=head1 VERSION -=back +$Id: cust_refund.pm,v 1.18.4.2 2002-11-19 09:52:02 ivan Exp $ =head1 BUGS -Delete and replace methods. payinfo_masked false laziness with cust_main.pm -and cust_pay.pm +Delete and replace methods. =head1 SEE ALSO diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index b97539681..a77e44f7c 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -9,9 +9,9 @@ use FS::part_pkg; use FS::part_svc; use FS::pkg_svc; use FS::svc_acct; +use FS::svc_acct_sm; use FS::svc_domain; use FS::svc_forward; -use FS::svc_broadband; use FS::domain_record; use FS::part_export; @@ -234,7 +234,7 @@ sub check { if scalar(@cust_svc) >= $quantity && !$ignore_quantity; } - $self->SUPER::check; + ''; #no error } =item part_svc @@ -280,6 +280,11 @@ sub label { my $tag; if ( $svcdb eq 'svc_acct' ) { $tag = $svc_x->email; + } elsif ( $svcdb eq 'svc_acct_sm' ) { + my $domuser = $svc_x->domuser eq '*' ? '(anything)' : $svc_x->domuser; + my $svc_domain = qsearchs ( 'svc_domain', { 'svcnum' => $svc_x->domsvc } ); + my $domain = $svc_domain->domain; + $tag = "$domuser\@$domain"; } elsif ( $svcdb eq 'svc_forward' ) { if ( $svc_x->srcsvc ) { my $svc_acct = $svc_x->srcsvc_acct; @@ -299,10 +304,6 @@ sub label { } elsif ( $svcdb eq 'svc_www' ) { my $domain = qsearchs( 'domain_record', { 'recnum' => $svc_x->recnum } ); $tag = $domain->zone; - } elsif ( $svcdb eq 'svc_broadband' ) { - $tag = $svc_x->ip_addr; - } elsif ( $svcdb eq 'svc_external' ) { - $tag = $svc_x->id. ': '. $svc_x->title; } else { cluck "warning: asked for label of unsupported svcdb; using svcnum"; $tag = $svc_x->getfield('svcnum'); diff --git a/FS/FS/cust_tax_exempt.pm b/FS/FS/cust_tax_exempt.pm index da0de000a..ab873c0a7 100644 --- a/FS/FS/cust_tax_exempt.pm +++ b/FS/FS/cust_tax_exempt.pm @@ -111,7 +111,6 @@ sub check { || $self->ut_number('year') #check better || $self->ut_number('month') #check better || $self->ut_money('amount') - || $self->SUPER::check ; } diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm index 2a30594da..4dfa5b6fd 100644 --- a/FS/FS/domain_record.pm +++ b/FS/FS/domain_record.pm @@ -298,7 +298,7 @@ sub check { die "ack!"; } - $self->SUPER::check; + ''; #no error } =item increment_serial diff --git a/FS/FS/export_svc.pm b/FS/FS/export_svc.pm index c104e4538..da9ac698a 100644 --- a/FS/FS/export_svc.pm +++ b/FS/FS/export_svc.pm @@ -105,7 +105,6 @@ sub check { || $self->ut_foreign_key('exportnum', 'part_export', 'exportnum') || $self->ut_number('svcpart') || $self->ut_foreign_key('svcpart', 'part_svc', 'svcpart') - || $self->SUPER::check ; } diff --git a/FS/FS/msgcat.pm b/FS/FS/msgcat.pm index 855b8b291..fa10d34fa 100644 --- a/FS/FS/msgcat.pm +++ b/FS/FS/msgcat.pm @@ -113,7 +113,7 @@ sub check { $self->locale =~ /^([\w\@]+)$/ or return "illegal locale: ". $self->locale; $self->locale($1); - $self->SUPER::check + ''; #no error } =back diff --git a/FS/FS/nas.pm b/FS/FS/nas.pm index 2d17df899..58c6827ea 100644 --- a/FS/FS/nas.pm +++ b/FS/FS/nas.pm @@ -114,9 +114,7 @@ sub check { || $self->ut_text('nas') || $self->ut_ip('nasip') || $self->ut_domain('nasfqdn') - || $self->ut_numbern('last') - || $self->SUPER::check - ; + || $self->ut_numbern('last'); } =item heartbeat TIMESTAMP @@ -138,7 +136,7 @@ sub heartbeat { =head1 VERSION -$Id: nas.pm,v 1.7 2003-08-05 00:20:43 khoff Exp $ +$Id: nas.pm,v 1.6 2002-03-04 12:48:49 ivan Exp $ =head1 BUGS diff --git a/FS/FS/part_bill_event.pm b/FS/FS/part_bill_event.pm index 86f929424..2638328ea 100644 --- a/FS/FS/part_bill_event.pm +++ b/FS/FS/part_bill_event.pm @@ -37,7 +37,7 @@ FS::Record. The following fields are currently supported: =item eventpart - primary key -=item payby - CARD, DCRD, CHEK, DCHK, LECB, BILL, or COMP +=item payby - CARD, CHEK, LECB, BILL, or COMP =item event - event name @@ -140,7 +140,7 @@ sub check { } my $error = $self->ut_numbern('eventpart') - || $self->ut_enum('payby', [qw( CARD DCRD CHEK DCHK LECB BILL COMP )] ) + || $self->ut_enum('payby', [qw( CARD CHEK LECB BILL COMP )] ) || $self->ut_text('event') || $self->ut_anything('eventcode') || $self->ut_number('seconds') @@ -168,7 +168,8 @@ sub check { } } - $self->SUPER::check; + ''; + } =back diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index bd12389c2..f722dd917 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -283,7 +283,7 @@ sub check { #check exporttype? - $self->SUPER::check; + ''; #no error } #=item part_svc diff --git a/FS/FS/part_export/router.pm b/FS/FS/part_export/router.pm deleted file mode 100644 index 648a4372b..000000000 --- a/FS/FS/part_export/router.pm +++ /dev/null @@ -1,190 +0,0 @@ -package FS::part_export::router; - -=head1 FS::part_export::router - -This export connects to a router and transmits commands via telnet or SSH. -It requires the following custom router fields: - -=over 4 - -=item admin_address - IP address (or hostname) to connect - -=item admin_user - username for admin access - -=item admin_password - password for admin access - -=back - -The export itself needs the following options: - -=over 4 - -=item insert, replace, delete - command strings (to be interpolated) - -=item Prompt - prompt string to expect from router after successful login - -=item Timeout - time to wait for prompt string - -=back - -(Prompt and Timeout are required only for telnet connections.) - -=cut - -use vars qw(@ISA %info @saltset); -use Tie::IxHash; -use String::ShellQuote; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'protocol' => { - label=>'Protocol', - type =>'select', - options => [qw(telnet ssh)], - default => 'telnet'}, - 'insert' => {label=>'Insert command', default=>'' }, - 'delete' => {label=>'Delete command', default=>'' }, - 'replace' => {label=>'Replace command', default=>'' }, - 'Timeout' => {label=>'Time to wait for prompt', default=>'20' }, - 'Prompt' => {label=>'Prompt string', default=>'#' } -; - -%info = ( - 'svc' => 'svc_broadband', - 'desc' => 'Send a command to a router.', - 'options' => \%options, - 'notes' => 'Installation of Net::Telnet from CPAN is required for telnet connections. ( more detailed description from Kristian / fire2wire? )', -); - -@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); - -sub rebless { shift; } - -sub _export_insert { - my($self) = shift; - $self->_export_command('insert', @_); -} - -sub _export_delete { - my($self) = shift; - $self->_export_command('delete', @_); -} - -sub _export_suspend { - my($self) = shift; - $self->_export_command('suspend', @_); -} - -sub _export_unsuspend { - my($self) = shift; - $self->_export_command('unsuspend', @_); -} - -sub _export_command { - my ( $self, $action, $svc_broadband) = (shift, shift, shift); - my $command = $self->option($action); - return '' if $command =~ /^\s*$/; - - no strict 'vars'; - { - no strict 'refs'; - ${$_} = $svc_broadband->getfield($_) foreach $svc_broadband->fields; - } - # fetch router info - my $router = $svc_broadband->addr_block->router; - my %r; - $r{$_} = $router->getfield($_) foreach $router->virtual_fields; - #warn qq("$command"); - #warn eval(qq("$command")); - - warn "admin_address: '$r{admin_address}'"; - - if ($r{admin_address} ne '') { - $self->router_queue( $svc_broadband->svcnum, $self->option('protocol'), - user => $r{admin_user}, - password => $r{admin_password}, - host => $r{admin_address}, - Timeout => $self->option('Timeout'), - Prompt => $self->option('Prompt'), - command => eval(qq("$command")), - ); - } else { - return ''; - } -} - -sub _export_replace { - - # We don't handle the case of a svc_broadband moving between routers. - # If you want to do that, reprovision the service. - - my($self, $new, $old ) = (shift, shift, shift); - my $command = $self->option('replace'); - no strict 'vars'; - { - no strict 'refs'; - ${"old_$_"} = $old->getfield($_) foreach $old->fields; - ${"new_$_"} = $new->getfield($_) foreach $new->fields; - } - - my $router = $new->addr_block->router; - my %r; - $r{$_} = $router->getfield($_) foreach $router->virtual_fields; - - if ($r{admin_address} ne '') { - $self->router_queue( $new->svcnum, $self->option('protocol'), - user => $r{admin_user}, - password => $r{admin_password}, - host => $r{admin_address}, - Timeout => $self->option('Timeout'), - Prompt => $self->option('Prompt'), - command => eval(qq("$command")), - ); - } else { - return ''; - } -} - -#a good idea to queue anything that could fail or take any time -sub router_queue { - #warn join ':', @_; - my( $self, $svcnum, $protocol ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - }; - $queue->job ("FS::part_export::router::".$protocol."_cmd"); - $queue->insert( @_ ); -} - -sub ssh_cmd { #subroutine, not method - use Net::SSH '0.08'; - &Net::SSH::ssh_cmd( { @_ } ); -} - -sub telnet_cmd { - eval 'use Net::Telnet;'; - die $@ if $@; - - warn join(', ', @_); - - my %arg = @_; - - my $t = new Net::Telnet (Timeout => $arg{Timeout}, - Prompt => $arg{Prompt}); - $t->open($arg{host}); - $t->login($arg{user}, $arg{password}); - my @error = $t->cmd($arg{command}); - die @error if (grep /^ERROR/, @error); -} - -#sub router_insert { #subroutine, not method -#} -#sub router_replace { #subroutine, not method -#} -#sub router_delete { #subroutine, not method -#} - -1; - diff --git a/FS/FS/part_export_option.pm b/FS/FS/part_export_option.pm index 33b5e5a67..a0b19fde1 100644 --- a/FS/FS/part_export_option.pm +++ b/FS/FS/part_export_option.pm @@ -115,7 +115,7 @@ sub check { #check options & values? - $self->SUPER::check; + ''; #no error } =back diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index dcce66b38..45760668f 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -249,7 +249,6 @@ sub check { || $self->ut_enum('recurtax', [ '', 'Y' ] ) || $self->ut_textn('taxclass') || $self->ut_enum('disabled', [ '', 'Y' ] ) - || $self->SUPER::check ; } diff --git a/FS/FS/part_pop_local.pm b/FS/FS/part_pop_local.pm index f7d5eac9a..0b7cdf6c9 100644 --- a/FS/FS/part_pop_local.pm +++ b/FS/FS/part_pop_local.pm @@ -92,7 +92,6 @@ sub check { or $self->ut_text('state') or $self->ut_number('npa') or $self->ut_number('nxx') - or $self->SUPER::check ; } @@ -101,7 +100,7 @@ sub check { =head1 VERSION -$Id: part_pop_local.pm,v 1.2 2003-08-05 00:20:44 khoff Exp $ +$Id: part_pop_local.pm,v 1.1 2001-09-26 09:17:06 ivan Exp $ =head1 BUGS diff --git a/FS/FS/part_referral.pm b/FS/FS/part_referral.pm index c0858c0ed..90ce7fef2 100644 --- a/FS/FS/part_referral.pm +++ b/FS/FS/part_referral.pm @@ -103,7 +103,7 @@ sub check { return $error if $error; } - $self->SUPER::check; + ''; } =back diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm index aacc3ab48..552019acb 100644 --- a/FS/FS/part_svc.pm +++ b/FS/FS/part_svc.pm @@ -68,7 +68,7 @@ TODOC: =item I<svcdb>__I<field> - Default or fixed value for I<field> in I<svcdb>. -=item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null, `D' for default, or `F' for fixed. For virtual fields, can also be 'X' for excluded. +=item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null, `D' for default, or `F' for fixed TODOC: EXTRA_FIELDS_ARRAYREF @@ -113,7 +113,7 @@ sub insert { } ); my $flag = $self->getfield($svcdb.'__'.$field.'_flag'); - if ( uc($flag) =~ /^([DFX])$/ ) { + if ( uc($flag) =~ /^([DF])$/ ) { $part_svc_column->setfield('columnflag', $1); $part_svc_column->setfield('columnvalue', $self->getfield($svcdb.'__'.$field) @@ -201,7 +201,7 @@ sub replace { } ); my $flag = $new->getfield($svcdb.'__'.$field.'_flag'); - if ( uc($flag) =~ /^([DFX])$/ ) { + if ( uc($flag) =~ /^([DF])$/ ) { $part_svc_column->setfield('columnflag', $1); $part_svc_column->setfield('columnvalue', $new->getfield($svcdb.'__'.$field) @@ -254,7 +254,32 @@ sub check { my @fields = eval { fields( $recref->{svcdb} ) }; #might die return "Unknown svcdb!" unless @fields; - $self->SUPER::check; +##REPLACED BY part_svc_column +# my $svcdb; +# foreach $svcdb ( qw( +# svc_acct svc_acct_sm svc_domain +# ) ) { +# my @rows = map { /^${svcdb}__(.*)$/; $1 } +# grep ! /_flag$/, +# grep /^${svcdb}__/, +# fields('part_svc'); +# foreach my $row (@rows) { +# unless ( $svcdb eq $recref->{svcdb} ) { +# $recref->{$svcdb.'__'.$row}=''; +# $recref->{$svcdb.'__'.$row.'_flag'}=''; +# next; +# } +# $recref->{$svcdb.'__'.$row.'_flag'} =~ /^([DF]?)$/ +# or return "Illegal flag for $svcdb $row"; +# $recref->{$svcdb.'__'.$row.'_flag'} = $1; +# +# my $error = $self->ut_anything($svcdb.'__'.$row); +# return $error if $error; +# +# } +# } + + ''; #no error } =item part_svc_column COLUMNNAME @@ -265,12 +290,12 @@ COLUMNNAME, or a new part_svc_column object if none exists. =cut sub part_svc_column { - my( $self, $columnname) = @_; - $self->svcpart && - qsearchs('part_svc_column', { - 'svcpart' => $self->svcpart, - 'columnname' => $columnname, - } + my $self = shift; + my $columnname = shift; + qsearchs('part_svc_column', { + 'svcpart' => $self->svcpart, + 'columnname' => $columnname, + } ) or new FS::part_svc_column { 'svcpart' => $self->svcpart, 'columnname' => $columnname, diff --git a/FS/FS/part_svc_column.pm b/FS/FS/part_svc_column.pm index 885155be3..37e841e87 100644 --- a/FS/FS/part_svc_column.pm +++ b/FS/FS/part_svc_column.pm @@ -41,7 +41,7 @@ fields are currently supported: =item columnvalue - default or fixed value for the column -=item columnflag - null, D, F, X (virtual fields) +=item columnflag - null, D or F =back @@ -91,18 +91,18 @@ sub check { ; return $error if $error; - $self->columnflag =~ /^([DFX])$/ + $self->columnflag =~ /^([DF])$/ or return "illegal columnflag ". $self->columnflag; $self->columnflag(uc($1)); - $self->SUPER::check; + ''; #no error } =back =head1 VERSION -$Id: part_svc_column.pm,v 1.2 2003-08-05 00:20:44 khoff Exp $ +$Id: part_svc_column.pm,v 1.1 2001-09-07 20:49:15 ivan Exp $ =head1 BUGS diff --git a/FS/FS/part_svc_router.pm b/FS/FS/part_svc_router.pm deleted file mode 100755 index 0b23ab580..000000000 --- a/FS/FS/part_svc_router.pm +++ /dev/null @@ -1,32 +0,0 @@ -package FS::part_svc_router; - -use strict; -use vars qw( @ISA ); -use FS::Record qw(qsearchs); -use FS::router; -use FS::part_svc; - -@ISA = qw(FS::Record); - -sub table { 'part_svc_router'; } - -sub check { - my $self = shift; - my $error = - $self->ut_foreign_key('svcpart', 'part_svc', 'svcpart') - || $self->ut_foreign_key('routernum', 'router', 'routernum'); - return $error if $error; - ''; #no error -} - -sub router { - my $self = shift; - return qsearchs('router', { routernum => $self->routernum }); -} - -sub part_svc { - my $self = shift; - return qsearchs('part_svc', { svcpart => $self->svcpart }); -} - -1; diff --git a/FS/FS/part_virtual_field.pm b/FS/FS/part_virtual_field.pm deleted file mode 100755 index 03c34cca5..000000000 --- a/FS/FS/part_virtual_field.pm +++ /dev/null @@ -1,303 +0,0 @@ -package FS::part_virtual_field; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearchs qsearch dbdef ); - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::part_virtual_field - Object methods for part_virtual_field records - -=head1 SYNOPSIS - - use FS::part_virtual_field; - - $record = new FS::part_virtual_field \%hash; - $record = new FS::part_virtual_field { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::part_virtual_field object represents the definition of a virtual field -(see the BACKGROUND section). FS::part_virtual_field contains the name and -base table of the field, as well as validation rules and UI hints about the -display of the field. The actual data is stored in FS::virtual_field; see -its manpage for details. - -FS::part_virtual_field inherits from FS::Record. The following fields are -currently supported: - -=over 2 - -=item vfieldpart - primary key (assigned automatically) - -=item name - name of the field - -=item dbtable - table for which this virtual field is defined - -=item check_block - Perl code to validate/normalize data - -=item list_source - Perl code to generate a list of values (UI hint) - -=item length - expected length of the value (UI hint) - -=item label - descriptive label for the field (UI hint) - -=item sequence - sort key (UI hint; unimplemented) - -=back - -=head1 BACKGROUND - -"Form is none other than emptiness, - and emptiness is none other than form." --- Heart Sutra - -The virtual field mechanism allows site admins to make trivial changes to -the Freeside database schema without modifying the code. Specifically, the -user can add custom-defined 'fields' to the set of data tracked by Freeside -about objects such as customers and services. These fields are not associated -with any logic in the core Freeside system, but may be referenced in peripheral -code such as exports, price calculations, or alternate interfaces, or may just -be stored in the database for future reference. - -This system was originally devised for svc_broadband, which (by necessity) -comprises such a wide range of access technologies that no static set of fields -could contain all the information needed by the exports. In an appalling -display of False Laziness, a parallel mechanism was implemented for the -router table, to store properties such as passwords to configure routers. - -The original system treated svc_broadband custom fields (sb_fields) as records -in a completely separate table. Any code that accessed or manipulated these -fields had to be aware that they were I<not> fields in svc_broadband, but -records in sb_field. For example, code that inserted a svc_broadband with -several custom fields had to create an FS::svc_broadband object, call its -insert() method, and then create several FS::sb_field objects and call I<their> -insert() methods. - -This created a problem for exports. The insert method on any FS::svc_Common -object (including svc_broadband) automatically triggers exports after the -record has been inserted. However, at this point, the sb_fields had not yet -been inserted, so the export could not rely on their presence, which was the -original purpose of sb_fields. - -Hence the new system. Virtual fields are appended to the field list of every -record at the FS::Record level, whether the object is created ex nihilo with -new() or fetched with qsearch(). The fields() method now returns a list of -both real and virtual fields. The insert(), replace(), and delete() methods -now update both the base table and the virtual fields, in a single transaction. - -A new method is provided, virtual_fields(), which gives only the virtual -fields. UI code that dynamically generates form widgets to edit virtual field -data should use this to figure out what fields are defined. (See below.) - -Subclasses may override virtual_fields() to restrict the set of virtual -fields available. Some discipline and sanity on the part of the programmer -are required; in particular, this function should probably not depend on any -fields in the record other than the primary key, since the others may change -after the object is instantiated. (Making it depend on I<virtual> fields is -just asking for pain.) One use of this is seen in FS::svc_Common; another -possibility is field-level access control based on FS::UID::getotaker(). - -As a trivial case, a subclass may opt out of supporting virtual fields with -the following code: - -sub virtual_fields { () } - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Create a new record. To add the record to the database, see "insert". - -=cut - -sub table { 'part_virtual_field'; } -sub virtual_fields { () } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Deletes this record from the database. If there is an error, returns the -error, otherwise returns false. - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -If there is an error, returns the error, otherwise returns false. -Called by the insert and replace methods. - -=back - -=cut - -sub check { - my $self = shift; - - my $error = $self->ut_text('name') || - $self->ut_text('dbtable') || - $self->ut_number('length') - ; - return $error if $error; - - # Make sure it's a real table with a numeric primary key - my ($table, $pkey); - if($table = $FS::Record::dbdef->table($self->dbtable)) { - if($pkey = $table->primary_key) { - if($table->column($pkey)->type =~ /int/i) { - # this is what it should be - } else { - $error = "$table.$pkey is not an integer"; - } - } else { - $error = "$table does not have a single-field primary key"; - } - } else { - $error = "$table does not exist in the schema"; - } - return $error if $error; - - # Possibly some sanity checks for check_block and list_source? - - $self->SUPER::check; -} - -=item list - -Evaluates list_source. - -=cut - -sub list { - my $self = shift; - return () unless $self->list_source; - - my @opts = eval($self->list_source); - if($@) { - warn $@; - return (); - } else { - return @opts; - } -} - -=item widget UI_TYPE MODE [ VALUE ] - -Generates UI code for a widget suitable for editing/viewing the field, based on -list_source and length. - -The only UI_TYPE currently supported is 'HTML', and the only MODE is 'view'. -Others will be added later. - -In HTML, all widgets are assumed to be table rows. View widgets look like -<TR><TD ALIGN="right">Label</TD><TD BGCOLOR="#ffffff">Value</TD></TR> - -(Most of the display style stuff, such as the colors, should probably go into -a separate module specific to the UI. That can wait, though. The API for -this function won't change.) - -VALUE (optional) is the current value of the field. - -=cut - -sub widget { - my $self = shift; - my ($ui_type, $mode, $value) = @_; - my $text; - my $label = $self->label || $self->name; - - if ($ui_type eq 'HTML') { - if ($mode eq 'view') { - $text = q!<TR><TD ALIGN="right">! . $label . - q!</TD><TD BGCOLOR="#ffffff">! . $value . - q!</TD></TR>! . "\n"; - } elsif ($mode eq 'edit') { - $text = q!<TR><TD ALIGN="right">! . $label . - q!</TD><TD>!; - if ($self->list_source) { - $text .= q!<SELECT NAME="! . $self->name . - q!" SIZE=1>! . "\n"; - foreach ($self->list) { - $text .= q!<OPTION VALUE="! . $_ . q!"!; - $text .= ' SELECTED' if ($_ eq $value); - $text .= '>' . $_ . '</OPTION>' . "\n"; - } - } else { - $text .= q!<INPUT NAME="! . $self->name . - q!" VALUE="! . $value . q!"!; - if ($self->length) { - $text .= q! SIZE="! . $self->length . q!"!; - } - $text .= '>'; - } - $text .= q!</TD></TR>! . "\n"; - } else { - return ''; - } - } else { - return ''; - } - return $text; -} - -=head1 VERSION - -$Id: part_virtual_field.pm,v 1.2 2003-08-05 00:20:45 khoff Exp $ - -=head1 NOTES - -=head2 Semantics of check_block: - -This has been changed from the sb_field implementation to make check_blocks -simpler and more natural to Perl programmers who work on things other than -Freeside. - -The check_block is eval'd with the (proposed) new value of the field in $_, -and the object to be updated in $self. Its return value is ignored. The -check_block may change the value of $_ to override the proposed value, or -call die() (with an appropriate error message) to reject the update entirely; -the error string will be returned as the output of the check() method. - -This makes check_blocks like - -C<s/foo/bar/> - -do what you expect. - -The check_block is expected NOT to do anything freaky to $self, like modifying -other fields or calling $self->check(). You have been warned. - -(FIXME: Rewrite some of the warnings from part_sb_field and insert here.) - -=head1 BUGS - -None. It's absolutely falwless. - -=head1 SEE ALSO - -L<FS::Record>, L<FS::virtual_field> - -=cut - -1; - - diff --git a/FS/FS/pkg_svc.pm b/FS/FS/pkg_svc.pm index ea52176cb..3956dd831 100644 --- a/FS/FS/pkg_svc.pm +++ b/FS/FS/pkg_svc.pm @@ -115,7 +115,7 @@ sub check { return $error if $error; } - $self->SUPER::check; + ''; #no error } =item part_pkg diff --git a/FS/FS/port.pm b/FS/FS/port.pm index 620030afc..13455ca89 100644 --- a/FS/FS/port.pm +++ b/FS/FS/port.pm @@ -113,7 +113,7 @@ sub check { unless $self->ip || $self->nasport; return "Unknown nasnum" unless qsearchs('nas', { 'nasnum' => $self->nasnum } ); - $self->SUPER::check; + ''; #no error } =item session @@ -133,7 +133,7 @@ sub session { =head1 VERSION -$Id: port.pm,v 1.6 2003-08-05 00:20:45 khoff Exp $ +$Id: port.pm,v 1.5 2001-02-14 04:33:06 ivan Exp $ =head1 BUGS diff --git a/FS/FS/prepay_credit.pm b/FS/FS/prepay_credit.pm index a9d26d151..7ed9b8344 100644 --- a/FS/FS/prepay_credit.pm +++ b/FS/FS/prepay_credit.pm @@ -108,7 +108,6 @@ sub check { || $self->ut_alpha('identifier') || $self->ut_money('amount') || $self->utnumbern('seconds') - || $self->SUPER::check ; } diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm index 9dcb2e3be..68a48634c 100644 --- a/FS/FS/queue.pm +++ b/FS/FS/queue.pm @@ -213,7 +213,7 @@ sub check { $self->status('new') unless $self->status; $self->_date(time) unless $self->_date; - $self->SUPER::check; + ''; #no error } =item args @@ -424,7 +424,7 @@ END =head1 VERSION -$Id: queue.pm,v 1.17 2004-03-03 13:42:08 ivan Exp $ +$Id: queue.pm,v 1.15.4.1 2004-03-03 13:44:27 ivan Exp $ =head1 BUGS diff --git a/FS/FS/queue_arg.pm b/FS/FS/queue_arg.pm index d23ee2afd..08fe47341 100644 --- a/FS/FS/queue_arg.pm +++ b/FS/FS/queue_arg.pm @@ -100,14 +100,14 @@ sub check { ; return $error if $error; - $self->SUPER::check; + ''; #no error } =back =head1 VERSION -$Id: queue_arg.pm,v 1.2 2003-08-05 00:20:46 khoff Exp $ +$Id: queue_arg.pm,v 1.1 2001-09-11 00:08:18 ivan Exp $ =head1 BUGS diff --git a/FS/FS/queue_depend.pm b/FS/FS/queue_depend.pm index bc910d8e9..4a4e3c55c 100644 --- a/FS/FS/queue_depend.pm +++ b/FS/FS/queue_depend.pm @@ -103,7 +103,6 @@ sub check { $self->ut_numbern('dependnum') || $self->ut_foreign_key('jobnum', 'queue', 'jobnum') || $self->ut_foreign_key('depend_jobnum', 'queue', 'jobnum') - || $self->SUPER::check ; } diff --git a/FS/FS/radius_usergroup.pm b/FS/FS/radius_usergroup.pm index 9bba057c9..647621d28 100644 --- a/FS/FS/radius_usergroup.pm +++ b/FS/FS/radius_usergroup.pm @@ -100,7 +100,6 @@ sub check { || $self->ut_number('svcnum') || $self->ut_foreign_key('svcnum','svc_acct','svcnum') || $self->ut_text('groupname') - || $self->SUPER::check ; } diff --git a/FS/FS/router.pm b/FS/FS/router.pm deleted file mode 100755 index 2554ce86b..000000000 --- a/FS/FS/router.pm +++ /dev/null @@ -1,144 +0,0 @@ -package FS::router; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearchs qsearch ); -use FS::addr_block; - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::router - Object methods for router records - -=head1 SYNOPSIS - - use FS::router; - - $record = new FS::router \%hash; - $record = new FS::router { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::router record describes a broadband router, such as a DSLAM or a wireless - access point. FS::router inherits from FS::Record. The following -fields are currently supported: - -=over 4 - -=item routernum - primary key - -=item routername - descriptive name for the router - -=item svcnum - svcnum of the owning FS::svc_broadband, if appropriate - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Create a new record. To add the record to the database, see "insert". - -=cut - -sub table { 'router'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=item delete - -Deletes this record from the database. If there is an error, returns the -error, otherwise returns false. - -=item replace OLD_RECORD - -Replaces OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=item check - -Checks all fields to make sure this is a valid record. If there is an error, -returns the error, otherwise returns false. Called by the insert and replace -methods. - -=cut - -sub check { - my $self = shift; - - my $error = - $self->ut_numbern('routernum') - || $self->ut_text('routername'); - return $error if $error; - - $self->SUPER::check; -} - -=item addr_block - -Returns a list of FS::addr_block objects (address blocks) associated -with this object. - -=cut - -sub addr_block { - my $self = shift; - return qsearch('addr_block', { routernum => $self->routernum }); -} - -=item part_svc_router - -Returns a list of FS::part_svc_router objects associated with this -object. This is unlikely to be useful for any purpose other than retrieving -the associated FS::part_svc objects. See below. - -=cut - -sub part_svc_router { - my $self = shift; - return qsearch('part_svc_router', { routernum => $self->routernum }); -} - -=item part_svc - -Returns a list of FS::part_svc objects associated with this object. - -=cut - -sub part_svc { - my $self = shift; - return map { qsearchs('part_svc', { svcpart => $_->svcpart }) } - $self->part_svc_router; -} - -=back - -=head1 VERSION - -$Id: - -=head1 BUGS - -=head1 SEE ALSO - -FS::svc_broadband, FS::router, FS::addr_block, FS::part_svc, -schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/session.pm b/FS/FS/session.pm index 2ad594cf2..de0f2a76a 100644 --- a/FS/FS/session.pm +++ b/FS/FS/session.pm @@ -216,7 +216,7 @@ sub check { return $error if $error; return "Unknown svcnum" unless qsearchs('svc_acct', { 'svcnum' => $self->svcnum } ); - $self->SUPER::check; + ''; } =item nas_heartbeat @@ -247,7 +247,7 @@ sub svc_acct { =head1 VERSION -$Id: session.pm,v 1.8 2003-08-05 00:20:46 khoff Exp $ +$Id: session.pm,v 1.7 2001-04-15 13:35:12 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm index a22326696..315b7c074 100644 --- a/FS/FS/svc_Common.pm +++ b/FS/FS/svc_Common.pm @@ -2,7 +2,7 @@ package FS::svc_Common; use strict; use vars qw( @ISA $noexport_hack $DEBUG ); -use FS::Record qw( qsearch qsearchs fields dbh ); +use FS::Record qw( qsearchs fields dbh ); use FS::cust_svc; use FS::part_svc; use FS::queue; @@ -31,60 +31,6 @@ inherit from, i.e. FS::svc_acct. FS::svc_Common inherits from FS::Record. =over 4 -=cut - -sub virtual_fields { - - # This restricts the fields based on part_svc_column and the svcpart of - # the service. There are four possible cases: - # 1. svcpart passed as part of the svc_x hash. - # 2. svcpart fetched via cust_svc based on svcnum. - # 3. No svcnum or svcpart. In this case, return ALL the fields with - # dbtable eq $self->table. - # 4. Called via "fields('svc_acct')" or something similar. In this case - # there is no $self object. - - my $self = shift; - my $svcpart; - my @vfields = $self->SUPER::virtual_fields; - - return @vfields unless (ref $self); # Case 4 - - if ($self->svcpart) { # Case 1 - $svcpart = $self->svcpart; - } elsif ( $self->svcnum - && qsearchs('cust_svc',{'svcnum'=>$self->svcnum} ) - ) { #Case 2 - $svcpart = $self->cust_svc->svcpart; - } else { # Case 3 - $svcpart = ''; - } - - if ($svcpart) { #Cases 1 and 2 - my %flags = map { $_->columnname, $_->columnflag } ( - qsearch ('part_svc_column', { svcpart => $svcpart } ) - ); - return grep { not ($flags{$_} eq 'X') } @vfields; - } else { # Case 3 - return @vfields; - } - return (); -} - -=item check - -Checks the validity of fields in this record. - -At present, this does nothing but call FS::Record::check (which, in turn, -does nothing but run virtual field checks). - -=cut - -sub check { - my $self = shift; - $self->SUPER::check; -} - =item insert [ , OPTION => VALUE ... ] Adds this record to the database. If there is an error, returns the error, @@ -368,7 +314,7 @@ sub setx { #set default/fixed/whatever fields from part_svc my $table = $self->table; - foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) { + foreach my $field ( grep { $_ ne 'svcnum' } fields($table) ) { my $part_svc_column = $part_svc->part_svc_column($field); if ( $part_svc_column->columnflag eq $x ) { $self->setfield( $field, $part_svc_column->columnvalue ); @@ -500,6 +446,10 @@ sub clone_kludge_unsuspend { =back +=head1 VERSION + +$Id: svc_Common.pm,v 1.12.4.6 2004-03-03 13:44:27 ivan Exp $ + =head1 BUGS The setfixed method return value. diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 100af6cb6..4b51a3671 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -7,6 +7,7 @@ use vars qw( @ISA $DEBUG $me $conf $username_ampersand $username_letter $username_letterfirst $username_noperiod $username_nounderscore $username_nodash $username_uppercase + $mydomain $welcome_template $welcome_from $welcome_subject $welcome_mimetype $smtpmachine $radius_password $radius_ip @@ -19,9 +20,11 @@ use FS::UID qw( datasrc ); use FS::Conf; use FS::Record qw( qsearch qsearchs fields dbh dbdef ); use FS::svc_Common; +use Net::SSH; use FS::cust_svc; use FS::part_svc; use FS::svc_acct_pop; +use FS::svc_acct_sm; use FS::cust_main_invoice; use FS::svc_domain; use FS::raddb; @@ -53,6 +56,7 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $username_nodash = $conf->exists('username-nodash'); $username_uppercase = $conf->exists('username-uppercase'); $username_ampersand = $conf->exists('username-ampersand'); + $mydomain = $conf->config('domain'); $dirhash = $conf->config('dirhash') || 0; if ( $conf->exists('welcome_email') ) { $welcome_template = new Text::Template ( @@ -322,8 +326,8 @@ sub insert { if ( exists($conflict_user_svcpart{$dup_svcpart}) || exists($conflict_userdomain_svcpart{$dup_svcpart}) ) { $dbh->rollback if $oldAutoCommit; - return "duplicate uid: conflicts with svcnum". $dup_uid->svcnum. - "via exportnum ". $conflict_user_svcpart{$dup_svcpart} + return "duplicate uid: conflicts with svcnum ". $dup_uid->svcnum. + " via exportnum ". $conflict_user_svcpart{$dup_svcpart} || $conflict_userdomain_svcpart{$dup_svcpart}; } } @@ -455,6 +459,11 @@ The corresponding FS::cust_svc record will be deleted as well. sub delete { my $self = shift; + if ( defined( $FS::Record::dbdef->table('svc_acct_sm') ) ) { + return "Can't delete an account which has (svc_acct_sm) mail aliases!" + if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } ); + } + return "can't delete system account" if $self->_check_system; return "Can't delete an account which is a (svc_forward) source!" @@ -637,11 +646,13 @@ sub replace { =item suspend -Suspends this account by calling export-specific suspend hooks. If there is -an error, returns the error, otherwise returns false. +Suspends this account by prefixing *SUSPENDED* to the password. If there is an +error, returns the error, otherwise returns false. Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>). +Calls any export-specific suspend hooks. + =cut sub suspend { @@ -652,11 +663,13 @@ sub suspend { =item unsuspend -Unsuspends this account by by calling export-specific suspend hooks. If there -is an error, returns the error, otherwise returns false. +Unsuspends this account by removing *SUSPENDED* from the password. If there is +an error, returns the error, otherwise returns false. Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>). +Calls any export-specific unsuspend hooks. + =cut sub unsuspend { @@ -674,35 +687,9 @@ sub unsuspend { =item cancel -Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>). - -If the B<auto_unset_catchall> configuration option is set, this method will -automatically remove any references to the canceled service in the catchall -field of svc_domain. This allows packages that contain both a svc_domain and -its catchall svc_acct to be canceled in one step. - -=cut - -sub cancel { - # Only one thing to do at this level - my $self = shift; - foreach my $svc_domain ( - qsearch( 'svc_domain', { catchall => $self->svcnum } ) ) { - if($conf->exists('auto_unset_catchall')) { - my %hash = $svc_domain->hash; - $hash{catchall} = ''; - my $new = new FS::svc_domain ( \%hash ); - my $error = $new->replace($svc_domain); - return $error if $error; - } else { - return "cannot unprovision svc_acct #".$self->svcnum. - " while assigned as catchall for svc_domain #".$svc_domain->svcnum; - } - } - - $self->SUPER::cancel; -} +Just returns false (no error) for now. +Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>). =item check @@ -845,7 +832,7 @@ sub check { $recref->{slipip} = '0e0'; } else { $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/ - or return "Illegal slipip: ". $self->slipip; + or return "Illegal slipip". $self->slipip; $recref->{slipip} = $1; } @@ -885,13 +872,13 @@ sub check { ": ". $recref->{_password}; } - $self->SUPER::check; + ''; #no error } =item _check_system - + =cut - + sub _check_system { my $self = shift; scalar( grep { $self->username eq $_ || $self->email eq $_ } @@ -899,6 +886,7 @@ sub _check_system { ); } + =item radius Depriciated, use radius_reply instead. @@ -951,7 +939,7 @@ sub radius_check { my $self = shift; my $password = $self->_password; my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password'; - ( $pw_attrib => $password, + ( $pw_attrib => $self->_password, map { /^(rc_(.*))$/; my($column, $attrib) = ($1, $2); @@ -969,10 +957,14 @@ Returns the domain associated with this account. sub domain { my $self = shift; - die "svc_acct.domsvc is null for svcnum ". $self->svcnum unless $self->domsvc; - my $svc_domain = $self->svc_domain - or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc; - $svc_domain->domain; + if ( $self->domsvc ) { + #$self->svc_domain->domain; + my $svc_domain = $self->svc_domain + or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc; + $svc_domain->domain; + } else { + $mydomain or die "svc_acct.domsvc is null and no legacy domain config file"; + } } =item svc_domain @@ -1085,6 +1077,7 @@ sub attribute_since_sqlradacct { $self->cust_svc->attribute_since_sqlradacct(@_); } + =item get_session_history_sqlradacct TIMESTAMP_START TIMESTAMP_END Returns an array of hash references of this customers login history for the @@ -1188,28 +1181,36 @@ sub check_password { =item send_email -This is the FS::svc_acct job-queue-able version. It still uses -FS::Misc::send_email under-the-hood. - =cut sub send_email { my %opt = @_; - eval "use FS::Misc qw(send_email)"; - die $@ if $@; + use Date::Format; + use Mail::Internet 1.44; + use Mail::Header; $opt{mimetype} ||= 'text/plain'; $opt{mimetype} .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/; - my $error = send_email( - 'from' => $opt{from}, - 'to' => $opt{to}, - 'subject' => $opt{subject}, - 'content-type' => $opt{mimetype}, - 'body' => [ map "$_\n", split("\n", $opt{body}) ], + $ENV{MAILADDRESS} = $opt{from}; + my $header = new Mail::Header ( [ + "From: $opt{from}", + "To: $opt{to}", + "Sender: $opt{from}", + "Reply-To: $opt{from}", + "Date: ". time2str("%a, %d %b %Y %X %z", time), + "Subject: $opt{subject}", + "Content-Type: $opt{mimetype}", + ] ); + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => [ map "$_\n", split("\n", $opt{body}) ], ); - die $error if $error; + $!=0; + $message->smtpsend( Host => $smtpmachine ) + or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) + or die "can't send email to $opt{to} via $smtpmachine with SMTP: $!"; } =item check_and_rebuild_fuzzyfiles @@ -1363,7 +1364,7 @@ insertion of RADIUS group stuff in insert could be done with child_objects now L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface, export.html from the base documentation, L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>, -L<freeside-queued>), L<FS::svc_acct_pop>, +L<freeside-queued>), L<Net::SSH>, L<ssh>, L<FS::svc_acct_pop>, schema.html from the base documentation. =cut diff --git a/FS/FS/svc_acct_pop.pm b/FS/FS/svc_acct_pop.pm index f98f91a4f..d2247658b 100644 --- a/FS/FS/svc_acct_pop.pm +++ b/FS/FS/svc_acct_pop.pm @@ -93,7 +93,6 @@ sub check { or $self->ut_number('ac') or $self->ut_number('exch') or $self->ut_numbern('loc') - or $self->SUPER::check ; } @@ -188,7 +187,7 @@ END =head1 VERSION -$Id: svc_acct_pop.pm,v 1.10 2003-08-05 00:20:47 khoff Exp $ +$Id: svc_acct_pop.pm,v 1.7.4.2 2003-07-04 01:37:44 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_acct_sm.pm b/FS/FS/svc_acct_sm.pm new file mode 100644 index 000000000..c92f1421f --- /dev/null +++ b/FS/FS/svc_acct_sm.pm @@ -0,0 +1,260 @@ +package FS::svc_acct_sm; + +use strict; +use vars qw( @ISA $nossh_hack $conf $shellmachine @qmailmachines ); +use FS::Record qw( fields qsearch qsearchs ); +use FS::svc_Common; +use FS::cust_svc; +use Net::SSH qw(ssh); +use FS::Conf; +use FS::svc_acct; +use FS::svc_domain; + +@ISA = qw( FS::svc_Common ); + +#ask FS::UID to run this stuff for us later +#$FS::UID::callback{'FS::svc_acct_sm'} = sub { +# $conf = new FS::Conf; +# $shellmachine = $conf->exists('qmailmachines') +# ? $conf->config('shellmachine') +# : ''; +#}; + +=head1 NAME + +FS::svc_acct_sm - Object methods for svc_acct_sm records + +=head1 SYNOPSIS + + use FS::svc_acct_sm; + + $record = new FS::svc_acct_sm \%hash; + $record = new FS::svc_acct_sm { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + + $error = $record->suspend; + + $error = $record->unsuspend; + + $error = $record->cancel; + +=head1 WARNING + +FS::svc_acct_sm is B<depreciated>. This class is only included for migration +purposes. See L<FS::svc_forward>. + +=head1 DESCRIPTION + +An FS::svc_acct_sm object represents a virtual mail alias. FS::svc_acct_sm +inherits from FS::Record. The following fields are currently supported: + +=over 4 + +=item svcnum - primary key (assigned automatcially for new accounts) + +=item domsvc - svcnum of the virtual domain (see L<FS::svc_domain>) + +=item domuid - uid of the target account (see L<FS::svc_acct>) + +=item domuser - virtual username + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new virtual mail alias. To add the virtual mail alias to the +database, see L<"insert">. + +=cut + +sub table { 'svc_acct_sm'; } + +=item insert + +Adds this virtual mail alias to the database. If there is an error, returns +the error, otherwise returns false. + +The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be +defined. An FS::cust_svc record will be created and inserted. + + #If the configuration values (see L<FS::Conf>) shellmachine and qmailmachines + #exist, and domuser is `*' (meaning a catch-all mailbox), the command: + # + # [ -e $dir/.qmail-$qdomain-default ] || { + # touch $dir/.qmail-$qdomain-default; + # chown $uid:$gid $dir/.qmail-$qdomain-default; + # } + # + #is executed on shellmachine via ssh (see L<dot-qmail/"EXTENSION ADDRESSES">). + #This behaviour can be surpressed by setting $FS::svc_acct_sm::nossh_hack true. + +=cut + +sub insert { + my $self = shift; + my $error; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + $error=$self->check; + return $error if $error; + + return "Domain username (domuser) in use for this domain (domsvc)" + if qsearchs('svc_acct_sm',{ 'domuser'=> $self->domuser, + 'domsvc' => $self->domsvc, + } ); + + return "First domain username (domuser) for domain (domsvc) must be " . + qq='*' (catch-all)!= + if $self->domuser ne '*' + && ! qsearch('svc_acct_sm',{ 'domsvc' => $self->domsvc } ) + && ! $conf->exists('maildisablecatchall'); + + $error = $self->SUPER::insert; + return $error if $error; + + #my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } ); + #my $svc_acct = qsearchs( 'svc_acct', { 'uid' => $self->domuid } ); + #my ( $uid, $gid, $dir, $domain ) = ( + # $svc_acct->uid, + # $svc_acct->gid, + # $svc_acct->dir, + # $svc_domain->domain, + #); + #my $qdomain = $domain; + #$qdomain =~ s/\./:/g; #see manpage for 'dot-qmail': EXTENSION ADDRESSES + #ssh("root\@$shellmachine","[ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }") + # if ( ! $nossh_hack && $shellmachine && $dir && $self->domuser eq '*' ); + + ''; #no error + +} + +=item delete + +Deletes this virtual mail alias from the database. If there is an error, +returns the error, otherwise returns false. + +The corresponding FS::cust_svc record will be deleted as well. + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +sub replace { + my ( $new, $old ) = ( shift, shift ); + my $error; + + return "Domain username (domuser) in use for this domain (domsvc)" + if ( $old->domuser ne $new->domuser + || $old->domsvc != $new->domsvc + ) && qsearchs('svc_acct_sm',{ + 'domuser'=> $new->domuser, + 'domsvc' => $new->domsvc, + } ) + ; + + $new->SUPER::replace($old); + +} + +=item suspend + +Just returns false (no error) for now. + +Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>). + +=item unsuspend + +Just returns false (no error) for now. + +Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>). + +=item cancel + +Just returns false (no error) for now. + +Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>). + +=item check + +Checks all fields to make sure this is a valid virtual mail alias. If there is +an error, returns the error, otherwise returns false. Called by the insert and +replace methods. + +Sets any fixed values; see L<FS::part_svc>. + +=cut + +sub check { + my $self = shift; + my $error; + + my $x = $self->setfixed; + return $x unless ref($x); + #my $part_svc = $x; + + my($recref) = $self->hashref; + + $recref->{domuser} =~ /^(\*|[a-z0-9_\-]{2,32})$/ + or return "Illegal domain username (domuser)"; + $recref->{domuser} = $1; + + $recref->{domsvc} =~ /^(\d+)$/ or return "Illegal domsvc"; + $recref->{domsvc} = $1; + my($svc_domain); + return "Unknown domsvc" unless + $svc_domain=qsearchs('svc_domain',{'svcnum'=> $recref->{domsvc} } ); + + $recref->{domuid} =~ /^(\d+)$/ or return "Illegal uid"; + $recref->{domuid} = $1; + my($svc_acct); + return "Unknown uid" unless + $svc_acct=qsearchs('svc_acct',{'uid'=> $recref->{domuid} } ); + + ''; #no error +} + +=back + +=head1 VERSION + +$Id: svc_acct_sm.pm,v 1.5 2001-09-06 20:41:59 ivan Exp $ + +=head1 BUGS + +The remote commands should be configurable. + +The $recref stuff in sub check should be cleaned up. + +=head1 SEE ALSO + +L<FS::svc_forward> + +L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, +L<FS::svc_acct>, L<FS::svc_domain>, L<Net::SSH>, L<ssh>, L<dot-qmail>, +schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/svc_broadband.pm b/FS/FS/svc_broadband.pm deleted file mode 100755 index aaac891e6..000000000 --- a/FS/FS/svc_broadband.pm +++ /dev/null @@ -1,243 +0,0 @@ -package FS::svc_broadband; - -use strict; -use vars qw(@ISA $conf); -use FS::Record qw( qsearchs qsearch dbh ); -use FS::svc_Common; -use FS::cust_svc; -use FS::addr_block; -use NetAddr::IP; - -@ISA = qw( FS::svc_Common ); - -$FS::UID::callback{'FS::svc_broadband'} = sub { - $conf = new FS::Conf; -}; - -=head1 NAME - -FS::svc_broadband - Object methods for svc_broadband records - -=head1 SYNOPSIS - - use FS::svc_broadband; - - $record = new FS::svc_broadband \%hash; - $record = new FS::svc_broadband { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - $error = $record->suspend; - - $error = $record->unsuspend; - - $error = $record->cancel; - -=head1 DESCRIPTION - -An FS::svc_broadband object represents a 'broadband' Internet connection, such -as a DSL, cable modem, or fixed wireless link. These services are assumed to -have the following properties: - -FS::svc_broadband inherits from FS::svc_Common. The following fields are -currently supported: - -=over 4 - -=item svcnum - primary key - -=item blocknum - see FS::addr_block - -=item -speed_up - maximum upload speed, in bits per second. If set to zero, upload -speed will be unlimited. Exports that do traffic shaping should handle this -correctly, and not blindly set the upload speed to zero and kill the customer's -connection. - -=item -speed_down - maximum download speed, as above - -=item ip_addr - the customer's IP address. If the customer needs more than one -IP address, set this to the address of the customer's router. As a result, the -customer's router will have the same address for both its internal and external -interfaces thus saving address space. This has been found to work on most NAT -routers available. - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new svc_broadband. To add the record to the database, see -"insert". - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -sub table { 'svc_broadband'; } - -=item insert [ , OPTION => VALUE ... ] - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -The additional fields pkgnum and svcpart (see FS::cust_svc) should be -defined. An FS::cust_svc record will be created and inserted. - -Currently available options are: I<depend_jobnum> - -If I<depend_jobnum> is set (to a scalar jobnum or an array reference of -jobnums), all provisioning jobs will have a dependancy on the supplied -jobnum(s) (they will not run until the specific job(s) complete(s)). - -=cut - -# Standard FS::svc_Common::insert - -=item delete - -Delete this record from the database. - -=cut - -# Standard FS::svc_Common::delete - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -# Standard FS::svc_Common::replace - -=item suspend - -Called by the suspend method of FS::cust_pkg (see FS::cust_pkg). - -=item unsuspend - -Called by the unsuspend method of FS::cust_pkg (see FS::cust_pkg). - -=item cancel - -Called by the cancel method of FS::cust_pkg (see FS::cust_pkg). - -=item check - -Checks all fields to make sure this is a valid broadband service. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -sub check { - my $self = shift; - my $x = $self->setfixed; - - return $x unless ref($x); - - my $error = - $self->ut_numbern('svcnum') - || $self->ut_foreign_key('blocknum', 'addr_block', 'blocknum') - || $self->ut_number('speed_up') - || $self->ut_number('speed_down') - || $self->ut_ipn('ip_addr') - ; - return $error if $error; - - if($self->speed_up < 0) { return 'speed_up must be positive'; } - if($self->speed_down < 0) { return 'speed_down must be positive'; } - - if (not($self->ip_addr) or $self->ip_addr eq '0.0.0.0') { - my $next_addr = $self->addr_block->next_free_addr; - if ($next_addr) { - $self->ip_addr($next_addr->addr); - } else { - return "No free addresses in addr_block (blocknum: ".$self->blocknum.")"; - } - } - - # This should catch errors in the ip_addr. If it doesn't, - # they'll almost certainly not map into the block anyway. - my $self_addr = $self->NetAddr; #netmask is /32 - return ('Cannot parse address: ' . $self->ip_addr) unless $self_addr; - - my $block_addr = $self->addr_block->NetAddr; - unless ($block_addr->contains($self_addr)) { - return 'blocknum '.$self->blocknum.' does not contain address '.$self->ip_addr; - } - - my $router = $self->addr_block->router - or return 'Cannot assign address from unallocated block:'.$self->addr_block->blocknum; - if(grep { $_->routernum == $router->routernum} $self->allowed_routers) { - } # do nothing - else { - return 'Router '.$router->routernum.' cannot provide svcpart '.$self->svcpart; - } - - $self->SUPER::check; -} - -=item NetAddr - -Returns a NetAddr::IP object containing the IP address of this service. The netmask -is /32. - -=cut - -sub NetAddr { - my $self = shift; - return new NetAddr::IP ($self->ip_addr); -} - -=item addr_block - -Returns the FS::addr_block record (i.e. the address block) for this broadband service. - -=cut - -sub addr_block { - my $self = shift; - - return qsearchs('addr_block', { blocknum => $self->blocknum }); -} - -=back - -=item allowed_routers - -Returns a list of allowed FS::router objects. - -=cut - -sub allowed_routers { - my $self = shift; - - return map { $_->router } qsearch('part_svc_router', { svcpart => $self->svcpart }); -} - -=head1 BUGS - -The business with sb_field has been 'fixed', in a manner of speaking. - -=head1 SEE ALSO - -FS::svc_Common, FS::Record, FS::addr_block, -FS::part_svc, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index b713e3e95..45fcdd24a 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -1,11 +1,13 @@ package FS::svc_domain; use strict; -use vars qw( @ISA $whois_hack $conf +use vars qw( @ISA $whois_hack $conf $smtpmachine @defaultrecords $soadefaultttl $soaemail $soaexpire $soamachine $soarefresh $soaretry ); use Carp; +use Mail::Internet 1.44; +use Mail::Header; use Date::Format; #use Net::Whois::Raw; use FS::Record qw(fields qsearch qsearchs dbh); @@ -24,6 +26,8 @@ use FS::queue; $FS::UID::callback{'FS::domain'} = sub { $conf = new FS::Conf; + $smtpmachine = $conf->config('smtpmachine'); + @defaultrecords = $conf->config('defaultrecords'); $soadefaultttl = $conf->config('soadefaultttl'); $soaemail = $conf->config('soaemail'); @@ -212,6 +216,10 @@ sub delete { return "Can't delete a domain which has accounts!" if qsearch( 'svc_acct', { 'domsvc' => $self->svcnum } ); + return "Can't delete a domain with (svc_acct_sm) mail aliases!" + if defined( $FS::Record::dbdef->table('svc_acct_sm') ) + && qsearch('svc_acct_sm', { 'domsvc' => $self->svcnum } ); + #return "Can't delete a domain with (domain_record) zone entries!" # if qsearch('domain_record', { 'svcnum' => $self->svcnum } ); @@ -256,8 +264,6 @@ sub replace { return "Can't change domain - reorder." if $old->getfield('domain') ne $new->getfield('domain'); - # Better to do it here than to force the caller to remember that svc_domain is weird. - $new->setfield(action => 'M'); my $error = $new->SUPER::replace($old); return $error if $error; } @@ -350,8 +356,7 @@ sub check { return "Unknown catchall" unless $svc_acct; } - $self->ut_textn('purpose') - or $self->SUPER::check; + $self->ut_textn('purpose'); } diff --git a/FS/FS/svc_external.pm b/FS/FS/svc_external.pm deleted file mode 100644 index b97e12b47..000000000 --- a/FS/FS/svc_external.pm +++ /dev/null @@ -1,180 +0,0 @@ -package FS::svc_external; - -use strict; -use vars qw(@ISA); # $conf -use FS::UID; -#use FS::Record qw( qsearch qsearchs dbh); -use FS::svc_Common; - -@ISA = qw( FS::svc_Common ); - -#FS::UID::install_callback( sub { -# $conf = new FS::Conf; -#}; - -=head1 NAME - -FS::svc_external - Object methods for svc_external records - -=head1 SYNOPSIS - - use FS::svc_external; - - $record = new FS::svc_external \%hash; - $record = new FS::svc_external { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - - $error = $record->suspend; - - $error = $record->unsuspend; - - $error = $record->cancel; - -=head1 DESCRIPTION - -An FS::svc_external object represents a externally tracked service. -FS::svc_external inherits from FS::svc_Common. The following fields are -currently supported: - -=over 4 - -=item svcnum - primary key - -=item id - unique number of external record - -=item title - for invoice line items - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new external service. To add the external service to the database, -see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I<hash> method. - -=cut - -sub table { 'svc_external'; } - -=item insert [ , OPTION => VALUE ... ] - -Adds this external service to the database. If there is an error, returns the -error, otherwise returns false. - -The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be -defined. An FS::cust_svc record will be created and inserted. - -Currently available options are: I<depend_jobnum> - -If I<depend_jobnum> is set (to a scalar jobnum or an array reference of -jobnums), all provisioning jobs will have a dependancy on the supplied -jobnum(s) (they will not run until the specific job(s) complete(s)). - -=cut - -#sub insert { -# my $self = shift; -# my $error; -# -# $error = $self->SUPER::insert(@_); -# return $error if $error; -# -# ''; -#} - -=item delete - -Delete this record from the database. - -=cut - -#sub delete { -# my $self = shift; -# my $error; -# -# $error = $self->SUPER::delete; -# return $error if $error; -# -# ''; -#} - - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -#sub replace { -# my ( $new, $old ) = ( shift, shift ); -# my $error; -# -# $error = $new->SUPER::replace($old); -# return $error if $error; -# -# ''; -#} - -=item suspend - -Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>). - -=item unsuspend - -Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>). - -=item cancel - -Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>). - -=item check - -Checks all fields to make sure this is a valid external service. If there is -an error, returns the error, otherwise returns false. Called by the insert -and repalce methods. - -=cut - -sub check { - my $self = shift; - - my $x = $self->setfixed; - return $x unless ref($x); - my $part_svc = $x; - - my $error = - $self->ut_numbern('svcnum') - || $self->ut_number('id') - || $self->ut_textn('title') - ; - - $self->SUPER::check; -} - -=back - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::svc_Common>, L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, -L<FS::cust_pkg>, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/svc_forward.pm b/FS/FS/svc_forward.pm index b8d55fecb..5ec396143 100644 --- a/FS/FS/svc_forward.pm +++ b/FS/FS/svc_forward.pm @@ -47,11 +47,9 @@ inherits from FS::Record. The following fields are currently supported: =item srcsvc - svcnum of the source of the forward (see L<FS::svc_acct>) -=item src - literal source (username or full email address) - =item dstsvc - svcnum of the destination of the forward (see L<FS::svc_acct>) -=item dst - literal destination (username or full email address) +=item dst - foreign destination (email address) - forward not local to freeside =back @@ -222,19 +220,12 @@ sub check { #my $part_svc = $x; my $error = $self->ut_numbern('svcnum') - || $self->ut_numbern('srcsvc') + || $self->ut_number('srcsvc') || $self->ut_numbern('dstsvc') ; return $error if $error; - return "Both srcsvc and src were defined; only one can be specified" - if $self->srcsvc && $self->src; - - return "one of srcsvc or src is required" - unless $self->srcsvc || $self->src; - - return "Unknown srcsvc: ". $self->srcsvc - unless ! $self->srcsvc || $self->srcsvc_acct; + return "Unknown srcsvc" unless $self->srcsvc_acct; return "Both dstsvc and dst were defined; only one can be specified" if $self->dstsvc && $self->dst; @@ -242,35 +233,26 @@ sub check { return "one of dstsvc or dst is required" unless $self->dstsvc || $self->dst; - return "Unknown dstsvc: ". $self->dstsvc - unless ! $self->dstsvc || $self->dstsvc_acct; - #return "Unknown dstsvc" - # unless qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } ) - # || ! $self->dstsvc; + #return "Unknown dstsvc: $dstsvc" unless $self->dstsvc_acct || ! $self->dstsvc; + return "Unknown dstsvc" + unless qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } ) + || ! $self->dstsvc; - if ( $self->src ) { - $self->src =~ /^([\w\.\-\&]*)(\@([\w\-]+\.)+\w+)?$/ - or return "Illegal src: ". $self->dst; - $self->src("$1$2"); - } else { - $self->src(''); - } if ( $self->dst ) { - $self->dst =~ /^([\w\.\-\&]*)(\@([\w\-]+\.)+\w+)?$/ + $self->dst =~ /^([\w\.\-]+)\@(([\w\-]+\.)+\w+)$/ or return "Illegal dst: ". $self->dst; - $self->dst("$1$2"); + $self->dst("$1\@$2"); } else { $self->dst(''); } - $self->SUPER::check; + ''; #no error } =item srcsvc_acct -Returns the FS::svc_acct object referenced by the srcsvc column, or false for -literally specified forwards. +Returns the FS::svc_acct object referenced by the srcsvc column. =cut @@ -282,7 +264,7 @@ sub srcsvc_acct { =item dstsvc_acct Returns the FS::svc_acct object referenced by the srcsvc column, or false for -literally specified forwards. +forwards not local to freeside. =cut diff --git a/FS/FS/svc_www.pm b/FS/FS/svc_www.pm index 6c276a198..2e9ab8522 100644 --- a/FS/FS/svc_www.pm +++ b/FS/FS/svc_www.pm @@ -241,8 +241,7 @@ sub check { return "Unknown usersvc (svc_acct.svcnum): ". $self->usersvc unless qsearchs('svc_acct', { 'svcnum' => $self->usersvc } ); - $self->SUPER::check; - + ''; #no error } =item domain_record diff --git a/FS/FS/type_pkgs.pm b/FS/FS/type_pkgs.pm index 5b3b11c09..99a79b93f 100644 --- a/FS/FS/type_pkgs.pm +++ b/FS/FS/type_pkgs.pm @@ -91,7 +91,7 @@ sub check { return "Unknown pkgpart" unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); - $self->SUPER::check; + ''; #no error } =item part_pkg @@ -111,7 +111,7 @@ sub part_pkg { =head1 VERSION -$Id: type_pkgs.pm,v 1.3 2003-08-05 00:20:48 khoff Exp $ +$Id: type_pkgs.pm,v 1.1.14.1 2002-10-04 12:56:35 ivan Exp $ =head1 BUGS diff --git a/FS/MANIFEST b/FS/MANIFEST index 675429e04..3d12a4051 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -8,13 +8,16 @@ bin/freeside-addoutsourceuser bin/freeside-adduser bin/freeside-apply-credits bin/freeside-bill +bin/freeside-cc-receipts-report bin/freeside-count-active-customers +bin/freeside-credit-report bin/freeside-daily bin/freeside-deloutsource bin/freeside-deloutsourceuser bin/freeside-deluser bin/freeside-email bin/freeside-expiration-alerter +bin/freeside-overdue bin/freeside-queued bin/freeside-radgroup bin/freeside-reexport @@ -35,9 +38,6 @@ FS/Conf.pm FS/ConfItem.pm FS/Misc.pm FS/Record.pm -FS/Report.pm -FS/Report/Table.pm -FS/Report/Table/Monthly.pm FS/SearchCache.pm FS/UI/Base.pm FS/UI/CGI.pm @@ -50,7 +50,6 @@ FS/agent.pm FS/agent_type.pm FS/cust_bill.pm FS/cust_bill_pkg.pm -FS/cust_bill_pkg_detail.pm FS/cust_credit.pm FS/cust_credit_bill.pm FS/cust_main.pm @@ -95,16 +94,12 @@ FS/part_pop_local.pm FS/part_referral.pm FS/part_svc.pm FS/part_svc_column.pm -FS/part_svc_router.pm -FS/part_virtual_field.pm FS/pkg_svc.pm FS/svc_Common.pm FS/svc_acct.pm FS/svc_acct_pop.pm -FS/svc_broadband.pm +FS/svc_acct_sm.pm FS/svc_domain.pm -FS/svc_external.pm -FS/router.pm FS/type_pkgs.pm FS/nas.pm FS/port.pm @@ -129,9 +124,6 @@ t/Conf.t t/ConfItem.t t/Misc.t t/Record.t -t/Report.t -t/Report-Table.t -t/Report-Table-Monthly.t t/UID.t t/Msgcat.t t/SearchCache.t @@ -139,7 +131,6 @@ t/cust_bill.t t/cust_bill_event.t t/cust_bill_pay.t t/cust_bill_pkg.t -t/cust_bill_pkg_detail.t t/cust_credit.t t/cust_credit_bill.t t/cust_credit_refund.t @@ -173,7 +164,6 @@ t/part_export-ldap.t t/part_export-null.t t/part_export-passwdfile.t t/part_export-postfix.t -t/part_export-router.t t/part_export-shellcommands.t t/part_export-shellcommands_withdomain.t t/part_export-sqlmail.t @@ -194,10 +184,9 @@ t/radius_usergroup.t t/session.t t/svc_acct.t t/svc_acct_pop.t -t/svc_broadband.t +t/svc_acct_sm.t t/svc_Common.t t/svc_domain.t -t/svc_external.t t/svc_forward.t t/svc_www.t t/type_pkgs.t diff --git a/FS/bin/freeside-adduser b/FS/bin/freeside-adduser index c3ee05b9b..424123226 100644 --- a/FS/bin/freeside-adduser +++ b/FS/bin/freeside-adduser @@ -1,10 +1,9 @@ #!/usr/bin/perl -w # -# $Id: freeside-adduser,v 1.8 2002-09-27 05:36:29 ivan Exp $ +# $Id: freeside-adduser,v 1.7 2002-08-25 01:16:30 ivan Exp $ use strict; use vars qw($opt_h $opt_b $opt_c $opt_s); -use Fcntl qw(:flock); use Getopt::Std; my $FREESIDE_CONF = "/usr/local/etc/freeside"; @@ -25,8 +24,7 @@ if ( $opt_h ) { my $secretfile = $opt_s || 'secrets'; open(MAPSECRETS,">>$FREESIDE_CONF/mapsecrets") - and flock(MAPSECRETS,LOCK_EX) - or die "can't open $FREESIDE_CONF/mapsecrets: $!"; + or die "can't open $FREESIDE_CONF/mapsecrets: $!"; print MAPSECRETS "$user $secretfile\n"; close MAPSECRETS or die "can't close $FREESIDE_CONF/mapsecrets: $!"; diff --git a/FS/bin/freeside-cc-receipts-report b/FS/bin/freeside-cc-receipts-report new file mode 100755 index 000000000..f4225d28a --- /dev/null +++ b/FS/bin/freeside-cc-receipts-report @@ -0,0 +1,270 @@ +#!/usr/bin/perl -Tw + + +use strict; +use Date::Parse; +use Time::Local; +use Getopt::Std; +use Text::Template; +use Net::SMTP; +use Mail::Header; +use Mail::Internet; +use FS::Conf; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::cust_pay; +use FS::cust_pay_batch; + + +&untaint_argv; #what it sounds like (eww) +use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $opt_s $opt_f $report_lines $report_template @buf $header); +getopts("vpmef:s:"); #switches + +#we're at now now (and later). +my($_finishdate)= $opt_f ? str2time($main::opt_f) : $^T; +my($_startdate)= $opt_s ? str2time($main::opt_s) : $^T; + +# Get the current month +my ($ssec,$smin,$shour,$smday,$smon,$syear) = + (localtime($_startdate) )[0,1,2,3,4,5]; +$smon++; +$syear += 1900; + +# Get the current month +my ($fsec,$fmin,$fhour,$fmday,$fmon,$fyear) = + (localtime($_finishdate) )[0,1,2,3,4,5]; +$fmon++; +$fyear += 1900; + +# Login to the database +my $user = shift or die &usage; +adminsuidsetup $user; + +# Get the needed configuration files +my $conf = new FS::Conf; +my $lpr = $conf->config('lpr'); +my $email = $conf->config('email'); +my $smtpmachine = $conf->config('smtpmachine'); +my $mail_sender = $conf->exists('invoice_from') ? $conf->config('invoice_from') : + 'postmaster'; +my @report_template = $conf->config('report_template') + or die "cannot load config file report_template"; +$report_lines = 0; +foreach ( grep /report_lines\(\d+\)/, @report_template ) { #kludgy :/ + /report_lines\((\d+)\)/; + $report_lines += $1; +} +die "no report_lines() functions in template?" unless $report_lines; +$report_template = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", @report_template ], +) or die "can't create new Text::Template object: $Text::Template::ERROR"; + + +my(@cust_pays)=qsearch('cust_pay',{}); +if (scalar(@cust_pays) == 0) +{ + exit 1; +} + +# Open print and email pipes +# $lpr and opt_p for printing +# $email and opt_m for email + +if ($lpr && $main::opt_p) +{ + open(LPR, "|$lpr"); +} + +if ($email && $main::opt_m) +{ + $ENV{MAILADDRESS} = $mail_sender; + $header = new Mail::Header ( [ + "From: Account Processor", + "To: $email", + "Sender: $mail_sender", + "Reply-To: $mail_sender", + "Subject: Credit Card Receipts", + ] ); +} + +my $uninvoiced = 0; +my $total = 0; +my $taxed = 0; +my $untaxed = 0; +my $total_tax = 0; + +# Now I can start looping +foreach my $cust_pay (@cust_pays) +{ + my $_date = $cust_pay->getfield('_date'); + my $invnum = $cust_pay->getfield('invnum'); + my $paid = $cust_pay->getfield('paid'); + my $payby = $cust_pay->getfield('payby'); + + + if ($_date >= $_startdate && $_date <= $_finishdate && $payby =~ 'CARD') { + $total += $paid; + + $uninvoiced += $cust_pay->unapplied; + my @cust_bill_pays = $cust_pay->cust_bill_pay; + foreach my $cust_bill_pay (@cust_bill_pays) { + my $invoice_amt =0; + my $invoice_tax =0; + my(@cust_bill_pkgs)= $cust_bill_pay->cust_bill->cust_bill_pkg; + foreach my $cust_bill_pkg (@cust_bill_pkgs) { + + my $recur = $cust_bill_pkg->getfield('recur'); + my $setup = $cust_bill_pkg->getfield('setup'); + my $pkgnum = $cust_bill_pkg->getfield('pkgnum'); + + if ($pkgnum == 0) { + $invoice_tax += $recur; + $invoice_tax += $setup; + } else { + $invoice_amt += $recur; + $invoice_amt += $setup; + } + + } + + if ($invoice_tax > 0) { + if ($invoice_amt != $paid) { + # attempt to prorate partially paid invoices + $total_tax += $paid / ($invoice_amt + $invoice_tax) * $invoice_tax; + $taxed += $paid / ($invoice_amt + $invoice_tax) * $invoice_amt; + } else { + $total_tax += $invoice_tax; + $taxed += $invoice_amt; + } + } else { + $untaxed += $paid; + } + + } + + } + +} + +push @buf, sprintf(qq{\n%25s%14.2f\n}, "Uninvoiced", $uninvoiced); +push @buf, sprintf(qq{%25s%14.2f\n}, "Untaxed", $untaxed); +push @buf, sprintf(qq{%25s%14.2f\n}, "Taxed", $taxed); +push @buf, sprintf(qq{%25s%14.2f\n}, "Tax", $total_tax); +push @buf, sprintf(qq{\n%39s\n%39.2f\n}, "=========", $total); + +sub FS::cc_receipts_report::_template::report_lines { + my $lines = shift; + map { + scalar(@buf) ? shift @buf : '' ; + } + ( 1 .. $lines ); +} + +$FS::cc_receipts_report::_template::title = qq~CREDIT CARD RECEIPTS for period $smon/$smday/$syear through $fmon/$fmday/$fyear~; +$FS::cc_receipts_report::_template::title = $opt_t if $opt_t; +$FS::cc_receipts_report::_template::page = 1; +$FS::cc_receipts_report::_template::date = $^T; +$FS::cc_receipts_report::_template::date = $^T; +$FS::cc_receipts_report::_template::fdate = $_finishdate; +$FS::cc_receipts_report::_template::fdate = $_finishdate; +$FS::cc_receipts_report::_template::sdate = $_startdate; +$FS::cc_receipts_report::_template::sdate = $_startdate; +$FS::cc_receipts_report::_template::total_pages = + int( scalar(@buf) / $report_lines); +$FS::cc_receipts_report::_template::total_pages++ if scalar(@buf) % $report_lines; + +my @report; +while (@buf) { + push @report, split("\n", + $report_template->fill_in( PACKAGE => 'FS::cc_receipts_report::_template' ) + ); + $FS::cc_receipts_report::_template::page++; +} + +if ($opt_v) { + print map "$_\n", @report; +} +if($lpr && $opt_p) +{ + print LPR map "$_\n", @report; + print LPR "\f" if $opt_e; + close LPR || die "Could not close printer: $lpr\n"; +} +if($email && $opt_m) +{ + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => [ (@report) ], + ); + $!=0; + $message->smtpsend( Host => "$smtpmachine" ) + or die "can't send report to $email via $smtpmachine: $!"; +} + + +# subroutines +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + $ARGV[$_] =~ /^([\w\-\/ :\.]*)$/ || die "Illegal argument \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-cc-receipts-report [-v] [-p] [-e] user\n"; +} + +=head1 NAME + +freeside-cc-receipts-report - Prints or emails total credit card receipts in a given period. + +=head1 SYNOPSIS + + freeside-cc-receipts-report [-v] [-p] [-m] [-e] [-t "title"] [-s date] [-f date] user + +=head1 DESCRIPTION + +Prints or emails sales taxes invoiced in a given period. + +-v: Verbose - Prints records to STDOUT. + +-p: Print to printer lpr as found in the conf directory. + +-m: Email output to user found in the Conf email file. + +-e: Print a final form feed to the printer. + +-t: supply a title for the top of each page. + +-s: starting date for inclusion + +-f: final date for inclusion + +user: From the mapsecrets file - see config.html from the base documentation + +=head1 VERSION + +$Id: freeside-cc-receipts-report,v 1.4.4.1 2002-09-09 22:57:32 ivan Exp $ + +=head1 BUGS + +Yes..... Use at your own risk. No guarantees or warrantees of any +kind apply to this program. Parts of this program are hacked from +other GNU licensed software created mainly by Ivan Kohler. + +This is released under the GNU Public License. See www.gnu.org +for more information regarding this license. + +=head1 SEE ALSO + +L<FS::cust_main>, config.html from the base documentation + +=head1 AUTHOR + +Jeff Finucane <jeff@cmh.net> + +based on print-batch by Joel Griffiths <griff@aver-computer.com> + +=cut + diff --git a/FS/bin/freeside-credit-report b/FS/bin/freeside-credit-report new file mode 100755 index 000000000..da01d3bd5 --- /dev/null +++ b/FS/bin/freeside-credit-report @@ -0,0 +1,224 @@ +#!/usr/bin/perl -Tw + + +use strict; +use Date::Parse; +use Time::Local; +use Getopt::Std; +use Text::Template; +use Net::SMTP; +use Mail::Header; +use Mail::Internet; +use FS::Conf; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_credit; + + +&untaint_argv; #what it sounds like (eww) +use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $opt_s $opt_f $report_lines $report_template @buf $header); +getopts("vpmef:s:"); #switches + +#we're at now now (and later). +my($_finishdate)= $opt_f ? str2time($main::opt_f) : $^T; +my($_startdate)= $opt_s ? str2time($main::opt_s) : $^T; + +# Get the current month +my ($ssec,$smin,$shour,$smday,$smon,$syear) = + (localtime($_startdate) )[0,1,2,3,4,5]; +$smon++; +$syear += 1900; + +# Get the current month +my ($fsec,$fmin,$fhour,$fmday,$fmon,$fyear) = + (localtime($_finishdate) )[0,1,2,3,4,5]; +$fmon++; +$fyear += 1900; + +# Login to the database +my $user = shift or die &usage; +adminsuidsetup $user; + +# Get the needed configuration files +my $conf = new FS::Conf; +my $lpr = $conf->config('lpr'); +my $email = $conf->config('email'); +my $smtpmachine = $conf->config('smtpmachine'); +my $mail_sender = $conf->exists('invoice_from') ? $conf->config('invoice_from') : + 'postmaster'; +my @report_template = $conf->config('report_template') + or die "cannot load config file report_template"; +$report_lines = 0; +foreach ( grep /report_lines\(\d+\)/, @report_template ) { #kludgy :/ + /report_lines\((\d+)\)/; + $report_lines += $1; +} +die "no report_lines() functions in template?" unless $report_lines; +$report_template = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", @report_template ], +) or die "can't create new Text::Template object: $Text::Template::ERROR"; + + +my(@cust_credits)=qsearch('cust_credit',{}); +if (scalar(@cust_credits) == 0) +{ + exit 1; +} + +# Open print and email pipes +# $lpr and opt_p for printing +# $email and opt_m for email + +if ($lpr && $main::opt_p) +{ + open(LPR, "|$lpr"); +} + +if ($email && $main::opt_m) +{ + $ENV{MAILADDRESS} = $mail_sender; + $header = new Mail::Header ( [ + "From: Account Processor", + "To: $email", + "Sender: $mail_sender", + "Reply-To: $mail_sender", + "Subject: In House Credits", + ] ); +} + +my $uninvoiced = 0; +my $total = 0; +my $taxed = 0; +my $untaxed = 0; +my $total_tax = 0; + +# Now I can start looping +foreach my $cust_credit (@cust_credits) +{ + my $_date = $cust_credit->getfield('_date'); + my $amount = $cust_credit->getfield('amount'); + + if ($_date >= $_startdate && $_date <= $_finishdate) { + $total += $amount; + } +} + +push @buf, sprintf(qq{\n%25s%14.2f\n}, "Credits Offered", $total); +push @buf, sprintf(qq{\n%39s\n%39.2f\n}, "=========", $total); + +sub FS::credit_report::_template::report_lines { + my $lines = shift; + map { + scalar(@buf) ? shift @buf : '' ; + } + ( 1 .. $lines ); +} + +$FS::credit_report::_template::title = qq~IN HOUSE CREDITS for $smon/$smday/$syear through $fmon/$fmday/$fyear~; +$FS::credit_report::_template::title = $opt_t if $opt_t; +$FS::credit_report::_template::page = 1; +$FS::credit_report::_template::date = $^T; +$FS::credit_report::_template::date = $^T; +$FS::credit_report::_template::fdate = $_finishdate; +$FS::credit_report::_template::fdate = $_finishdate; +$FS::credit_report::_template::sdate = $_startdate; +$FS::credit_report::_template::sdate = $_startdate; +$FS::credit_report::_template::total_pages = + int( scalar(@buf) / $report_lines); +$FS::credit_report::_template::total_pages++ if scalar(@buf) % $report_lines; + +my @report; +while (@buf) { + push @report, split("\n", + $report_template->fill_in( PACKAGE => 'FS::credit_report::_template' ) + ); + $FS::credit_report::_template::page++; +} + +if ($opt_v) { + print map "$_\n", @report; +} +if($lpr && $opt_p) +{ + print LPR map "$_\n", @report; + print LPR "\f" if $opt_e; + close LPR || die "Could not close printer: $lpr\n"; +} +if($email && $opt_m) +{ + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => [ (@report) ], + ); + $!=0; + $message->smtpsend( Host => "$smtpmachine" ) + or die "can't send report to $email via $smtpmachine: $!"; +} + + +# subroutines +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + $ARGV[$_] =~ /^([\w\-\/ :\.]*)$/ || die "Illegal argument \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-credit-report [-v] [-p] [-e] user\n"; +} + +=head1 NAME + +freeside-credit-report - Prints or emails total credit memos in a given period. + +=head1 SYNOPSIS + + freeside-credit-report [-v] [-p] [-m] [-e] [-t "title"] [-s date] [-f date] user + +=head1 DESCRIPTION + +Prints or emails total credit memos in a given period. + +-v: Verbose - Prints records to STDOUT. + +-p: Print to printer lpr as found in the conf directory. + +-m: Email output to user found in the Conf email file. + +-e: Print a final form feed to the printer. + +-t: supply a title for the top of each page. + +-s: starting date for inclusion + +-f: final date for inclusion + +user: From the mapsecrets file - see config.html from the base documentation + +=head1 VERSION + +$Id: freeside-credit-report,v 1.4.4.1 2002-09-09 22:57:32 ivan Exp $ + +=head1 BUGS + +Yes..... Use at your own risk. No guarantees or warrantees of any +kind apply to this program. Parts of this program are hacked from +other GNU licensed software created mainly by Ivan Kohler. + +This is released under the GNU Public License. See www.gnu.org +for more information regarding this license. + +=head1 SEE ALSO + +L<FS::cust_main>, config.html from the base documentation + +=head1 AUTHOR + +Jeff Finucane <jeff@cmh.net> + +based on print-batch by Joel Griffiths <griff@aver-computer.com> + +=cut + diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index 00de2987a..bbb074ffd 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -120,7 +120,7 @@ the bill and collect methods of a cust_main object. See L<FS::cust_main>. "pretend date" 15 days from whatever was specified by the -d switch (or now, if no -d switch was given). - -p: Only process customers with the specified payby (I<CARD>, I<DCRD>, I<CHEK>, I<DCHK>, I<BILL>, I<COMP>, I<LECB>) + -p: Only process customers with the specified payby (I<CARD>, I<CHEK>, I<BILL>, I<COMP>, I<LECB>) -s: re-charge setup fees diff --git a/FS/bin/freeside-email b/FS/bin/freeside-email index 400dc2ac7..c7ff41114 100755 --- a/FS/bin/freeside-email +++ b/FS/bin/freeside-email @@ -12,9 +12,11 @@ my $user = shift or die &usage; adminsuidsetup $user; my $conf = new FS::Conf; +my $domain = $conf->config('domain'); my @svc_acct = qsearch('svc_acct', {}); -my @emails = map $_->email, @svc_acct; +my @usernames = map $_->username, @svc_acct; +my @emails = map "$_\@$domain", @usernames; print join("\n", @emails), "\n"; @@ -49,7 +51,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-email,v 1.2 2002-09-18 22:50:44 ivan Exp $ +$Id: freeside-email,v 1.1 2001-05-15 07:52:34 ivan Exp $ =head1 BUGS diff --git a/FS/bin/freeside-expiration-alerter b/FS/bin/freeside-expiration-alerter index 691fd3aa5..2c89bef20 100755 --- a/FS/bin/freeside-expiration-alerter +++ b/FS/bin/freeside-expiration-alerter @@ -97,7 +97,7 @@ foreach my $customer (@customers) my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear); #credit cards expire at the end of the month/year of their exp date - if ($payby eq 'CARD' || $payby eq 'DCRD') { + if ($payby eq 'CARD') { ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++); $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear); $expire_time--; @@ -127,7 +127,7 @@ foreach my $customer (@customers) $FS::alerter::_template::first = $first; $FS::alerter::_template::last = $last; $FS::alerter::_template::company = $company; - if ($payby eq 'CARD' || $payby eq 'DCRD') { + if ($payby eq 'CARD') { $FS::alerter::_template::payby = "credit card (" . substr($payinfo, 0, 2) . "xxxxxxxxxx" . substr($payinfo, -4) . ")"; @@ -202,7 +202,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-expiration-alerter,v 1.5 2003-04-21 20:53:57 ivan Exp $ +$Id: freeside-expiration-alerter,v 1.3.4.1 2002-09-16 09:27:12 ivan Exp $ =head1 BUGS diff --git a/FS/bin/freeside-overdue b/FS/bin/freeside-overdue new file mode 100755 index 000000000..116245f9c --- /dev/null +++ b/FS/bin/freeside-overdue @@ -0,0 +1,196 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw( $days_to_pay $cust_main $cust_pkg + $cust_svc $svc_acct ); +use Getopt::Std; +use FS::cust_main; +use FS::cust_pkg; +use FS::cust_svc; +use FS::svc_acct; +use FS::Record qw(qsearch qsearchs); +use FS::UID qw(adminsuidsetup); + +&untaint_argv; +my %opt; +getopts('ed:qpl:scbyoi', \%opt); +my $user = shift or die &usage; + +adminsuidsetup $user; + +my $now = time; #eventually take a time option like freeside-bill +my ($sec,$min,$hour,$mday,$mon,$year) = + (localtime($now) )[0,1,2,3,4,5]; +$mon++; +$year += 1900; + +foreach $cust_main ( qsearch('cust_main',{} ) ) { + + my ( $eyear, $emon, $eday ) = ( 2037, 12, 31 ); + if ( $cust_main->paydate =~ /^(\d{4})\-(\d{1,2})\-(\d{1,2})$/ + && $cust_main->payby eq 'BILL') { + ( $eyear, $emon, $eday ) = ( $1, $2, $3 ); + } + + if ( ( $opt{d} + && $cust_main->balance_date(time - $opt{d} * 86400) > 0 + && qsearchs( 'cust_pkg', { 'custnum' => $cust_main->custnum, + 'susp' => "" } ) ) + || ( $opt{e} + && $cust_main->payby eq 'BILL' + && ( $eyear < $year + || ( $eyear == $year && $emon < $mon ) ) ) + ) { + + unless ( $opt{q} ) { + print $cust_main->custnum, "\t", + $cust_main->last, "\t", $cust_main->first, "\t", + $cust_main->balance_date(time-$opt{d} * 86400); + } + + if ( $opt{p} && ! grep { $_ eq 'POST' } $cust_main->invoicing_list ) { + print "\n\tAdding postal invoicing" unless $opt{q}; + my @invoicing_list = $cust_main->invoicing_list; + push @invoicing_list, 'POST'; + $cust_main->invoicing_list(\@invoicing_list); + } + + if ( $opt{l} ) { + print "\n\tCharging late fee of \$$opt{l}" unless $opt{q}; + my $error = $cust_main->charge($opt{l}, 'Late fee'); + # comment or plandata with info so we don't redo the same late fee every + # day + } + + foreach $cust_pkg ( qsearch( 'cust_pkg', + { 'custnum' => $cust_main->custnum } ) ) { + + if ($opt{s}) { + print "\n\tSuspending pkgnum " . $cust_pkg->pkgnum unless $opt{q}; + $cust_pkg->suspend; + } + + if ($opt{c}) { + print "\n\tCancelling pkgnum " . $cust_pkg->pkgnum unless $opt{q}; + $cust_pkg->cancel; + } + + } + + if ( $opt{b} ) { + print "\n\tBilling" unless $opt{q}; + my $error = $cust_main->bill('time'=>$now); + warn "Error billing, customer #" . $cust_main->custnum . + ":" . $error if $error; + } + + if ( $opt{y} ) { + print "\n\tApplying outstanding payments and credits" unless $opt{q}; + $cust_main->apply_payments; + $cust_main->apply_credits; + } + + if ( $opt{o} ) { + print "\n\tCollecting" unless $opt{q}; + my $error = $cust_main->collect( + 'invoice_time' => $now, + 'batch_card' => $opt{i} ? 'no' : 'yes', + 'force_print' => 'yes', + ); + warn "Error collecting from customer #" . $cust_main->custnum. ":$error" + if $error; + } + + print "\n" unless $opt{q}; + + } + +} + +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { + $ARGV[$_] =~ /^([\w\-\/\.]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-overdue [ -e ] [ -d days ] [ -q ] [ -p ] [ -l amount ] [ -s ] [ -c ] [ -b ] [ -y ] [ -o [ -i ] ] user\n"; +} + + +=head1 NAME + +freeside-overdue - Perform actions on overdue and/or expired accounts. + +=head1 SYNOPSIS + + freeside-overdue [ -e ] [ -d days ] [ -q ] [ -p ] [ -l amount ] [ -s ] [ -c ] [ -b ] [ -y ] [ -o [ -i ] ] user + +=head1 DESCRIPTION + +This script is deprecated in 1.4.0. You should use freeside-daily and invoice +events instead. + +Performs actions on overdue and/or expired accounts. + +Selection options (at least one selection option is required): + + -d: Customers with a balance due on invoices older than the supplied number + of days. Requires an integer argument. + + -e: Customers with a billing expiration date in the past. + +Action options: + + -q: Be quiet (by default, selected accounts are printed). + + -p: Add postal invoicing to the relevant customers. + + -l: Add a charge of the given amount to the relevant customers. + + -s: Suspend accounts. + + -c: Cancel accounts. + + -b: Bill customers (create invoices) + + -y: Apply unapplied payments and credits + + -o: Collect from customers (charge cards, print invoices) + + -i: real-time billing (as opposed to batch billing). only relevant + for credit cards. + + user: From the mapsecrets file - see config.html from the base documentation + +=head1 CRONTAB + +Example crontab entries: + +# suspend expired accounts +20 4 * * * freeside-overdue -e -s user + +# quietly add postal invoicing to customers over 30 days past due +20 4 * * * freeside-overdue -d 30 -p -q user + +# suspend accounts and charge a $10.23 fee for customers over 60 days past due +20 4 * * * freeside-overdue -d 60 -s -l 10.23 user + +# cancel accounts over 90 days past due +20 4 * * * freeside-overdue -d 90 -c user + +=head1 ORIGINAL AUTHORS + +Original disable-overdue version by mw/kwh: Mark W.? and Kristian Hoffmann ? + +Ivan seems to be turning it into the "do-everything" CLI. + +=head1 BUGS + +Hell now that this is the do-everything CLI it should have --longoptions + +=cut + +1; + diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index 522c0a1a2..65e67b5a7 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -9,7 +9,7 @@ use Getopt::Std; use Locale::Country; use Locale::SubCountry; use DBI; -use DBIx::DBSchema 0.21; +use DBIx::DBSchema 0.20; use DBIx::DBSchema::Table; use DBIx::DBSchema::Column; use DBIx::DBSchema::ColGroup::Unique; @@ -113,9 +113,8 @@ my($dbdef) = new DBIx::DBSchema ( map { my $cust_main = $dbdef->table('cust_main'); unless ($ship) { #remove ship_ from cust_main $cust_main->delcolumn($_) foreach ( grep /^ship_/, $cust_main->columns ); -} else { #add indices - push @{$cust_main->index->lol_ref}, - map { [ "ship_$_" ] } qw( last company daytime night fax ); +} else { #add indices on ship_last and ship_company + push @{$cust_main->index->lol_ref}, ( ['ship_last'], ['ship_company'] ) } #add radius attributes to svc_acct @@ -141,6 +140,33 @@ foreach $attribute (@check_attributes) { )); } +##make part_svc table (but now as object) +# +#my($part_svc)=$dbdef->table('part_svc'); +# +##because of svc_acct_pop +##foreach (grep /^svc_/, $dbdef->tables) { +##foreach (qw(svc_acct svc_acct_sm svc_charge svc_domain svc_wo)) { +#foreach (qw(svc_acct svc_domain svc_forward svc_www)) { +# my($table)=$dbdef->table($_); +# my($col); +# foreach $col ( $table->columns ) { +# next if $col =~ /^svcnum$/; +# $part_svc->addcolumn( new DBIx::DBSchema::Column ( +# $table->name. '__' . $table->column($col)->name, +# 'varchar', #$table->column($col)->type, +# 'NULL', +# $char_d, #$table->column($col)->length, +# )); +# $part_svc->addcolumn ( new DBIx::DBSchema::Column ( +# $table->name. '__'. $table->column($col)->name . "_flag", +# 'char', +# 'NULL', +# 1, +# )); +# } +#} + #create history tables (false laziness w/create-history-tables) foreach my $table ( grep { ! /^h_/ } $dbdef->tables ) { my $tableobj = $dbdef->table($table) @@ -192,23 +218,7 @@ foreach my $table ( grep { ! /^h_/ } $dbdef->tables ) { 'default' => '', 'local' => '', } ), - map { - my $column = $tableobj->column($_); - - #clone so as to not disturb the original - $column = DBIx::DBSchema::Column->new( { - map { $_ => $column->$_() } - qw( name type null length default local ) - } ); - - $column->type('int') - if $column->type eq 'serial'; - #$column->default('') - # if $column->default =~ /^nextval\(/i; - #( my $local = $column->local ) =~ s/AUTO_INCREMENT//i; - #$column->local($local); - $column; - } $tableobj->columns + map { $tableobj->column($_) } $tableobj->columns ], } ); $dbdef->addtable($h_tableobj); @@ -273,8 +283,6 @@ foreach my $aref ( [ 'COMP', 'Comp invoice', '$cust_bill->comp();', 30, 'comp' ], [ 'CARD', 'Batch card', '$cust_bill->batch_card();', 40, 'batch-card' ], [ 'BILL', 'Send invoice', '$cust_bill->send();', 50, 'send' ], - [ 'DCRD', 'Send invoice', '$cust_bill->send();', 50, 'send' ], - [ 'DCHK', 'Send invoice', '$cust_bill->send();', 50, 'send' ], ) { my $part_bill_event = new FS::part_bill_event({ @@ -313,23 +321,20 @@ sub tables_hash_hack { 'agent' => { 'columns' => [ - 'agentnum', 'serial', '', '', + 'agentnum', 'int', '', '', 'agent', 'varchar', '', $char_d, 'typenum', 'int', '', '', 'freq', 'int', 'NULL', '', 'prog', @perl_type, - 'disabled', 'char', 'NULL', 1, - 'username', 'varchar', 'NULL', $char_d, - '_password','varchar', 'NULL', $char_d, ], 'primary_key' => 'agentnum', 'unique' => [], - 'index' => [ ['typenum'], ['disabled'] ], + 'index' => [ ['typenum'] ], }, 'agent_type' => { 'columns' => [ - 'typenum', 'serial', '', '', + 'typenum', 'int', '', '', 'atype', 'varchar', '', $char_d, ], 'primary_key' => 'typenum', @@ -349,7 +354,7 @@ sub tables_hash_hack { 'cust_bill' => { 'columns' => [ - 'invnum', 'serial', '', '', + 'invnum', 'int', '', '', 'custnum', 'int', '', '', '_date', @date_type, 'charged', @money_type, @@ -363,7 +368,7 @@ sub tables_hash_hack { 'cust_bill_event' => { 'columns' => [ - 'eventnum', 'serial', '', '', + 'eventnum', 'int', '', '', 'invnum', 'int', '', '', 'eventpart', 'int', '', '', '_date', @date_type, @@ -378,7 +383,7 @@ sub tables_hash_hack { 'part_bill_event' => { 'columns' => [ - 'eventpart', 'serial', '', '', + 'eventpart', 'int', '', '', 'payby', 'char', '', 4, 'event', 'varchar', '', $char_d, 'eventcode', @perl_type, @@ -390,7 +395,7 @@ sub tables_hash_hack { ], 'primary_key' => 'eventpart', 'unique' => [], - 'index' => [ ['payby'], ['disabled'], ], + 'index' => [ ['payby'] ], }, 'cust_bill_pkg' => { @@ -401,28 +406,15 @@ sub tables_hash_hack { 'recur', @money_type, 'sdate', @date_type, 'edate', @date_type, - 'itemdesc', 'varchar', 'NULL', $char_d, ], 'primary_key' => '', - 'unique' => [], + 'unique' => [ ['pkgnum', 'invnum'] ], 'index' => [ ['invnum'] ], }, - 'cust_bill_pkg_detail' => { - 'columns' => [ - 'detailnum', 'serial', '', '', - 'pkgnum', 'int', '', '', - 'invnum', 'int', '', '', - 'detail', 'varchar', '', $char_d, - ], - 'primary_key' => 'detailnum', - 'unique' => [], - 'index' => [ [ 'pkgnum', 'invnum' ] ], - }, - 'cust_credit' => { 'columns' => [ - 'crednum', 'serial', '', '', + 'crednum', 'int', '', '', 'custnum', 'int', '', '', '_date', @date_type, 'amount', @money_type, @@ -437,7 +429,7 @@ sub tables_hash_hack { 'cust_credit_bill' => { 'columns' => [ - 'creditbillnum', 'serial', '', '', + 'creditbillnum', 'int', '', '', 'crednum', 'int', '', '', 'invnum', 'int', '', '', '_date', @date_type, @@ -450,7 +442,7 @@ sub tables_hash_hack { 'cust_main' => { 'columns' => [ - 'custnum', 'serial', '', '', + 'custnum', 'int', '', '', 'agentnum', 'int', '', '', # 'titlenum', 'int', 'NULL', '', 'last', 'varchar', '', $char_d, @@ -484,12 +476,11 @@ sub tables_hash_hack { 'ship_fax', 'varchar', 'NULL', 12, 'payby', 'char', '', 4, 'payinfo', 'varchar', 'NULL', $char_d, - 'paycvv', 'varchar', 'NULL', 4, #'paydate', @date_type, 'paydate', 'varchar', 'NULL', 10, 'payname', 'varchar', 'NULL', $char_d, 'tax', 'char', 'NULL', 1, - 'otaker', 'varchar', '', 32, + 'otaker', 'varchar', '', 32, 'refnum', 'int', '', '', 'referral_custnum', 'int', 'NULL', '', 'comments', 'text', 'NULL', '', @@ -497,14 +488,12 @@ sub tables_hash_hack { 'primary_key' => 'custnum', 'unique' => [], #'index' => [ ['last'], ['company'] ], - 'index' => [ ['last'], [ 'company' ], [ 'referral_custnum' ], - [ 'daytime' ], [ 'night' ], [ 'fax' ], - ], + 'index' => [ ['last'], [ 'company' ], [ 'referral_custnum' ] ], }, 'cust_main_invoice' => { 'columns' => [ - 'destnum', 'serial', '', '', + 'destnum', 'int', '', '', 'custnum', 'int', '', '', 'dest', 'varchar', '', $char_d, ], @@ -517,16 +506,13 @@ sub tables_hash_hack { #cust_main_county for validation and to provide # a tax rate. 'columns' => [ - 'taxnum', 'serial', '', '', + 'taxnum', 'int', '', '', 'state', 'varchar', 'NULL', $char_d, 'county', 'varchar', 'NULL', $char_d, 'country', 'char', '', 2, 'taxclass', 'varchar', 'NULL', $char_d, 'exempt_amount', @money_type, 'tax', 'real', '', '', #tax % - 'taxname', 'varchar', 'NULL', $char_d, - 'setuptax', 'char', 'NULL', 1, # Y = setup tax exempt - 'recurtax', 'char', 'NULL', 1, # Y = recur tax exempt ], 'primary_key' => 'taxnum', 'unique' => [], @@ -536,7 +522,7 @@ sub tables_hash_hack { 'cust_pay' => { 'columns' => [ - 'paynum', 'serial', '', '', + 'paynum', 'int', '', '', #now cust_bill_pay #'invnum', 'int', '', '', 'custnum', 'int', '', '', 'paid', @money_type, @@ -549,12 +535,12 @@ sub tables_hash_hack { ], 'primary_key' => 'paynum', 'unique' => [], - 'index' => [ [ 'custnum' ], [ 'paybatch' ], [ 'payby' ], [ '_date' ] ], + 'index' => [ [ 'custnum' ], [ 'paybatch' ] ], }, 'cust_bill_pay' => { 'columns' => [ - 'billpaynum', 'serial', '', '', + 'billpaynum', 'int', '', '', 'invnum', 'int', '', '', 'paynum', 'int', '', '', 'amount', @money_type, @@ -568,7 +554,7 @@ sub tables_hash_hack { 'cust_pay_batch' => { #what's this used for again? list of customers #in current CARD batch? (necessarily CARD?) 'columns' => [ - 'paybatchnum', 'serial', '', '', + 'paybatchnum', 'int', '', '', 'invnum', 'int', '', '', 'custnum', 'int', '', '', 'last', 'varchar', '', $char_d, @@ -593,13 +579,12 @@ sub tables_hash_hack { 'cust_pkg' => { 'columns' => [ - 'pkgnum', 'serial', '', '', + 'pkgnum', 'int', '', '', 'custnum', 'int', '', '', 'pkgpart', 'int', '', '', 'otaker', 'varchar', '', 32, 'setup', @date_type, 'bill', @date_type, - 'last_bill', @date_type, 'susp', @date_type, 'cancel', @date_type, 'expire', @date_type, @@ -612,7 +597,7 @@ sub tables_hash_hack { 'cust_refund' => { 'columns' => [ - 'refundnum', 'serial', '', '', + 'refundnum', 'int', '', '', #now cust_credit_refund #'crednum', 'int', '', '', 'custnum', 'int', '', '', '_date', @date_type, @@ -632,7 +617,7 @@ sub tables_hash_hack { 'cust_credit_refund' => { 'columns' => [ - 'creditrefundnum', 'serial', '', '', + 'creditrefundnum', 'int', '', '', 'crednum', 'int', '', '', 'refundnum', 'int', '', '', 'amount', @money_type, @@ -646,7 +631,7 @@ sub tables_hash_hack { 'cust_svc' => { 'columns' => [ - 'svcnum', 'serial', '', '', + 'svcnum', 'int', '', '', 'pkgnum', 'int', 'NULL', '', 'svcpart', 'int', '', '', ], @@ -657,11 +642,11 @@ sub tables_hash_hack { 'part_pkg' => { 'columns' => [ - 'pkgpart', 'serial', '', '', + 'pkgpart', 'int', '', '', 'pkg', 'varchar', '', $char_d, 'comment', 'varchar', '', $char_d, 'setup', @perl_type, - 'freq', 'varchar', '', $char_d, #billing frequency + 'freq', 'int', '', '', #billing frequency (months) 'recur', @perl_type, 'setuptax', 'char', 'NULL', 1, 'recurtax', 'char', 'NULL', 1, @@ -690,7 +675,6 @@ sub tables_hash_hack { 'pkgpart', 'int', '', '', 'svcpart', 'int', '', '', 'quantity', 'int', '', '', - 'primary_svc','char', 'NULL', 1, ], 'primary_key' => '', 'unique' => [ ['pkgpart', 'svcpart'] ], @@ -699,18 +683,17 @@ sub tables_hash_hack { 'part_referral' => { 'columns' => [ - 'refnum', 'serial', '', '', + 'refnum', 'int', '', '', 'referral', 'varchar', '', $char_d, - 'disabled', 'char', 'NULL', 1, ], 'primary_key' => 'refnum', 'unique' => [], - 'index' => [ ['disabled'] ], + 'index' => [], }, 'part_svc' => { 'columns' => [ - 'svcpart', 'serial', '', '', + 'svcpart', 'int', '', '', 'svc', 'varchar', '', $char_d, 'svcdb', 'varchar', '', $char_d, 'disabled', 'char', 'NULL', 1, @@ -722,7 +705,7 @@ sub tables_hash_hack { 'part_svc_column' => { 'columns' => [ - 'columnnum', 'serial', '', '', + 'columnnum', 'int', '', '', 'svcpart', 'int', '', '', 'columnname', 'varchar', '', 64, 'columnvalue', 'varchar', 'NULL', $char_d, @@ -736,7 +719,7 @@ sub tables_hash_hack { #(this should be renamed to part_pop) 'svc_acct_pop' => { 'columns' => [ - 'popnum', 'serial', '', '', + 'popnum', 'int', '', '', 'city', 'varchar', '', $char_d, 'state', 'varchar', '', $char_d, 'ac', 'char', '', 3, @@ -750,7 +733,7 @@ sub tables_hash_hack { 'part_pop_local' => { 'columns' => [ - 'localnum', 'serial', '', '', + 'localnum', 'int', '', '', 'popnum', 'int', '', '', 'city', 'varchar', 'NULL', $char_d, 'state', 'char', 'NULL', 2, @@ -785,6 +768,18 @@ sub tables_hash_hack { 'index' => [ ['username'], ['domsvc'] ], }, +# 'svc_acct_sm' => { +# 'columns' => [ +# 'svcnum', 'int', '', '', +# 'domsvc', 'int', '', '', +# 'domuid', 'int', '', '', +# 'domuser', 'varchar', '', $char_d, +# ], +# 'primary_key' => 'svcnum', +# 'unique' => [ [] ], +# 'index' => [ ['domsvc'], ['domuid'] ], +# }, + #'svc_charge' => { # 'columns' => [ # 'svcnum', 'int', '', '', @@ -808,13 +803,11 @@ sub tables_hash_hack { 'domain_record' => { 'columns' => [ - 'recnum', 'serial', '', '', + 'recnum', 'int', '', '', 'svcnum', 'int', '', '', - #'reczone', 'varchar', '', $char_d, 'reczone', 'varchar', '', 255, 'recaf', 'char', '', 2, - 'rectype', 'varchar', '', 5, - #'recdata', 'varchar', '', $char_d, + 'rectype', 'varchar', '', 5, 'recdata', 'varchar', '', 255, ], 'primary_key' => 'recnum', @@ -824,11 +817,10 @@ sub tables_hash_hack { 'svc_forward' => { 'columns' => [ - 'svcnum', 'int', '', '', - 'srcsvc', 'int', 'NULL', '', - 'src', 'varchar', 'NULL', 255, - 'dstsvc', 'int', 'NULL', '', - 'dst', 'varchar', 'NULL', 255, + 'svcnum', 'int', '', '', + 'srcsvc', 'int', '', '', + 'dstsvc', 'int', '', '', + 'dst', 'varchar', 'NULL', $char_d, ], 'primary_key' => 'svcnum', 'unique' => [], @@ -861,7 +853,7 @@ sub tables_hash_hack { 'prepay_credit' => { 'columns' => [ - 'prepaynum', 'serial', '', '', + 'prepaynum', 'int', '', '', 'identifier', 'varchar', '', $char_d, 'amount', @money_type, 'seconds', 'int', 'NULL', '', @@ -873,7 +865,7 @@ sub tables_hash_hack { 'port' => { 'columns' => [ - 'portnum', 'serial', '', '', + 'portnum', 'int', '', '', 'ip', 'varchar', 'NULL', 15, 'nasport', 'int', 'NULL', '', 'nasnum', 'int', '', '', @@ -885,7 +877,7 @@ sub tables_hash_hack { 'nas' => { 'columns' => [ - 'nasnum', 'serial', '', '', + 'nasnum', 'int', '', '', 'nas', 'varchar', '', $char_d, 'nasip', 'varchar', '', 15, 'nasfqdn', 'varchar', '', $char_d, @@ -898,7 +890,7 @@ sub tables_hash_hack { 'session' => { 'columns' => [ - 'sessionnum', 'serial', '', '', + 'sessionnum', 'int', '', '', 'portnum', 'int', '', '', 'svcnum', 'int', '', '', 'login', @date_type, @@ -911,7 +903,7 @@ sub tables_hash_hack { 'queue' => { 'columns' => [ - 'jobnum', 'serial', '', '', + 'jobnum', 'int', '', '', 'job', 'text', '', '', '_date', 'int', '', '', 'status', 'varchar', '', $char_d, @@ -925,7 +917,7 @@ sub tables_hash_hack { 'queue_arg' => { 'columns' => [ - 'argnum', 'serial', '', '', + 'argnum', 'int', '', '', 'jobnum', 'int', '', '', 'arg', 'text', 'NULL', '', ], @@ -936,7 +928,7 @@ sub tables_hash_hack { 'queue_depend' => { 'columns' => [ - 'dependnum', 'serial', '', '', + 'dependnum', 'int', '', '', 'jobnum', 'int', '', '', 'depend_jobnum', 'int', '', '', ], @@ -947,7 +939,7 @@ sub tables_hash_hack { 'export_svc' => { 'columns' => [ - 'exportsvcnum' => 'serial', '', '', + 'exportsvcnum' => 'int', '', '', 'exportnum' => 'int', '', '', 'svcpart' => 'int', '', '', ], @@ -958,7 +950,7 @@ sub tables_hash_hack { 'part_export' => { 'columns' => [ - 'exportnum', 'serial', '', '', + 'exportnum', 'int', '', '', #'svcpart', 'int', '', '', 'machine', 'varchar', '', $char_d, 'exporttype', 'varchar', '', $char_d, @@ -971,7 +963,7 @@ sub tables_hash_hack { 'part_export_option' => { 'columns' => [ - 'optionnum', 'serial', '', '', + 'optionnum', 'int', '', '', 'exportnum', 'int', '', '', 'optionname', 'varchar', '', $char_d, 'optionvalue', 'text', 'NULL', '', @@ -983,7 +975,7 @@ sub tables_hash_hack { 'radius_usergroup' => { 'columns' => [ - 'usergroupnum', 'serial', '', '', + 'usergroupnum', 'int', '', '', 'svcnum', 'int', '', '', 'groupname', 'varchar', '', $char_d, ], @@ -994,7 +986,7 @@ sub tables_hash_hack { 'msgcat' => { 'columns' => [ - 'msgnum', 'serial', '', '', + 'msgnum', 'int', '', '', 'msgcode', 'varchar', '', $char_d, 'locale', 'varchar', '', 16, 'msg', 'text', '', '', @@ -1006,7 +998,7 @@ sub tables_hash_hack { 'cust_tax_exempt' => { 'columns' => [ - 'exemptnum', 'serial', '', '', + 'exemptnum', 'int', '', '', 'custnum', 'int', '', '', 'taxnum', 'int', '', '', 'year', 'int', '', '', @@ -1018,102 +1010,7 @@ sub tables_hash_hack { 'index' => [], }, - 'router' => { - 'columns' => [ - 'routernum', 'serial', '', '', - 'routername', 'varchar', '', $char_d, - 'svcnum', 'int', 'NULL', '', - ], - 'primary_key' => 'routernum', - 'unique' => [], - 'index' => [], - }, - - 'part_svc_router' => { - 'columns' => [ - 'svcpart', 'int', '', '', - 'routernum', 'int', '', '', - ], - 'primary_key' => '', - 'unique' => [], - 'index' => [], - }, - - 'addr_block' => { - 'columns' => [ - 'blocknum', 'serial', '', '', - 'routernum', 'int', '', '', - 'ip_gateway', 'varchar', '', 15, - 'ip_netmask', 'int', '', '', - ], - 'primary_key' => 'blocknum', - 'unique' => [ [ 'blocknum', 'routernum' ] ], - 'index' => [], - }, - - 'svc_broadband' => { - 'columns' => [ - 'svcnum', 'int', '', '', - 'blocknum', 'int', '', '', - 'speed_up', 'int', '', '', - 'speed_down', 'int', '', '', - 'ip_addr', 'varchar', '', 15, - ], - 'primary_key' => 'svcnum', - 'unique' => [], - 'index' => [], - }, - 'part_virtual_field' => { - 'columns' => [ - 'vfieldpart', 'int', '', '', - 'dbtable', 'varchar', '', 32, - 'name', 'varchar', '', 32, - 'check_block', 'text', 'NULL', '', - 'length', 'int', 'NULL', '', - 'list_source', 'text', 'NULL', '', - 'label', 'varchar', 'NULL', 80, - ], - 'primary_key' => 'vfieldpart', - 'unique' => [], - 'index' => [], - }, - - 'virtual_field' => { - 'columns' => [ - 'recnum', 'int', '', '', - 'vfieldpart', 'int', '', '', - 'value', 'varchar', '', 128, - ], - 'primary_key' => '', - 'unique' => [ [ 'vfieldpart', 'recnum' ] ], - 'index' => [], - }, - - 'acct_snarf' => { - 'columns' => [ - 'snarfnum', 'int', '', '', - 'svcnum', 'int', '', '', - 'machine', 'varchar', '', 255, - 'protocol', 'varchar', '', $char_d, - 'username', 'varchar', '', $char_d, - '_password', 'varchar', '', $char_d, - ], - 'primary_key' => 'snarfnum', - 'unique' => [], - 'index' => [ [ 'svcnum' ] ], - }, - - 'svc_external' => { - 'columns' => [ - 'svcnum', 'int', '', '', - 'id', 'int', '', '', - 'title', 'varchar', 'NULL', $char_d, - ], - 'primary_key' => 'svcnum', - 'unique' => [], - 'index' => [], - }, ); diff --git a/FS/bin/freeside-tax-report b/FS/bin/freeside-tax-report index 240f3ad37..d48da87a6 100755 --- a/FS/bin/freeside-tax-report +++ b/FS/bin/freeside-tax-report @@ -267,7 +267,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-tax-report,v 1.5 2002-09-09 22:57:34 ivan Exp $ +$Id: freeside-tax-report,v 1.4.4.1 2002-09-09 22:57:32 ivan Exp $ =head1 BUGS diff --git a/FS/t/Report-Table-Monthly.t b/FS/t/Report-Table-Monthly.t deleted file mode 100644 index 6ff365d1c..000000000 --- a/FS/t/Report-Table-Monthly.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::Report::Table::Monthly; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/Report-Table.t b/FS/t/Report-Table.t deleted file mode 100644 index 866d4981e..000000000 --- a/FS/t/Report-Table.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::Report::Table; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/acct_snarf.t b/FS/t/acct_snarf.t deleted file mode 100644 index 642760f20..000000000 --- a/FS/t/acct_snarf.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::acct_snarf; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/cust_bill_pkg_detail.t b/FS/t/cust_bill_pkg_detail.t deleted file mode 100644 index ea6e3d125..000000000 --- a/FS/t/cust_bill_pkg_detail.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::cust_bill_pkg_detail; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/part_export-router.t b/FS/t/part_export-router.t deleted file mode 100644 index 54e4b63de..000000000 --- a/FS/t/part_export-router.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::part_export::router; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/Report.t b/FS/t/svc_acct_sm.t index 76d6ea489..1082f2cdb 100644 --- a/FS/t/Report.t +++ b/FS/t/svc_acct_sm.t @@ -1,5 +1,5 @@ BEGIN { $| = 1; print "1..1\n" } END {print "not ok 1\n" unless $loaded;} -use FS::Report; +use FS::svc_acct_sm; $loaded=1; print "ok 1\n"; diff --git a/FS/t/svc_broadband.t b/FS/t/svc_broadband.t deleted file mode 100644 index 02dc1124a..000000000 --- a/FS/t/svc_broadband.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::svc_broadband; -$loaded=1; -print "ok 1\n"; diff --git a/FS/t/svc_external.t b/FS/t/svc_external.t deleted file mode 100644 index 20a676784..000000000 --- a/FS/t/svc_external.t +++ /dev/null @@ -1,5 +0,0 @@ -BEGIN { $| = 1; print "1..1\n" } -END {print "not ok 1\n" unless $loaded;} -use FS::svc_external; -$loaded=1; -print "ok 1\n"; |