diff options
Diffstat (limited to 'FS')
44 files changed, 666 insertions, 2106 deletions
@@ -62,6 +62,8 @@ L<FS::domain_record> - DNS zone entries L<FS::svc_forward> - Mail forwarding class +L<FS::svc_acct_sm> - (Depreciated) Vitual mail alias class + L<FS::svc_www> - Web virtual host class. L<FS::part_svc> - Service definition class @@ -102,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 @@ -187,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/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/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 f0a4c9f45..fcc150cd4 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -297,6 +297,13 @@ httemplate/docs/config.html }, { + 'key' => 'cybercash3.2', + 'section' => 'billing', + 'description' => '<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.', @@ -346,6 +353,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', 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 40215100f..31b6070a3 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -9,8 +9,8 @@ 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); @@ -60,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'); @@ -86,7 +88,7 @@ FS::Record - Database record objects $quoted_value = _quote($value,'table','field'); - #deprecated + #depriciated $fields = hfields('table'); if ( $fields->{Field} ) { # etc. @@ -165,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)!"; @@ -211,7 +213,7 @@ sub qsearch { 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'}); @@ -222,19 +224,19 @@ sub qsearch { if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) { if ( $op eq '=' ) { - if ( driver_name eq 'Pg' ) { + if ( driver_name =~ /^Pg$/i ) { qq-( $column IS NULL OR $column = '' )-; } else { qq-( $column IS NULL OR $column = "" )-; } } elsif ( $op eq '!=' ) { - if ( driver_name eq 'Pg' ) { + if ( driver_name =~ /^Pg$/i ) { qq-( $column IS NOT NULL AND $column != '' )-; } else { qq-( $column IS NOT NULL AND $column != "" )-; } } else { - if ( driver_name eq 'Pg' ) { + if ( driver_name =~ /^Pg$/i ) { qq-( $column $op '' )-; } else { qq-( $column $op "" )-; @@ -351,7 +353,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'}; } @@ -478,40 +480,24 @@ 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 @fields = grep defined($self->getfield($_)) && $self->getfield($_) ne "", $self->fields ; - my @values = map { _quote( $self->getfield($_), $table, $_) } @fields; + my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields; #eslaf - my $statement = "INSERT INTO $table ( ". + my $statement = "INSERT INTO ". $self->table. " ( ". join( ', ', @fields ). ") VALUES (". join( ', ', @values ). @@ -520,6 +506,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'; @@ -528,64 +523,7 @@ sub insert { local $SIG{PIPE} = 'IGNORE'; $sth->execute or return $sth->errstr; - - if ( $db_seq ) { # get inserted id from the database, if applicable - warn "[debug]$me retreiving sequence from database\n" if $DEBUG; - my $insertid = ''; - 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 $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; ''; @@ -598,7 +536,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 } @@ -616,7 +554,7 @@ sub delete { map { $self->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" - ? ( driver_name eq 'Pg' + ? ( driver_name =~ /^Pg$/i ? "$_ IS NULL" : "( $_ IS NULL OR $_ = \"\" )" ) @@ -662,7 +600,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 } @@ -702,7 +640,7 @@ sub replace { map { $old->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" - ? ( driver_name eq 'Pg' + ? ( driver_name =~ /^Pg$/i ? "$_ IS NULL" : "( $_ IS NULL OR $_ = \"\" )" ) @@ -755,7 +693,7 @@ 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 } @@ -788,13 +726,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 @@ -803,6 +736,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!" @@ -818,8 +753,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; @@ -1237,14 +1173,14 @@ sub _quote { =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)) { @@ -1280,7 +1216,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.) @@ -1288,7 +1224,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 ebf9b96e5..8934d49fc 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -87,7 +87,7 @@ sub forksuidsetup { getsecrets; $dbh = DBI->connect($datasrc,$db_user,$db_pass, { 'AutoCommit' => 0, - #'ChopBlanks' => 1, + 'ChopBlanks' => 1, } ) or die "DBI->connect error: $DBI::errstr\n"; foreach ( keys %callback ) { @@ -171,7 +171,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 @@ -256,7 +258,7 @@ coderef into the hash %FS::UID::callback : =head1 VERSION -$Id: UID.pm,v 1.21 2002-09-27 12:14:12 ivan Exp $ +$Id: UID.pm,v 1.19 2002-08-29 06:02:52 ivan Exp $ =head1 BUGS diff --git a/FS/FS/addr_block.pm b/FS/FS/addr_block.pm deleted file mode 100755 index b671723aa..000000000 --- a/FS/FS/addr_block.pm +++ /dev/null @@ -1,322 +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 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; - } - } - - ''; -} - - -=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 @used = map { $_->NetAddr->addr } - ($self, - qsearch('svc_broadband', { blocknum => $self->blocknum }) ); - - 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. - -1; - diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index aa82eb6f8..009f6af33 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -3,6 +3,7 @@ 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 ); @@ -41,7 +42,28 @@ $FS::UID::callback{'FS::cust_bill'} = sub { ( $ach_processor,$ach_login, $ach_password, $ach_action ) = ( '', '', '', ''); @ach_options = (); - if ( $conf->exists('business-onlinepayment') ) { + 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, @@ -370,7 +392,7 @@ 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 = ($invoice_from) unless @invoicing_list; @@ -532,13 +554,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( @@ -812,7 +831,7 @@ sub realtime_bop { 'invnum' => $self->invnum, 'paid' => $amount, '_date' => '', - 'payby' => method2payby{$method}, + 'payby' => $method2payby{$method}, 'payinfo' => $cust_main->payinfo, 'paybatch' => "$processor:". $transaction->authorization, } ); @@ -874,6 +893,84 @@ sub realtime_bop { } +=item realtime_card_cybercash + +Attempts to pay this invoice with the CyberCash CashRegister realtime gateway. + +=cut + +sub realtime_card_cybercash { + my $self = shift; + my $cust_main = $self->cust_main; + my $amount = $self->owed; + + return "CyberCash CashRegister real-time card processing not enabled!" + unless $cybercash eq 'cybercash3.2'; + + my $address = $cust_main->address1; + $address .= ", ". $cust_main->address2 if $cust_main->address2; + + #fix exp. date + #$cust_main->paydate =~ /^(\d+)\/\d*(\d{2})$/; + $cust_main->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + my $exp = "$2/$1"; + + # + + my $paybatch = $self->invnum. + '-' . time2str("%y%m%d%H%M%S", time); + + my $payname = $cust_main->payname || + $cust_main->getfield('first').' '.$cust_main->getfield('last'); + + my $country = $cust_main->country eq 'US' ? 'USA' : $cust_main->country; + + my @full_xaction = ( $xaction, + 'Order-ID' => $paybatch, + 'Amount' => "usd $amount", + 'Card-Number' => $cust_main->getfield('payinfo'), + 'Card-Name' => $payname, + 'Card-Address' => $address, + 'Card-City' => $cust_main->getfield('city'), + 'Card-State' => $cust_main->getfield('state'), + 'Card-Zip' => $cust_main->getfield('zip'), + 'Card-Country' => $country, + 'Card-Exp' => $exp, + ); + + my %result; + %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction); + + if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3 + my $cust_pay = new FS::cust_pay ( { + 'invnum' => $self->invnum, + 'paid' => $amount, + '_date' => '', + 'payby' => 'CARD', + 'payinfo' => $cust_main->payinfo, + 'paybatch' => "$cybercash:$paybatch", + } ); + my $error = $cust_pay->insert; + if ( $error ) { + # gah, even with transactions. + my $e = 'WARNING: Card debited but database not updated - '. + 'error applying payment, invnum #' . $self->invnum. + " (CyberCash Order-ID $paybatch): $error"; + warn $e; + return $e; + } else { + return ''; + } +# } elsif ( $result{'Mstatus'} ne 'failure-bad-money' +# || $options{'report_badcard'} +# ) { + } else { + return 'Cybercash error, invnum #' . + $self->invnum. ':'. $result{'MErrMsg'}; + } + +} + =item batch_card Adds a payment for this invoice to the pending credit card batch (see @@ -953,43 +1050,33 @@ sub print_text { } #new charges - foreach my $cust_bill_pkg ( - ( grep { $_->pkgnum } $self->cust_bill_pkg ), #packages first - ( grep { ! $_->pkgnum } $self->cust_bill_pkg ), #then taxes - ) { + foreach ( $self->cust_bill_pkg ) { - if ( $cust_bill_pkg->pkgnum ) { + if ( $_->pkgnum ) { - my $cust_pkg = qsearchs('cust_pkg', { pkgnum =>$cust_bill_pkg->pkgnum } ); - my $part_pkg = qsearchs('part_pkg', { pkgpart=>$cust_pkg->pkgpart } ); - my $pkg = $part_pkg->pkg; + my($cust_pkg)=qsearchs('cust_pkg', { 'pkgnum', $_->pkgnum } ); + my($part_pkg)=qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->pkgpart}); + my($pkg)=$part_pkg->pkg; - if ( $cust_bill_pkg->setup != 0 ) { - push @buf, [ "$pkg Setup", - $money_char. sprintf("%10.2f", $cust_bill_pkg->setup) ]; + if ( $_->setup != 0 ) { + push @buf, [ "$pkg Setup", $money_char. sprintf("%10.2f",$_->setup) ]; push @buf, map { [ " ". $_->[0]. ": ". $_->[1], '' ] } $cust_pkg->labels; } - if ( $cust_bill_pkg->recur != 0 ) { + if ( $_->recur != 0 ) { push @buf, [ - "$pkg (" . time2str("%x", $cust_bill_pkg->sdate) . " - " . - time2str("%x", $cust_bill_pkg->edate) . ")", - $money_char. sprintf("%10.2f", $cust_bill_pkg->recur) + "$pkg (" . time2str("%x",$_->sdate) . " - " . + time2str("%x",$_->edate) . ")", + $money_char. sprintf("%10.2f",$_->recur) ]; push @buf, map { [ " ". $_->[0]. ": ". $_->[1], '' ] } $cust_pkg->labels; } - push @buf, map { [ " $_", '' ] } $cust_bill_pkg->details; - - } else { #pkgnum tax - my $itemdesc = defined $cust_bill_pkg->dbdef_table->column('itemdesc') - ? ( $cust_bill_pkg->itemdesc || 'Tax' ) - : 'Tax'; - push @buf, [ $itemdesc, - $money_char. sprintf("%10.2f", $cust_bill_pkg->setup) ] - if $cust_bill_pkg->setup != 0; + } else { #pkgnum Tax + push @buf,["Tax", $money_char. sprintf("%10.2f",$_->setup) ] + if $_->setup != 0; } } @@ -1133,6 +1220,10 @@ sub print_text { =back +=head1 VERSION + +$Id: cust_bill.pm,v 1.41.2.20 2003-01-10 07:42:39 ivan Exp $ + =head1 BUGS The delete method. diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm index a6615d05d..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; @@ -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 199de439b..000000000 --- a/FS/FS/cust_bill_pkg_detail.pm +++ /dev/null @@ -1,123 +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') - ; - -} - -=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_main.pm b/FS/FS/cust_main.pm index d1e975406..c5a5982d3 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -172,8 +172,6 @@ FS::Record. The following fields are currently supported: =item comments - comments (optional) -=item referral_custnum - referring customer number - =back =head1 METHODS @@ -486,7 +484,7 @@ sub replace { if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ && grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) { - # card/check info has changed, want to retry realtime_card invoice events + # card info has changed, want to retry realtime_card invoice events #false laziness w/collect foreach my $cust_bill_event ( grep { @@ -923,12 +921,10 @@ sub bill { my( $total_setup, $total_recur ) = ( 0, 0 ); #my( $taxable_setup, $taxable_recur ) = ( 0, 0 ); my @cust_bill_pkg = (); - #my $tax = 0;## + my $tax = 0;## #my $taxable_charged = 0;## #my $charged = 0;## - my %tax; - foreach my $cust_pkg ( qsearch('cust_pkg', { 'custnum' => $self->custnum } ) ) { @@ -947,8 +943,6 @@ sub bill { my %hash = $cust_pkg->hash; my $old_cust_pkg = new FS::cust_pkg \%hash; - my @details = (); - # bill setup my $setup = 0; unless ( $cust_pkg->setup ) { @@ -1044,12 +1038,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; @@ -1126,10 +1119,7 @@ sub bill { } #if $cust_main_county->exempt_amount $taxable_charged = sprintf( "%.2f", $taxable_charged); - - #$tax += $taxable_charged * $cust_main_county->tax / 100 - $tax{ $cust_main_county->taxname || 'Tax' } += - $taxable_charged * $cust_main_county->tax / 100 + $tax += $taxable_charged * $cust_main_county->tax / 100 } #unless $self->tax =~ /Y/i # || $self->payby eq 'COMP' @@ -1162,17 +1152,16 @@ sub bill { # $taxable_charged * ( $cust_main_county->getfield('tax') / 100 ) # ); - foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) { - my $tax = sprintf("%.2f", $tax{$taxname} ); + $tax = sprintf("%.2f", $tax); + if ( $tax > 0 ) { $charged = sprintf( "%.2f", $charged+$tax ); my $cust_bill_pkg = new FS::cust_bill_pkg ({ - 'pkgnum' => 0, - 'setup' => $tax, - 'recur' => 0, - 'sdate' => '', - 'edate' => '', - 'itemdesc' => $taxname, + 'pkgnum' => 0, + 'setup' => $tax, + 'recur' => 0, + 'sdate' => '', + 'edate' => '', }); push @cust_bill_pkg, $cust_bill_pkg; } diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm index d8796e451..e41564d21 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" - =back =head1 METHODS @@ -112,7 +110,6 @@ sub check { || $self->ut_float('tax') || $self->ut_textn('taxclass') # ... || $self->ut_money('exempt_amount') - || $self->ut_textn('taxname') ; } diff --git a/FS/FS/cust_main_invoice.pm b/FS/FS/cust_main_invoice.pm index bcb1437af..a5533a088 100644 --- a/FS/FS/cust_main_invoice.pm +++ b/FS/FS/cust_main_invoice.pm @@ -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.13 2002-09-18 22:50:44 ivan 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 79cf82755..67fdcf246 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -406,7 +406,7 @@ sub unapplied { =head1 VERSION -$Id: cust_pay.pm,v 1.23 2002-11-19 09:51:58 ivan Exp $ +$Id: cust_pay.pm,v 1.21.4.2 2002-11-19 09:52:02 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 4eea2c087..8529e08ca 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,8 +1,7 @@ package FS::cust_pkg; use strict; -use vars qw(@ISA $disable_agentcheck); -use vars qw( $quiet ); +use vars qw(@ISA $quiet $disable_agentcheck); use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearch qsearchs ); use FS::cust_svc; @@ -16,6 +15,7 @@ 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; @@ -600,8 +600,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 @@ -817,12 +816,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 763671736..aa81003b1 100644 --- a/FS/FS/cust_refund.pm +++ b/FS/FS/cust_refund.pm @@ -267,7 +267,7 @@ sub check { =head1 VERSION -$Id: cust_refund.pm,v 1.20 2002-11-19 09:51:58 ivan 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 26e6274a1..68734a6b9 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -9,6 +9,7 @@ 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::domain_record; @@ -277,6 +278,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. '->'; @@ -291,8 +297,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; } else { cluck "warning: asked for label of unsupported svcdb; using svcnum"; $tag = $svc_x->getfield('svcnum'); diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm index 2f7e270dc..dd16675fb 100644 --- a/FS/FS/domain_record.pm +++ b/FS/FS/domain_record.pm @@ -332,7 +332,7 @@ sub zone { =head1 VERSION -$Id: domain_record.pm,v 1.13 2003-03-29 04:53:44 ivan 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/part_export.pm b/FS/FS/part_export.pm index 789e8450d..c6f9b0606 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -923,6 +923,8 @@ tie my %ldap_options, 'Tie::IxHash', }, + 'svc_acct_sm' => {}, + 'svc_forward' => { 'sqlmail' => { 'desc' => 'Real-time export to SQL-backed mail server', @@ -946,9 +948,6 @@ tie my %ldap_options, 'Tie::IxHash', }, }, - 'svc_broadband' => { - }, - ); =back diff --git a/FS/FS/part_router_field.pm b/FS/FS/part_router_field.pm deleted file mode 100755 index 73ca50fb6..000000000 --- a/FS/FS/part_router_field.pm +++ /dev/null @@ -1,134 +0,0 @@ -package FS::part_router_field; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearchs ); -use FS::router_field; -use FS::router; - - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::part_router_field - Object methods for part_router_field records - -=head1 SYNOPSIS - - use FS::part_router_field; - - $record = new FS::part_router_field \%hash; - $record = new FS::part_router_field { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -A part_router_field represents an xfield definition for routers. For more -information on xfields, see L<FS::part_sb_field>. - -The following fields are supported: - -=over 4 - -=item routerfieldpart - primary key (assigned automatically) - -=item name - name of field - -=item length - -=item check_block - -=item list_source - -(See L<FS::part_sb_field> for details on these 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_router_field'; } - -=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->name =~ /^([a-z0-9_\-\.]{1,15})$/i - or return "Invalid field name for part_router_field"; - - ''; #no error -} - -=item list_values - -Equivalent to "eval($part_router_field->list_source)". - -=cut - -sub list_values { - my $self = shift; - return () unless $self->list_source; - my @opts = eval($self->list_source); - if($@) { - warn $@; - return (); - } else { - return @opts; - } -} - -=back - -=head1 VERSION - -$Id: - -=head1 BUGS - -Needless duplication of much of FS::part_sb_field, with the result that most of -the warnings about it apply here also. - -=head1 SEE ALSO - -FS::svc_broadband, FS::router, FS::router_field, schema.html -from the base documentation. - -=cut - -1; - diff --git a/FS/FS/part_sb_field.pm b/FS/FS/part_sb_field.pm deleted file mode 100755 index 8dca946b5..000000000 --- a/FS/FS/part_sb_field.pm +++ /dev/null @@ -1,267 +0,0 @@ -package FS::part_sb_field; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearchs ); - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::part_sb_field - Object methods for part_sb_field records - -=head1 SYNOPSIS - - use FS::part_sb_field; - - $record = new FS::part_sb_field \%hash; - $record = new FS::part_sb_field { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::part_sb_field object represents an extended field (xfield) definition -for svc_broadband's sb_field mechanism (see L<FS::svc_broadband>). -FS::part_sb_field inherits from FS::Record. The following fields are -currently supported: - -=over 2 - -=item sbfieldpart - primary key (assigned automatically) - -=item name - name of the field - -=item svcpart - service type for which this field is available (see L<FS::part_svc>) - -=item length - length of the contents of the field (see note #1) - -=item check_block - validation routine (see note #2) - -=item list_source - enumeration routine (see note #3) - -=back - -=head1 BACKGROUND - -Broadband services, unlike dialup services, are provided over a wide -variety of physical media (DSL, wireless, cable modems, digital circuits) -and network architectures (Ethernet, PPP, ATM). For many of these access -mechanisms, adding a new customer requires knowledge of some properties -of the physical connection (circuit number, the type of CPE in use, etc.). -It is unreasonable to expect ISPs to alter Freeside's schema (and the -associated library and UI code) to make each of these parameters a field in -svc_broadband. - -Hence sb_field and part_sb_field. They allow the Freeside administrator to -define 'extended fields' ('xfields') associated with svc_broadband records. -These are I<not> processed in any way by Freeside itself; they exist solely for -use by exports (see L<FS::part_export>) and technical support staff. - -For a parallel mechanism (at the per-router level rather than per-service), -see L<FS::part_router_field>. - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Create a new record. To add the record to the database, see "insert". - -=cut - -sub table { 'part_sb_field'; } - -=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 = ''; - - $error = $self->ut_numbern('svcpart'); - return $error if $error; - - unless (qsearchs('part_svc', { svcpart => $self->svcpart })) - { return "Unknown svcpart: " . $self->svcpart;} - - $self->name =~ /^([a-z0-9_\-\.]{1,15})$/i - or return "Invalid field name for part_sb_field"; - - #How to check input_block, display_block, and check_block? - - ''; #no error -} - -=item list_values - -If the I<list_source> field is set, this method eval()s it and -returns its output. If the field is empty, list_values returns -an empty list. - -Any arguments passed to this method will be received by the list_source -code, but this behavior is a fortuitous accident and may be removed in -the future. - -=cut - -sub list_values { - my $self = shift; - return () unless $self->list_source; - - my @opts = eval($self->list_source); - if($@) { - warn $@; - return (); - } else { - return @opts; - } -} - -=item part_svc - -Returns the FS::part_svc object associated with this field definition. - -=cut - -sub part_svc { - my $self = shift; - return qsearchs('part_svc', { svcpart => $self->svcpart }); -} - -=back - -=head1 VERSION - -$Id: - -=head1 NOTES - -=over - -=item 1. - -The I<length> field is not enforced. It provides a hint to UI -code about how to display the field on a form. If you want to enforce a -minimum or maximum length for a field, use a I<check_block>. - -=item 2. - -The check_block mechanism used here as well as in -FS::part_router_field allows the user to define validation rules. - -When FS::sb_field::check is called, the proposed value of the xfield is -assigned to $_. The check_block is then eval()'d and its return value -captured. If the return value is false (empty/zero/undef), $_ is then assigned -back into the field and stored in the database. - -Therefore a check_block can do three different things with the value: allow -it, allow it with a modification, or reject it. This is very flexible, but -somewhat dangerous. Some warnings: - -=over 2 - -=item * - -Assume that $_ has had I<no> error checking prior to the -check_block. That's what the check_block is for, after all. It could -contain I<anything>: evil shell commands in backquotes, 100kb JPEG images, -the Klez virus, whatever. - -=item * - -If your check_block modifies the input value, it should probably -produce a value that wouldn't be modified by going through the same -check_block again. (That is, it should map input values into its own -eigenspace.) The reason is that if someone calls $new->replace($old), -where $new and $old contain the same value for the field, they probably -want the field to keep its old value, not to get transformed by the -check_block again. So don't do silly things like '$_++' or -'tr/A-Za-z/a-zA-Z/'. - -=item * - -Don't alter the contents of the database. I<Reading> the database -is perfectly reasonable, but writing to it is a bad idea. Remember that -check() might get called more than once, as described above. - -=item * - -The check_block probably won't even get called if the user submits -an I<empty> sb_field. So at present, you can't set up a default value with -something like 's/^$/foo/'. Conversely, don't replace the submitted value -with an empty string. It probably will get stored, but might be deleted at -any time. - -=back - -=item 3. - -The list_source mechanism is a UI hint (like length) to generate -drop-down or list boxes. If list_source contains a value, the UI code can -eval() it and use the results as the options on the list. - -Note 'can'. This is not a substitute for check_block. The HTML interface -currently requires that the user pick one of the options on the list -because that's the way HTML drop-down boxes work, but in the future the UI -code might add an 'Other (please specify)' option and a text box so that -the user can enter something else. Or it might ignore list_source and just -generate a text box. Or the interface might be rewritten in MS Access, -where drop-down boxes have text boxes built in. Data validation is the job -of check(), not the front end. - -Note also that a list of literals evaluates to itself, so a list_source -like - -C<('Windows', 'MacOS', 'Linux')> - -or - -C<qw(Windows MacOS Linux)> - -means exactly what you'd think. - -=head1 BUGS - -The lack of any way to do default values. We might add this as another UI -hint (since, for the most part, it's the UI's job to figure out which fields -have had values entered into them). In fact, there are lots of things we -should add as UI hints. - -Oh, and the documentation is probably full of lies. - -=head1 SEE ALSO - -FS::svc_broadband, FS::sb_field, schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm index 63bc2ad1c..552019acb 100644 --- a/FS/FS/part_svc.pm +++ b/FS/FS/part_svc.pm @@ -254,6 +254,31 @@ sub check { my @fields = eval { fields( $recref->{svcdb} ) }; #might die return "Unknown svcdb!" unless @fields; +##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 } @@ -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_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/pkg_svc.pm b/FS/FS/pkg_svc.pm index 3c544ffd8..1812dbf29 100644 --- a/FS/FS/pkg_svc.pm +++ b/FS/FS/pkg_svc.pm @@ -137,7 +137,7 @@ sub part_svc { =head1 VERSION -$Id: pkg_svc.pm,v 1.3 2002-06-10 01:39:50 khoff Exp $ +$Id: pkg_svc.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ =head1 BUGS diff --git a/FS/FS/router.pm b/FS/FS/router.pm deleted file mode 100755 index 3f9459a01..000000000 --- a/FS/FS/router.pm +++ /dev/null @@ -1,156 +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; - - ''; -} - -=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 router_field - -Returns a list of FS::router_field objects assigned to this object. - -=cut - -sub router_field { - my $self = shift; - - return qsearch('router_field', { 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::router_field, FS::part_svc, -schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/router_field.pm b/FS/FS/router_field.pm deleted file mode 100755 index eee21ab89..000000000 --- a/FS/FS/router_field.pm +++ /dev/null @@ -1,146 +0,0 @@ -package FS::router_field; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearchs ); -use FS::part_router_field; -use FS::router; - - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::router_field - Object methods for router_field records - -=head1 SYNOPSIS - - use FS::router_field; - - $record = new FS::router_field \%hash; - $record = new FS::router_field { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -FS::router_field contains values of router xfields. See FS::part_sb_field -for details on the xfield mechanism. - -=over 4 - -=item routerfieldpart - Type of router_field as defined by -FS::part_router_field - -=item routernum - The FS::router to which this value belongs. - -=item value - The contents of the field. - -=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_field'; } - -=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; - - return "routernum must be defined" unless $self->routernum; - return "routerfieldpart must be defined" unless $self->routerfieldpart; - - my $part_router_field = $self->part_router_field; - $_ = $self->value; - - my $check_block = $part_router_field->check_block; - if ($check_block) { - $@ = ''; - my $error = (eval($check_block) or $@); - return $error if $error; - $self->setfield('value' => $_); - } - - ''; #no error -} - -=item part_router_field - -Returns a reference to the FS:part_router_field that defines this -FS::router_field - -=cut - -sub part_router_field { - my $self = shift; - - return qsearchs('part_router_field', - { routerfieldpart => $self->routerfieldpart }); -} - -=item router - -Returns a reference to the FS::router to which this FS::router_field -belongs. - -=cut - -sub router { - my $self = shift; - - return qsearchs('router', { routernum => $self->routernum }); -} - -=back - -=head1 VERSION - -$Id: - -=head1 BUGS - -=head1 SEE ALSO - -FS::svc_broadband, FS::router, FS::router_block, FS::router_field, -schema.html from the base documentation. - -=cut - -1; - diff --git a/FS/FS/sb_field.pm b/FS/FS/sb_field.pm deleted file mode 100755 index d4eb37844..000000000 --- a/FS/FS/sb_field.pm +++ /dev/null @@ -1,148 +0,0 @@ -package FS::sb_field; - -use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearchs ); -use FS::part_sb_field; - -use UNIVERSAL qw( can ); - -@ISA = qw( FS::Record ); - -=head1 NAME - -FS::sb_field - Object methods for sb_field records - -=head1 SYNOPSIS - - use FS::sb_field; - - $record = new FS::sb_field \%hash; - $record = new FS::sb_field { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -See L<FS::part_sb_field> for details on this table's mission in life. -FS::sb_field contains the actual values of the xfields defined in -part_sb_field. - -The following fields are supported: - -=over 4 - -=item sbfieldpart - Type of sb_field as defined by FS::part_sb_field - -=item svcnum - The svc_broadband to which this value belongs. - -=item value - The contents of the field. - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Create a new record. To add the record to the database, see L<"insert">. - -=cut - -sub table { 'sb_field'; } - -=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 the value against the check_block of the corresponding part_sb_field. -Returns whatever the check_block returned (unless the check_block dies, in -which case check returns the die message). Therefore, if the check_block -wants to allow the value to be stored, it must return false. See -L<FS::part_sb_field> for details. - -=cut - -sub check { - my $self = shift; - - return "svcnum must be defined" unless $self->svcnum; - return "sbfieldpart must be defined" unless $self->sbfieldpart; - - my $part_sb_field = $self->part_sb_field; - - $_ = $self->value; - - my $check_block = $self->part_sb_field->check_block; - if ($check_block) { - $@ = ''; - my $error = (eval($check_block) or $@); # treat fatal errors as errors - return $error if $error; - $self->setfield('value' => $_); - } - - ''; #no error -} - -=item part_sb_field - -Returns a reference to the FS::part_sb_field that defines this FS::sb_field. - -=cut - -sub part_sb_field { - my $self = shift; - - return qsearchs('part_sb_field', { sbfieldpart => $self->sbfieldpart }); -} - -=back - -=item svc_broadband - -Returns a reference to the FS::svc_broadband to which this value is attached. -Nobody's ever going to use this function, but here it is anyway. - -=cut - -sub svc_broadband { - my $self = shift; - - return qsearchs('svc_broadband', { svcnum => $self->svcnum }); -} - -=head1 VERSION - -$Id: - -=head1 BUGS - -=head1 SEE ALSO - -L<FS::svc_broadband>, schema.html -from the base documentation. - -=cut - -1; - diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index e0c4662b2..1a36fa36a 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 @@ -18,9 +19,11 @@ use FS::UID qw( datasrc ); use FS::Conf; use FS::Record qw( qsearch qsearchs fields dbh ); 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 ( @@ -420,6 +424,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 an account which is a (svc_forward) source!" if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } ); @@ -785,7 +794,7 @@ sub check { unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) { unless ( $recref->{slipip} eq '0e0' ) { $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; } else { $recref->{slipip} = '0e0'; @@ -880,7 +889,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); @@ -898,10 +907,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 @@ -962,7 +975,7 @@ external SQL radacct table, specified via sqlradius export. Sessions which started in the specified range but are still open are counted from session start to the end of the range (unless they are over 1 day old, in which case they are presumed missing their stop record and not counted). Also, sessions -which end in therange but started earlier are counted from the start of the +which end in the range but started earlier are counted from the start of the range to session end. Finally, sessions which start before the range but end after are counted for the entire range. @@ -996,6 +1009,7 @@ sub attribute_since_sqlradacct { $self->cust_svc->attribute_since_sqlradacct(@_); } + =item radius_groups Returns all RADIUS groups for this account (see L<FS::radius_usergroup>). @@ -1202,7 +1216,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_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 45f6c3601..000000000 --- a/FS/FS/svc_broadband.pm +++ /dev/null @@ -1,288 +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 sb_field - -Returns a list of FS::sb_field objects assigned to this object. - -=cut - -sub sb_field { - my $self = shift; - - return qsearch( 'sb_field', { svcnum => $self->svcnum } ); -} - -=item sb_field_hashref - -Returns a hashref of the FS::sb_field key/value pairs for this object. - -Deprecated. Please don't use it. - -=cut - -# Kristian wrote this, but don't hold it against him. He was under a powerful -# distracting influence whom he evidently found much more interesting than -# svc_broadband.pm. I can't say I blame him. - -sub sb_field_hashref { - my $self = shift; - my $svcpart = shift; - - if ((not $svcpart) && ($self->cust_svc)) { - $svcpart = $self->cust_svc->svcpart; - } - - my $hashref = {}; - - map { - my $sb_field = qsearchs('sb_field', { sbfieldpart => $_->sbfieldpart, - svcnum => $self->svcnum }); - $hashref->{$_->getfield('name')} = $sb_field ? $sb_field->getfield('value') : ''; - } qsearch('part_sb_field', { svcpart => $svcpart }); - - return $hashref; - -} - -=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; - } - - - ''; #no error -} - -=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 - -I think there's one place in the code where we actually use sb_field_hashref. -That's a bug in itself. - -The real problem with it is that we're still grappling with the question of how -tightly xfields should be integrated with real fields. There are a few -different directions we could go with it--we I<could> override several -functions in Record so that xfields behave almost exactly like real fields (can -be set with setfield(), appear in fields() and hash(), used as criteria in -qsearch(), etc.). - -=head1 SEE ALSO - -FS::svc_Common, FS::Record, FS::addr_block, FS::sb_field, -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 3941d6eff..9a9f3b360 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -251,6 +251,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 } ); diff --git a/FS/FS/type_pkgs.pm b/FS/FS/type_pkgs.pm index efba60dbd..99a79b93f 100644 --- a/FS/FS/type_pkgs.pm +++ b/FS/FS/type_pkgs.pm @@ -111,7 +111,7 @@ sub part_pkg { =head1 VERSION -$Id: type_pkgs.pm,v 1.2 2002-10-04 12:57:06 ivan 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 32a4e4f59..df0ee0df6 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -9,11 +9,8 @@ bin/freeside-email bin/freeside-queued bin/freeside-addoutsource bin/freeside-addoutsourceuser -bin/freeside-deloutsource -bin/freeside-deloutsourceuser bin/freeside-apply-credits bin/freeside-adduser -bin/freeside-deluser bin/freeside-setup bin/freeside-setinvoice bin/freeside-overdue @@ -48,7 +45,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 @@ -90,17 +86,12 @@ FS/part_pop_local.pm FS/part_referral.pm FS/part_svc.pm FS/part_svc_column.pm -FS/part_router_field.pm -FS/part_sb_field.pm -FS/part_svc_router.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/router.pm -FS/router_field.pm FS/type_pkgs.pm FS/nas.pm FS/port.pm @@ -109,7 +100,6 @@ FS/domain_record.pm FS/prepay_credit.pm FS/svc_www.pm FS/svc_forward.pm -FS/sb_field.pm FS/raddb.pm FS/radius_usergroup.pm FS/queue.pm @@ -131,7 +121,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 @@ -179,6 +168,7 @@ t/radius_usergroup.t t/session.t t/svc_acct.t t/svc_acct_pop.t +t/svc_acct_sm.t t/svc_Common.t t/svc_domain.t t/svc_forward.t diff --git a/FS/bin/freeside-addoutsourceuser b/FS/bin/freeside-addoutsourceuser index 180cd9399..bbad8aa3f 100644 --- a/FS/bin/freeside-addoutsourceuser +++ b/FS/bin/freeside-addoutsourceuser @@ -11,5 +11,5 @@ freeside-adduser -h /usr/local/etc/freeside/htpasswd \ [ -e /usr/local/etc/freeside/dbdef.DBI:Pg:host=localhost\;dbname=$domain ] \ || ( freeside-setup $username 2>/dev/null; \ - /home/ivan/freeside/bin/populate-msgcat $username ) + /home/ivan/freeside/bin/populate-msgcat $username; 2>/dev/null ) 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-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 5399f6d22..2c89bef20 100755 --- a/FS/bin/freeside-expiration-alerter +++ b/FS/bin/freeside-expiration-alerter @@ -202,7 +202,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-expiration-alerter,v 1.4 2002-09-16 09:27:14 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-receivables-report b/FS/bin/freeside-receivables-report index f3ad2a1a6..033e83c52 100755 --- a/FS/bin/freeside-receivables-report +++ b/FS/bin/freeside-receivables-report @@ -192,7 +192,7 @@ user: From the mapsecrets file - see config.html from the base documentation =head1 VERSION -$Id: freeside-receivables-report,v 1.6 2002-09-09 22:57:34 ivan Exp $ +$Id: freeside-receivables-report,v 1.5.4.1 2002-09-09 22:57:32 ivan Exp $ =head1 BUGS diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index 010ec4c14..c91e816d1 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); @@ -329,7 +339,7 @@ sub tables_hash_hack { 'agent' => { 'columns' => [ - 'agentnum', 'serial', '', '', + 'agentnum', 'int', '', '', 'agent', 'varchar', '', $char_d, 'typenum', 'int', '', '', 'freq', 'int', 'NULL', '', @@ -342,7 +352,7 @@ sub tables_hash_hack { 'agent_type' => { 'columns' => [ - 'typenum', 'serial', '', '', + 'typenum', 'int', '', '', 'atype', 'varchar', '', $char_d, ], 'primary_key' => 'typenum', @@ -362,7 +372,7 @@ sub tables_hash_hack { 'cust_bill' => { 'columns' => [ - 'invnum', 'serial', '', '', + 'invnum', 'int', '', '', 'custnum', 'int', '', '', '_date', @date_type, 'charged', @money_type, @@ -376,7 +386,7 @@ sub tables_hash_hack { 'cust_bill_event' => { 'columns' => [ - 'eventnum', 'serial', '', '', + 'eventnum', 'int', '', '', 'invnum', 'int', '', '', 'eventpart', 'int', '', '', '_date', @date_type, @@ -391,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, @@ -414,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, ], @@ -450,7 +447,7 @@ sub tables_hash_hack { 'cust_credit_bill' => { 'columns' => [ - 'creditbillnum', 'serial', '', '', + 'creditbillnum', 'int', '', '', 'crednum', 'int', '', '', 'invnum', 'int', '', '', '_date', @date_type, @@ -463,7 +460,7 @@ sub tables_hash_hack { 'cust_main' => { 'columns' => [ - 'custnum', 'serial', '', '', + 'custnum', 'int', '', '', 'agentnum', 'int', '', '', # 'titlenum', 'int', 'NULL', '', 'last', 'varchar', '', $char_d, @@ -501,7 +498,7 @@ sub tables_hash_hack { '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', '', @@ -509,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, ], @@ -529,14 +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, ], 'primary_key' => 'taxnum', 'unique' => [], @@ -546,14 +540,14 @@ sub tables_hash_hack { 'cust_pay' => { 'columns' => [ - 'paynum', 'serial', '', '', + 'paynum', 'int', '', '', #now cust_bill_pay #'invnum', 'int', '', '', 'custnum', 'int', '', '', 'paid', @money_type, '_date', @date_type, 'payby', 'char', '', 4, # CARD/BILL/COMP, should be index into # payment type table. - 'payinfo', 'varchar', 'NULL', $char_d, #see cust_main above + 'payinfo', 'varchar', 'NULL', 16, #see cust_main above 'paybatch', 'varchar', 'NULL', $char_d, #for auditing purposes. 'closed', 'char', 'NULL', 1, ], @@ -564,7 +558,7 @@ sub tables_hash_hack { 'cust_bill_pay' => { 'columns' => [ - 'billpaynum', 'serial', '', '', + 'billpaynum', 'int', '', '', 'invnum', 'int', '', '', 'paynum', 'int', '', '', 'amount', @money_type, @@ -578,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, @@ -603,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, @@ -622,16 +615,16 @@ 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. - 'payinfo', 'varchar', 'NULL', $char_d, #see cust_main above + 'payinfo', 'varchar', 'NULL', 16, #see cust_main above 'paybatch', 'varchar', 'NULL', $char_d, 'closed', 'char', 'NULL', 1, ], @@ -642,7 +635,7 @@ sub tables_hash_hack { 'cust_credit_refund' => { 'columns' => [ - 'creditrefundnum', 'serial', '', '', + 'creditrefundnum', 'int', '', '', 'crednum', 'int', '', '', 'refundnum', 'int', '', '', 'amount', @money_type, @@ -656,7 +649,7 @@ sub tables_hash_hack { 'cust_svc' => { 'columns' => [ - 'svcnum', 'serial', '', '', + 'svcnum', 'int', '', '', 'pkgnum', 'int', 'NULL', '', 'svcpart', 'int', '', '', ], @@ -667,7 +660,7 @@ sub tables_hash_hack { 'part_pkg' => { 'columns' => [ - 'pkgpart', 'serial', '', '', + 'pkgpart', 'int', '', '', 'pkg', 'varchar', '', $char_d, 'comment', 'varchar', '', $char_d, 'setup', @perl_type, @@ -708,7 +701,7 @@ sub tables_hash_hack { 'part_referral' => { 'columns' => [ - 'refnum', 'serial', '', '', + 'refnum', 'int', '', '', 'referral', 'varchar', '', $char_d, ], 'primary_key' => 'refnum', @@ -718,7 +711,7 @@ sub tables_hash_hack { 'part_svc' => { 'columns' => [ - 'svcpart', 'serial', '', '', + 'svcpart', 'int', '', '', 'svc', 'varchar', '', $char_d, 'svcdb', 'varchar', '', $char_d, 'disabled', 'char', 'NULL', 1, @@ -730,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, @@ -744,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, @@ -758,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, @@ -793,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', '', '', @@ -816,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', 'char', '', 5, - #'recdata', 'varchar', '', $char_d, - 'recdata', 'varchar', '', 255, + 'recdata', 'varchar', '', $char_d, ], 'primary_key' => 'recnum', 'unique' => [], @@ -868,7 +871,7 @@ sub tables_hash_hack { 'prepay_credit' => { 'columns' => [ - 'prepaynum', 'serial', '', '', + 'prepaynum', 'int', '', '', 'identifier', 'varchar', '', $char_d, 'amount', @money_type, 'seconds', 'int', 'NULL', '', @@ -880,7 +883,7 @@ sub tables_hash_hack { 'port' => { 'columns' => [ - 'portnum', 'serial', '', '', + 'portnum', 'int', '', '', 'ip', 'varchar', 'NULL', 15, 'nasport', 'int', 'NULL', '', 'nasnum', 'int', '', '', @@ -892,7 +895,7 @@ sub tables_hash_hack { 'nas' => { 'columns' => [ - 'nasnum', 'serial', '', '', + 'nasnum', 'int', '', '', 'nas', 'varchar', '', $char_d, 'nasip', 'varchar', '', 15, 'nasfqdn', 'varchar', '', $char_d, @@ -905,7 +908,7 @@ sub tables_hash_hack { 'session' => { 'columns' => [ - 'sessionnum', 'serial', '', '', + 'sessionnum', 'int', '', '', 'portnum', 'int', '', '', 'svcnum', 'int', '', '', 'login', @date_type, @@ -918,7 +921,7 @@ sub tables_hash_hack { 'queue' => { 'columns' => [ - 'jobnum', 'serial', '', '', + 'jobnum', 'int', '', '', 'job', 'text', '', '', '_date', 'int', '', '', 'status', 'varchar', '', $char_d, @@ -932,7 +935,7 @@ sub tables_hash_hack { 'queue_arg' => { 'columns' => [ - 'argnum', 'serial', '', '', + 'argnum', 'int', '', '', 'jobnum', 'int', '', '', 'arg', 'text', 'NULL', '', ], @@ -943,7 +946,7 @@ sub tables_hash_hack { 'queue_depend' => { 'columns' => [ - 'dependnum', 'serial', '', '', + 'dependnum', 'int', '', '', 'jobnum', 'int', '', '', 'depend_jobnum', 'int', '', '', ], @@ -954,7 +957,7 @@ sub tables_hash_hack { 'export_svc' => { 'columns' => [ - 'exportsvcnum' => 'serial', '', '', + 'exportsvcnum' => 'int', '', '', 'exportnum' => 'int', '', '', 'svcpart' => 'int', '', '', ], @@ -965,7 +968,7 @@ sub tables_hash_hack { 'part_export' => { 'columns' => [ - 'exportnum', 'serial', '', '', + 'exportnum', 'int', '', '', #'svcpart', 'int', '', '', 'machine', 'varchar', '', $char_d, 'exporttype', 'varchar', '', $char_d, @@ -978,7 +981,7 @@ sub tables_hash_hack { 'part_export_option' => { 'columns' => [ - 'optionnum', 'serial', '', '', + 'optionnum', 'int', '', '', 'exportnum', 'int', '', '', 'optionname', 'varchar', '', $char_d, 'optionvalue', 'text', 'NULL', '', @@ -990,7 +993,7 @@ sub tables_hash_hack { 'radius_usergroup' => { 'columns' => [ - 'usergroupnum', 'serial', '', '', + 'usergroupnum', 'int', '', '', 'svcnum', 'int', '', '', 'groupname', 'varchar', '', $char_d, ], @@ -1001,7 +1004,7 @@ sub tables_hash_hack { 'msgcat' => { 'columns' => [ - 'msgnum', 'serial', '', '', + 'msgnum', 'int', '', '', 'msgcode', 'varchar', '', $char_d, 'locale', 'varchar', '', 16, 'msg', 'text', '', '', @@ -1013,7 +1016,7 @@ sub tables_hash_hack { 'cust_tax_exempt' => { 'columns' => [ - 'exemptnum', 'serial', '', '', + 'exemptnum', 'int', '', '', 'custnum', 'int', '', '', 'taxnum', 'int', '', '', 'year', 'int', '', '', @@ -1025,100 +1028,7 @@ sub tables_hash_hack { 'index' => [], }, - 'router' => { - 'columns' => [ - 'routernum', 'serial', '', '', - 'routername', 'varchar', '', $char_d, - 'svcnum', 'int', '0', '', - ], - 'primary_key' => 'routernum', - 'unique' => [], - 'index' => [], - }, - 'part_svc_router' => { - 'columns' => [ - 'svcpart', 'int', '', '', - 'routernum', 'int', '', '', - ], - 'primary_key' => '', - 'unique' => [], - 'index' => [], - }, - - 'part_router_field' => { - 'columns' => [ - 'routerfieldpart', 'serial', '', '', - 'name', 'varchar', '', $char_d, - 'length', 'int', '', '', - 'check_block', 'text', 'NULL', '', - 'list_source', 'text', 'NULL', '', - ], - 'primary_key' => 'routerfieldpart', - 'unique' => [], - 'index' => [], - }, - - 'router_field' => { - 'columns' => [ - 'routerfieldpart', 'int', '', '', - 'routernum', 'int', '', '', - 'value', 'varchar', '', 128, - ], - 'primary_key' => '', - 'unique' => [ [ 'routerfieldpart', 'routernum' ] ], - 'index' => [], - }, - - 'addr_block' => { - 'columns' => [ - 'blocknum', 'int', '', '', - 'routernum', 'int', '', '', - 'ip_gateway', 'varchar', '', 15, - 'ip_netmask', 'int', '', '', - ], - 'primary_key' => 'blocknum', - 'unique' => [ [ 'blocknum', 'routernum' ] ], - 'index' => [], - }, - - 'part_sb_field' => { - 'columns' => [ - 'sbfieldpart', 'int', '', '', - 'svcpart', 'int', '', '', - 'name', 'varchar', '', $char_d, - 'length', 'int', '', '', - 'check_block', 'text', 'NULL', '', - 'list_source', 'text', 'NULL', '', - ], - 'primary_key' => 'sbfieldpart', - 'unique' => [ [ 'sbfieldpart', 'svcpart' ] ], - 'index' => [], - }, - - 'sb_field' => { - 'columns' => [ - 'sbfieldpart', 'int', '', '', - 'svcnum', 'int', '', '', - 'value', 'varchar', '', 128, - ], - 'primary_key' => '', - 'unique' => [ [ 'sbfieldpart', 'svcnum' ] ], - 'index' => [], - }, - - 'svc_broadband' => { - 'columns' => [ - 'svcnum', 'int', '', '', - 'blocknum', 'int', '', '', - 'speed_up', 'int', '', '', - 'speed_down', 'int', '', '', - 'ip_addr', 'varchar', '', 15, - ], - '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/svc_acct_sm.t index ea6e3d125..1082f2cdb 100644 --- a/FS/t/cust_bill_pkg_detail.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::cust_bill_pkg_detail; +use FS::svc_acct_sm; $loaded=1; print "ok 1\n"; |