diff options
Diffstat (limited to 'FS')
76 files changed, 1557 insertions, 3066 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 f6153761b..86d20f6cb 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); @@ -230,9 +225,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 445f0ece8..22f0d4adb 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -4,16 +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::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 @@ -23,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, @@ -128,6 +124,7 @@ sub customer_info { } + return { 'error' => '', 'custnum' => $custnum, %return, @@ -156,104 +153,6 @@ sub edit_info { 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; - - if ( $cust_main->paydate =~ /^(\d{4})-(\d{2})-\d{2}$/ ) { #Pg date format - @return{'month', 'year'} = ( $2, $1 ); - } elsif ( $cust_main->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) { - @return{'month', 'year'} = ( $1, $3 ); - } - - } - - #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, - }; - -}; - -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" }; - - 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; - } - - my $error = $cust_main->realtime_bop( 'CC', $p->{'amount'}, quiet=>1, - 'paydate' => $p->{'year'}. '-'. $p->{'month'}. '-01', - map { $_ => $p->{$_} } - qw( payname address1 address2 city state zip payinfo paybatch ) - ); - return { 'error' => $error } if $error; - - $cust_main->apply_payments; - - return { 'error' => '' }; - -} - sub invoice { my $p = shift; my $session = $cache->get($p->{'session_id'}) diff --git a/FS/FS/ClientAPI/passwd.pm b/FS/FS/ClientAPI/passwd.pm index 016ebff79..29606227d 100644 --- a/FS/FS/ClientAPI/passwd.pm +++ b/FS/FS/ClientAPI/passwd.pm @@ -15,9 +15,8 @@ FS::ClientAPI->register_handlers( sub passwd { my $packet = shift; - my $domain = $FS::ClientAPI::domain || $packet->{'domain'}; - my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ) - or return { error => "Domain $domain not found" }; + #my $domain = qsearchs('svc_domain', { 'domain' => $packet->{'domain'} } ) + # or return { error => "Domain $domain not found" }; my $old_password = $packet->{'old_password'}; my $new_password = $packet->{'new_password'}; @@ -28,11 +27,11 @@ sub passwd { my $svc_acct = ( length($old_password) < 13 && qsearchs( 'svc_acct', { 'username' => $packet->{'username'}, - 'domsvc' => $svc_domain->svcnum, + #'domsvc' => $svc_domain->svcnum, '_password' => $old_password } ) ) || qsearchs( 'svc_acct', { 'username' => $packet->{'username'}, - 'domsvc' => $svc_domain->svcnum, + #'domsvc' => $svc_domain->svcnum, '_password' => $old_password } ); unless ( $svc_acct ) { return { error => 'Incorrect password.' } } diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 99eee18ea..0b979cf37 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.', @@ -365,6 +372,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', @@ -393,13 +407,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\'', @@ -967,7 +974,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) ], }, { @@ -1095,7 +1102,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) ], }, { 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 b950e306b..98acaf522 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -2,22 +2,18 @@ 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); use File::CounterFile; use Locale::Country; use DBI qw(:sql_types); -use DBIx::DBSchema 0.21; -use FS::UID qw(dbh getotaker datasrc driver_name); +use DBIx::DBSchema 0.19; +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 } @@ -819,11 +635,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 ''; } @@ -831,18 +644,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; @@ -866,44 +679,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'; @@ -915,24 +690,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; ''; @@ -946,34 +703,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 { @@ -981,7 +722,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; @@ -995,13 +736,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 @@ -1010,6 +746,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!" @@ -1025,8 +763,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; @@ -1377,94 +1116,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 @@ -1523,40 +1204,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)) { @@ -1592,7 +1249,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.) @@ -1600,7 +1257,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/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 a3e76620e..1c3941b21 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) ); - return "can't send invoice: $error" if $error; + $!=0; + $message->smtpsend( Host => $smtpmachine ) + or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) + or return "(customer # ". $self->custnum. ") can't send invoice email". + " to ". join(', ', grep { $_ ne 'POST' } @invoicing_list ). + " via server $smtpmachine with SMTP: $!"; } @@ -348,7 +428,6 @@ sub send { } if ( grep { $_ eq 'POST' } @invoicing_list ) { #postal - my $lpr = $conf->config('lpr'); open(LPR, "|$lpr") or return "Can't open pipe to $lpr: $!"; 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,12 +742,276 @@ sub realtime_bop { grep { $_->pkgnum } $self->cust_bill_pkg ); $description = eval qq("$dtempl"); + } - $cust_main->realtime_bop($method, $amount, - 'description' => $description, - 'invnum' => $self->invnum, + 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"; + } + } + + #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 ) { + # gah, even with transactions. + my $e = 'WARNING: Card/ACH debited but database not updated - '. + 'error applying payment, invnum #' . $self->invnum. + " ($processor): $error"; + warn $e; + return $e; + } else { + return ''; + } + #} 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 { $_ eq $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'}; + } } @@ -729,8 +1123,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 19a54534f..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 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 6ca32871d..986fef3a5 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 @@ -781,11 +772,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; @@ -813,7 +804,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; @@ -866,24 +857,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{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 \,\.\-\']+)$/ @@ -898,7 +882,7 @@ sub check { #warn "AFTER: \n". $self->_dump; - $self->SUPER::check; + ''; #no error } =item all_pkgs @@ -1102,8 +1086,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'} ) { @@ -1211,12 +1193,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; @@ -1257,7 +1238,7 @@ sub bill { join('/', ( map $self->$_(), qw(state county country) ), $part_pkg->taxclass ). "\n"; } - + foreach my $tax ( @taxes ) { my $taxable_charged = 0; @@ -1424,9 +1405,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. @@ -1526,7 +1506,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; } @@ -1630,268 +1613,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 ); - - #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*$/; - - #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 - #make this disable-able via a config option if anyone insists? - # (though that probably violates cardholder agreements) - if ( defined $self->dbdef_table->column('paycvv') - && length($self->paycvv) - && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save') - ) { - 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 ) { - # gah, even with transactions. - my $e = 'WARNING: Card/ACH debited but database not updated - '. - 'error applying payment, invnum #' . $self->invnum. - " ($processor): $error"; - warn $e; - return $e; - } else { - return ''; - } - - } 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 { $_ eq $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 diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm index 76c982ae8..c124f960b 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 e1943ae2d..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 @@ -401,7 +418,7 @@ sub cust_main { =head1 VERSION -$Id: cust_pay.pm,v 1.26 2003-09-10 10:54:46 ivan Exp $ +$Id: cust_pay.pm,v 1.21.4.3 2003-09-10 10:54:47 ivan Exp $ =head1 BUGS 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 5700b654e..c147f0926 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); +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,15 +15,22 @@ 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 ); +$DEBUG = 0; + $disable_agentcheck = 0; sub _cache { @@ -99,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 @@ -250,7 +254,7 @@ sub check { $self->manual_flag($1); } - $self->SUPER::check; + ''; #no error } =item cancel [ OPTION => VALUE ... ] @@ -308,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 @@ -460,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, @@ -582,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 @@ -610,61 +635,6 @@ sub attribute_since_sqlradacct { } -=item transfer DEST_PKGNUM - -Transfers as many services as possible from this package to another package. -The destination package must already exist. Services are moved only if -the destination allows services with the correct I<svcnum> (not svcdb). -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) = @_; - - my $remaining = 0; - my $dest; - my %target; - my $pkg_svc; - - 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 $pkg_svc (qsearch('pkg_svc', { pkgpart => $dest->pkgpart })) { - $target{$pkg_svc->svcpart} = $pkg_svc->quantity; - } - - my $cust_svc; - - foreach $cust_svc ($dest->cust_svc) { - $target{$cust_svc->svcpart}--; - } - - foreach $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; - } else { - $remaining++ - } - } - return $remaining; -} - =item reexport =cut @@ -726,62 +696,186 @@ newly-created cust_pkg objects. =cut sub order { + my($custnum, $pkgparts, $remove_pkgnums, $return_cust_pkg) = @_; + $remove_pkgnums = [] unless defined($remove_pkgnums); - # Rewritten to make use of the transfer() method, and in general - # to not suck so badly. - - my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg) = @_; - - # Transactionize this whole mess 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"; + } + } + + #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 ( $DEBUG ) { + foreach my $svcpart ( keys %svcnum ) { + warn "after special-case move svcpart $svcpart: existing svcnums ". + join(', ', map { $_->svcnum } @{$svcnum{$svcpart}} ). "\n"; } - 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. + } + + + #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 @@ -795,12 +889,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 250bd20e0..aa81003b1 100644 --- a/FS/FS/cust_refund.pm +++ b/FS/FS/cust_refund.pm @@ -260,14 +260,14 @@ sub check { $self->otaker(getotaker); - $self->SUPER::check; + ''; #no error } =back =head1 VERSION -$Id: cust_refund.pm,v 1.21 2003-08-05 00:20:42 khoff Exp $ +$Id: cust_refund.pm,v 1.18.4.2 2002-11-19 09:52:02 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index b74cfd685..e27b273b4 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' ) { my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->srcsvc } ); $tag = $svc_acct->email. '->'; @@ -294,10 +299,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 ea0c48d4f..dd16675fb 100644 --- a/FS/FS/domain_record.pm +++ b/FS/FS/domain_record.pm @@ -241,7 +241,7 @@ sub check { if ( $self->rectype eq 'SOA' ) { my $recdata = $self->recdata; $recdata =~ s/\s+/ /g; - $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( ((\d+|((\d+[WDHMS])+)) ){5}\))$/i + $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( (\d+ ){5}\))$/i or return "Illegal data for SOA record: $recdata"; $self->recdata($1); } elsif ( $self->rectype eq 'NS' ) { @@ -271,7 +271,7 @@ sub check { die "ack!"; } - $self->SUPER::check; + ''; #no error } =item increment_serial @@ -332,7 +332,7 @@ sub zone { =head1 VERSION -$Id: domain_record.pm,v 1.16 2003-08-05 00:20:43 khoff Exp $ +$Id: domain_record.pm,v 1.11.4.2 2003-03-29 04:52:35 ivan Exp $ =head1 BUGS 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 033840aeb..95a111788 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -281,7 +281,7 @@ sub check { #check exporttype? - $self->SUPER::check; + ''; #no error } #=item part_svc @@ -303,7 +303,7 @@ sub part_svc { =item svc_x -Returns a list of associated FS::svc_* records. +Returns a list of associate FS::svc_* records. =cut @@ -663,19 +663,6 @@ END }, ; -tie my %router_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=>'#' } -; - tie my %domain_shellcommands_options, 'Tie::IxHash', 'user' => { label=>'Remote username', default=>'root' }, 'useradd' => { label=>'Insert command', @@ -781,30 +768,18 @@ tie my %communigate_pro_singledomain_options, 'Tie::IxHash', ; tie my %bind_options, 'Tie::IxHash', - #'machine' => { label=>'named machine' }, - 'named_conf' => { label => 'named.conf location', - default=> '/etc/bind/named.conf' }, - 'zonepath' => { label => 'path to zone files', - default=> '/etc/bind/', }, - 'bind_release' => { label => 'ISC BIND Release', - type => 'select', - options => [qw(BIND8 BIND9)], - default => 'BIND8' }, - 'bind9_minttl' => { label => 'The minttl required by bind9 and RFC1035.', - default => '1D' }, + #'machine' => { label=>'named machine' }, + 'named_conf' => { label => 'named.conf location', + default=> '/etc/bind/named.conf' }, + 'zonepath' => { label => 'path to zone files', + default=> '/etc/bind/', }, ; tie my %bind_slave_options, 'Tie::IxHash', - #'machine' => { label=> 'Slave machine' }, - 'master' => { label=> 'Master IP address(s) (semicolon-separated)' }, - 'named_conf' => { label => 'named.conf location', - default => '/etc/bind/named.conf' }, - 'bind_release' => { label => 'ISC BIND Release', - type => 'select', - options => [qw(BIND8 BIND9)], - default => 'BIND8' }, - 'bind9_minttl' => { label => 'The minttl required by bind9 and RFC1035.', - default => '1D' }, + #'machine' => { label=> 'Slave machine' }, + 'master' => { label=> 'Master IP address(s) (semicolon-separated)' }, + 'named_conf' => { label => 'named.conf location', + default => '/etc/bind/named.conf' }, ; tie my %http_options, 'Tie::IxHash', @@ -839,27 +814,9 @@ tie my %http_options, 'Tie::IxHash', ; tie my %sqlmail_options, 'Tie::IxHash', - 'datasrc' => { label => 'DBI data source' }, - 'username' => { label => 'Database username' }, - 'password' => { label => 'Database password' }, - 'server_type' => { - label => 'Server type', - type => 'select', - options => [qw(dovecot_plain dovecot_crypt dovecot_digest_md5 courier_plain - courier_crypt)], - default => ['dovecot_plain'], }, - 'svc_acct_table' => { label => 'User Table', default => 'user_acct' }, - 'svc_forward_table' => { label => 'Forward Table', default => 'forward' }, - 'svc_domain_table' => { label => 'Domain Table', default => 'domain' }, - 'svc_acct_fields' => { label => 'svc_acct Export Fields', - default => 'username _password domsvc svcnum' }, - 'svc_forward_fields' => { label => 'svc_forward Export Fields', - default => 'domain svcnum catchall' }, - 'svc_domain_fields' => { label => 'svc_domain Export Fields', - default => 'srcsvc dstsvc dst' }, - 'resolve_dstsvc' => { label => q{Resolve svc_forward.dstsvc to an email address and store it in dst. (Doesn't require that you also export dstsvc.)}, - type => 'checkbox' }, - + 'datasrc' => { label=>'DBI data source' }, + 'username' => { label=>'Database username' }, + 'password' => { label=>'Database password' }, ; tie my %ldap_options, 'Tie::IxHash', @@ -967,7 +924,7 @@ tie my %forward_shellcommands_options, 'Tie::IxHash', 'sqlmail' => { 'desc' => 'Real-time export to SQL-backed mail server', 'options' => \%sqlmail_options, - 'nodomain' => '', + 'nodomain' => 'Y', 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)', }, @@ -1048,6 +1005,8 @@ tie my %forward_shellcommands_options, 'Tie::IxHash', }, + 'svc_acct_sm' => {}, + 'svc_forward' => { 'sqlmail' => { 'desc' => 'Real-time export to SQL-backed mail server', @@ -1077,17 +1036,6 @@ tie my %forward_shellcommands_options, 'Tie::IxHash', }, }, - 'svc_broadband' => { - 'router' => { - 'desc' => 'Send a command to a router.', - 'options' => \%router_options, - 'notes' => '', - }, - }, - - 'svc_external' => { - }, - ); =back diff --git a/FS/FS/part_export/router.pm b/FS/FS/part_export/router.pm deleted file mode 100644 index 07b5b9edb..000000000 --- a/FS/FS/part_export/router.pm +++ /dev/null @@ -1,166 +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 @saltset); -use String::ShellQuote; -use FS::part_export; - -@ISA = qw(FS::part_export); - -@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 { - use Net::Telnet; - - 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 -#} - 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 634f7f4bd..d35dc883f 100644 --- a/FS/FS/queue.pm +++ b/FS/FS/queue.pm @@ -207,7 +207,7 @@ sub check { $self->status('new') unless $self->status; $self->_date(time) unless $self->_date; - $self->SUPER::check; + ''; #no error } =item args @@ -385,7 +385,7 @@ END =head1 VERSION -$Id: queue.pm,v 1.16 2003-08-05 00:20:46 khoff Exp $ +$Id: queue.pm,v 1.15 2002-07-02 06:48:59 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 cadb997da..2e236ee2e 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 ); -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; @@ -28,60 +28,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 [ JOBNUM_ARRAYREF [ OBJECTS_ARRAYREF ] ] Adds this record to the database. If there is an error, returns the error, @@ -324,7 +270,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 ); @@ -432,6 +378,10 @@ sub cancel { ''; } =back +=head1 VERSION + +$Id: svc_Common.pm,v 1.12.4.4 2003-11-12 12:29:55 ivan Exp $ + =head1 BUGS The setfixed method return value. diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 9d8566d77..8c99c9e48 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 @@ -18,9 +19,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; @@ -51,6 +54,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 ( @@ -314,8 +318,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}; } } @@ -427,6 +431,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!" @@ -609,11 +618,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 { @@ -624,11 +635,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 { @@ -791,7 +804,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; } @@ -831,13 +844,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 $_ } @@ -845,6 +858,7 @@ sub _check_system { ); } + =item radius Depriciated, use radius_reply instead. @@ -897,7 +911,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); @@ -915,10 +929,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 @@ -1031,6 +1049,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 @@ -1069,28 +1088,36 @@ sub radius_groups { =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 @@ -1241,7 +1268,7 @@ probably live somewhere else... 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 ec915327b..000000000 --- a/FS/FS/svc_broadband.pm +++ /dev/null @@ -1,235 +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 - -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. - -=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') { - $self->ip_addr($self->addr_block->next_free_addr->addr); - if (not $self->ip_addr) { - 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 10d5d8f5c..58e4c790b 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 1.0; 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'); @@ -206,6 +210,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 } ); @@ -342,8 +350,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 fe4ea1d67..000000000 --- a/FS/FS/svc_external.pm +++ /dev/null @@ -1,174 +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 - -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. - -=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 7a121b835..2b1fb9225 100644 --- a/FS/FS/svc_forward.pm +++ b/FS/FS/svc_forward.pm @@ -241,7 +241,7 @@ sub check { $self->dst(''); } - $self->SUPER::check; + ''; #no error } =item srcsvc_acct diff --git a/FS/FS/svc_www.pm b/FS/FS/svc_www.pm index 7e8908346..d7a42c8ae 100644 --- a/FS/FS/svc_www.pm +++ b/FS/FS/svc_www.pm @@ -234,8 +234,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 3cbf0e91f..80b246f48 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -17,6 +17,7 @@ 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 @@ -49,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 @@ -94,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 @@ -135,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 @@ -185,10 +180,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 index 136851aec..f4225d28a 100755 --- a/FS/bin/freeside-cc-receipts-report +++ b/FS/bin/freeside-cc-receipts-report @@ -245,7 +245,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-cc-receipts-report,v 1.5 2002-09-09 22:57:34 ivan Exp $ +$Id: freeside-cc-receipts-report,v 1.4.4.1 2002-09-09 22:57:32 ivan Exp $ =head1 BUGS diff --git a/FS/bin/freeside-credit-report b/FS/bin/freeside-credit-report index 410dabe8f..da01d3bd5 100755 --- a/FS/bin/freeside-credit-report +++ b/FS/bin/freeside-credit-report @@ -199,7 +199,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-credit-report,v 1.5 2002-09-09 22:57:34 ivan Exp $ +$Id: freeside-credit-report,v 1.4.4.1 2002-09-09 22:57:32 ivan Exp $ =head1 BUGS diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index 5fb966665..9ff21d421 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 72780e363..213dcb947 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -7,7 +7,7 @@ use strict; use vars qw($opt_s); use Getopt::Std; 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; @@ -111,9 +111,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 @@ -139,6 +138,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) @@ -190,23 +216,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); @@ -291,8 +301,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({ @@ -331,23 +339,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', @@ -367,7 +372,7 @@ sub tables_hash_hack { 'cust_bill' => { 'columns' => [ - 'invnum', 'serial', '', '', + 'invnum', 'int', '', '', 'custnum', 'int', '', '', '_date', @date_type, 'charged', @money_type, @@ -381,7 +386,7 @@ sub tables_hash_hack { 'cust_bill_event' => { 'columns' => [ - 'eventnum', 'serial', '', '', + 'eventnum', 'int', '', '', 'invnum', 'int', '', '', 'eventpart', 'int', '', '', '_date', @date_type, @@ -396,7 +401,7 @@ sub tables_hash_hack { 'part_bill_event' => { 'columns' => [ - 'eventpart', 'serial', '', '', + 'eventpart', 'int', '', '', 'payby', 'char', '', 4, 'event', 'varchar', '', $char_d, 'eventcode', @perl_type, @@ -408,7 +413,7 @@ sub tables_hash_hack { ], 'primary_key' => 'eventpart', 'unique' => [], - 'index' => [ ['payby'], ['disabled'], ], + 'index' => [ ['payby'] ], }, 'cust_bill_pkg' => { @@ -419,32 +424,19 @@ 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, - 'otaker', 'varchar', '', 32, + 'otaker', 'varchar', '', 8, 'reason', 'text', 'NULL', '', 'closed', 'char', 'NULL', 1, ], @@ -455,7 +447,7 @@ sub tables_hash_hack { 'cust_credit_bill' => { 'columns' => [ - 'creditbillnum', 'serial', '', '', + 'creditbillnum', 'int', '', '', 'crednum', 'int', '', '', 'invnum', 'int', '', '', '_date', @date_type, @@ -468,13 +460,13 @@ sub tables_hash_hack { 'cust_main' => { 'columns' => [ - 'custnum', 'serial', '', '', + 'custnum', 'int', '', '', 'agentnum', 'int', '', '', # 'titlenum', 'int', 'NULL', '', 'last', 'varchar', '', $char_d, # 'middle', 'varchar', 'NULL', $char_d, 'first', 'varchar', '', $char_d, - 'ss', 'varchar', 'NULL', 11, + 'ss', 'char', 'NULL', 11, 'company', 'varchar', 'NULL', $char_d, 'address1', 'varchar', '', $char_d, 'address2', 'varchar', 'NULL', $char_d, @@ -502,12 +494,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', '', 8, 'refnum', 'int', '', '', 'referral_custnum', 'int', 'NULL', '', 'comments', 'text', 'NULL', '', @@ -515,14 +506,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, ], @@ -535,16 +524,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' => [], @@ -554,7 +540,7 @@ sub tables_hash_hack { 'cust_pay' => { 'columns' => [ - 'paynum', 'serial', '', '', + 'paynum', 'int', '', '', #now cust_bill_pay #'invnum', 'int', '', '', 'custnum', 'int', '', '', 'paid', @money_type, @@ -567,12 +553,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, @@ -586,7 +572,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, @@ -611,13 +597,12 @@ sub tables_hash_hack { 'cust_pkg' => { 'columns' => [ - 'pkgnum', 'serial', '', '', + 'pkgnum', 'int', '', '', 'custnum', 'int', '', '', 'pkgpart', 'int', '', '', - 'otaker', 'varchar', '', 32, + 'otaker', 'varchar', '', 8, 'setup', @date_type, 'bill', @date_type, - 'last_bill', @date_type, 'susp', @date_type, 'cancel', @date_type, 'expire', @date_type, @@ -630,12 +615,12 @@ sub tables_hash_hack { 'cust_refund' => { 'columns' => [ - 'refundnum', 'serial', '', '', + 'refundnum', 'int', '', '', #now cust_credit_refund #'crednum', 'int', '', '', 'custnum', 'int', '', '', '_date', @date_type, 'refund', @money_type, - 'otaker', 'varchar', '', 32, + 'otaker', 'varchar', '', 8, 'reason', 'varchar', '', $char_d, 'payby', 'char', '', 4, # CARD/BILL/COMP, should be index # into payment type table. @@ -650,7 +635,7 @@ sub tables_hash_hack { 'cust_credit_refund' => { 'columns' => [ - 'creditrefundnum', 'serial', '', '', + 'creditrefundnum', 'int', '', '', 'crednum', 'int', '', '', 'refundnum', 'int', '', '', 'amount', @money_type, @@ -664,7 +649,7 @@ sub tables_hash_hack { 'cust_svc' => { 'columns' => [ - 'svcnum', 'serial', '', '', + 'svcnum', 'int', '', '', 'pkgnum', 'int', 'NULL', '', 'svcpart', 'int', '', '', ], @@ -675,11 +660,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, @@ -708,7 +693,6 @@ sub tables_hash_hack { 'pkgpart', 'int', '', '', 'svcpart', 'int', '', '', 'quantity', 'int', '', '', - 'primary_svc','char', 'NULL', 1, ], 'primary_key' => '', 'unique' => [ ['pkgpart', 'svcpart'] ], @@ -717,18 +701,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, @@ -740,7 +723,7 @@ sub tables_hash_hack { 'part_svc_column' => { 'columns' => [ - 'columnnum', 'serial', '', '', + 'columnnum', 'int', '', '', 'svcpart', 'int', '', '', 'columnname', 'varchar', '', 64, 'columnvalue', 'varchar', 'NULL', $char_d, @@ -754,7 +737,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, @@ -768,7 +751,7 @@ sub tables_hash_hack { 'part_pop_local' => { 'columns' => [ - 'localnum', 'serial', '', '', + 'localnum', 'int', '', '', 'popnum', 'int', '', '', 'city', 'varchar', 'NULL', $char_d, 'state', 'char', 'NULL', 2, @@ -803,6 +786,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', '', '', @@ -826,14 +821,12 @@ sub tables_hash_hack { 'domain_record' => { 'columns' => [ - 'recnum', 'serial', '', '', + 'recnum', 'int', '', '', 'svcnum', 'int', '', '', - #'reczone', 'varchar', '', $char_d, - 'reczone', 'varchar', '', 255, + 'reczone', 'varchar', '', $char_d, 'recaf', 'char', '', 2, - 'rectype', 'varchar', '', 5, - #'recdata', 'varchar', '', $char_d, - 'recdata', 'varchar', '', 255, + 'rectype', 'char', '', 5, + 'recdata', 'varchar', '', $char_d, ], 'primary_key' => 'recnum', 'unique' => [], @@ -878,7 +871,7 @@ sub tables_hash_hack { 'prepay_credit' => { 'columns' => [ - 'prepaynum', 'serial', '', '', + 'prepaynum', 'int', '', '', 'identifier', 'varchar', '', $char_d, 'amount', @money_type, 'seconds', 'int', 'NULL', '', @@ -890,7 +883,7 @@ sub tables_hash_hack { 'port' => { 'columns' => [ - 'portnum', 'serial', '', '', + 'portnum', 'int', '', '', 'ip', 'varchar', 'NULL', 15, 'nasport', 'int', 'NULL', '', 'nasnum', 'int', '', '', @@ -902,7 +895,7 @@ sub tables_hash_hack { 'nas' => { 'columns' => [ - 'nasnum', 'serial', '', '', + 'nasnum', 'int', '', '', 'nas', 'varchar', '', $char_d, 'nasip', 'varchar', '', 15, 'nasfqdn', 'varchar', '', $char_d, @@ -915,7 +908,7 @@ sub tables_hash_hack { 'session' => { 'columns' => [ - 'sessionnum', 'serial', '', '', + 'sessionnum', 'int', '', '', 'portnum', 'int', '', '', 'svcnum', 'int', '', '', 'login', @date_type, @@ -928,7 +921,7 @@ sub tables_hash_hack { 'queue' => { 'columns' => [ - 'jobnum', 'serial', '', '', + 'jobnum', 'int', '', '', 'job', 'text', '', '', '_date', 'int', '', '', 'status', 'varchar', '', $char_d, @@ -942,7 +935,7 @@ sub tables_hash_hack { 'queue_arg' => { 'columns' => [ - 'argnum', 'serial', '', '', + 'argnum', 'int', '', '', 'jobnum', 'int', '', '', 'arg', 'text', 'NULL', '', ], @@ -953,7 +946,7 @@ sub tables_hash_hack { 'queue_depend' => { 'columns' => [ - 'dependnum', 'serial', '', '', + 'dependnum', 'int', '', '', 'jobnum', 'int', '', '', 'depend_jobnum', 'int', '', '', ], @@ -964,7 +957,7 @@ sub tables_hash_hack { 'export_svc' => { 'columns' => [ - 'exportsvcnum' => 'serial', '', '', + 'exportsvcnum' => 'int', '', '', 'exportnum' => 'int', '', '', 'svcpart' => 'int', '', '', ], @@ -975,7 +968,7 @@ sub tables_hash_hack { 'part_export' => { 'columns' => [ - 'exportnum', 'serial', '', '', + 'exportnum', 'int', '', '', #'svcpart', 'int', '', '', 'machine', 'varchar', '', $char_d, 'exporttype', 'varchar', '', $char_d, @@ -988,7 +981,7 @@ sub tables_hash_hack { 'part_export_option' => { 'columns' => [ - 'optionnum', 'serial', '', '', + 'optionnum', 'int', '', '', 'exportnum', 'int', '', '', 'optionname', 'varchar', '', $char_d, 'optionvalue', 'text', 'NULL', '', @@ -1000,7 +993,7 @@ sub tables_hash_hack { 'radius_usergroup' => { 'columns' => [ - 'usergroupnum', 'serial', '', '', + 'usergroupnum', 'int', '', '', 'svcnum', 'int', '', '', 'groupname', 'varchar', '', $char_d, ], @@ -1011,7 +1004,7 @@ sub tables_hash_hack { 'msgcat' => { 'columns' => [ - 'msgnum', 'serial', '', '', + 'msgnum', 'int', '', '', 'msgcode', 'varchar', '', $char_d, 'locale', 'varchar', '', 16, 'msg', 'text', '', '', @@ -1023,7 +1016,7 @@ sub tables_hash_hack { 'cust_tax_exempt' => { 'columns' => [ - 'exemptnum', 'serial', '', '', + 'exemptnum', 'int', '', '', 'custnum', 'int', '', '', 'taxnum', 'int', '', '', 'year', 'int', '', '', @@ -1035,102 +1028,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/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/svc_external.t b/FS/t/svc_acct_sm.t index 20a676784..1082f2cdb 100644 --- a/FS/t/svc_external.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::svc_external; +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"; |