From: ivan Date: Tue, 29 Dec 1998 11:59:58 +0000 (+0000) Subject: mostly properly OO, some work still to be done with svc_ stuff X-Git-Tag: freeside_1_2_0~92 X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=commitdiff_plain;h=1f2d8690193476319d61b20b78461eb1a3ff106e mostly properly OO, some work still to be done with svc_ stuff --- diff --git a/TODO b/TODO index 24461b621..5c8e02cef 100644 --- a/TODO +++ b/TODO @@ -1,4 +1,4 @@ -$Id: TODO,v 1.16 1998-12-16 05:38:39 ivan Exp $ +$Id: TODO,v 1.17 1998-12-29 11:59:32 ivan Exp $ If you are interested in helping with any of these, please join the mailing list (send a blank message to ivan-freeside-subscribe@sisd.com) to avoid @@ -6,6 +6,14 @@ duplication of effort. -- 1.1.x -- +check all .pm's for numeric comparisons done as `eq' + +FS::cust_pkg _require_'s FS::$svc, but this won't work with %FS::UID::callback +loading of configuration. (pry need same idea, but will run immediately if +context allows). Looks like error is masked by 'use FS::cust_svc' which in +turn 'use's FS::{svc_acct, svc_acct_sm, svc_domain}' which is now explicit +w/comments in source + int'l stuff in web interface (not on david's time) admin web interface for titles (Dr., Mrs.) and default in fs-setup diff --git a/site_perl/Record.pm b/site_perl/Record.pm index b8d565cd9..0f098b471 100644 --- a/site_perl/Record.pm +++ b/site_perl/Record.pm @@ -26,7 +26,7 @@ FS::Record - Database record objects =head1 SYNOPSIS use FS::Record; - use FS::Record qw(dbh fields hfields qsearch qsearchs dbdef); + use FS::Record qw(dbh fields qsearch qsearchs dbdef); $record = new FS::Record 'table', \%hash; $record = new FS::Record 'table', { 'column' => 'value', ... }; @@ -51,11 +51,14 @@ FS::Record - Database record objects $hashref = $record->hashref; - $error = $record->add; + $error = $record->insert; + #$error = $record->add; #depriciated - $error = $record->del; + $error = $record->delete; + #$error = $record->del; #depriciated - $error = $new_record->rep($old_record); + $error = $new_record->replace($old_record); + #$error = $new_record->rep($old_record); #depriciated $value = $record->unique('column'); @@ -80,7 +83,8 @@ FS::Record - Database record objects $fields = hfields('table'); if ( $fields->{Field} ) { # etc. - @fields = fields 'table'; + @fields = fields 'table'; #as a subroutine + @fields = $record->fields; #as a method call =head1 DESCRIPTION @@ -89,64 +93,57 @@ FS::Record - Database record objects implemented on top of DBI. FS::Record is intended as a base class for table-specific classes to inherit from, i.e. FS::cust_main. -=head1 METHODS +=head1 CONSTRUCTORS =over 4 -=item new TABLE, HASHREF +=item new [ TABLE, ] HASHREF Creates a new record. It doesn't store it in the database, though. See -L<"add"> for that. +L<"insert"> for that. Note that the object stores this hash reference, not a distinct copy of the hash it points to. You can ask the object for a copy with the I method. +TABLE can only be omitted when a dervived class overrides the table method. + =cut sub new { - my($proto,$table,$hashref) = @_; - confess "Second arguement to FS::Record->new is not a HASH ref: ", - ref($hashref), " ", $hashref, "\n" - unless ref($hashref) eq 'HASH'; #bad practice? + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + bless ($self, $class); - #check to make sure $table exists? (ask dbdef) + $self->{'Table'} = shift unless defined ( $self->table ); - foreach my $field ( FS::Record::fields $table ) { - $hashref->{$field}='' unless defined $hashref->{$field}; - } + my $hashref = $self->{'Hash'} = shift; - # mySQL must rtrim the inbound text strings or store them z-terminated - # I simulate this for Postgres below - # Turned off in favor of ChopBlanks in UID.pm (see man DBI) - #if (datasrc =~ m/Pg/) - #{ - # foreach my $index (keys %$hashref) - # { - # $$hashref{$index} = unpack("A255", $$hashref{$index}) - # if ($$hashref{$index} =~ m/ $/) ; - # } - #} - - foreach my $column ( FS::Record::fields $table ) { - #trim the '$' from money fields for Pg (beong HERE?) + foreach my $field ( $self->fields ) { + $hashref->{$field}='' unless defined $hashref->{$field}; + #trim the '$' from money fields for Pg (belong HERE?) #(what about Pg i18n?) if ( datasrc =~ m/Pg/ - && $dbdef->table($table)->column($column)->type eq 'money' ) { - ${$hashref}{$column} =~ s/^\$//; + && $self->dbdef_table->column($field)->type eq 'money' ) { + ${$hashref}{$field} =~ s/^\$//; } - #foreach my $column ( grep $dbdef->table($table)->column($_)->type eq 'money', keys %{$hashref} ) { - # ${$hashref}{$column} =~ s/^\$//; - #} } - my $class = ref($proto) || $proto; - my $self = { 'Table' => $table, - 'Hash' => $hashref, - }; + $self; +} +sub create { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; bless ($self, $class); - + if ( defined $self->table ) { + cluck "create constructor is depriciated, use new!"; + $self->new(@_); + } else { + croak "FS::Record::create called (not from a subclass)!"; + } } =item qsearch TABLE, HASHREF @@ -158,8 +155,6 @@ objects. =cut -# Usage: @records = &FS::Search::qsearch($table,\%hash); -# Each element of @records is a FS::Record object. sub qsearch { my($table,$record) = @_; my($dbh) = dbh; @@ -181,7 +176,7 @@ sub qsearch { if ( eval ' scalar(@FS::'. $table. '::ISA);' ) { map { - eval 'create FS::'. $table. ' ( $sth->fetchrow_hashref );'; + eval 'new FS::'. $table. ' ( $sth->fetchrow_hashref );'; } ( 1 .. $sth->execute ); } else { cluck "qsearch: warning: FS::$table not loaded; returning generic FS::Record objects"; @@ -202,11 +197,17 @@ for a single item, or your data is corrupted. sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash); my(@result) = qsearch(@_); - carp "Multiple records in scalar search!" if scalar(@result) > 1; + carp "warning: Multiple records in scalar search!" if scalar(@result) > 1; #should warn more vehemently if the search was on a primary key? $result[0]; } +=back + +=head1 METHODS + +=over 4 + =item table Returns the table name. @@ -214,7 +215,8 @@ Returns the table name. =cut sub table { - my($self) = @_; +# cluck "warning: FS::Record::table depriciated; supply one in subclass!"; + my $self = shift; $self -> {'Table'}; } @@ -246,7 +248,8 @@ sub get { } } sub getfield { - get(@_); + my $self = shift; + $self->get(@_); } =item set, setfield COLUMN, VALUE @@ -260,7 +263,8 @@ sub set { $self->{'Hash'}->{$field} = $value; } sub setfield { - set(@_); + my $self = shift; + $self->set(@_); } =item AUTLOADED METHODS @@ -308,41 +312,41 @@ sub hashref { $self->{'Hash'}; } -=item add +=item insert -Adds this record to the database. If there is an error, returns the error, +Inserts this record to the database. If there is an error, returns the error, otherwise returns false. =cut -sub add { - my($self) = @_; - my($dbh)=dbh; - my($table)=$self->table; +sub insert { + my $self = shift; + + my $error = $self->check; + return $error if $error; #single-field unique keys are given a value if false #(like MySQL's AUTO_INCREMENT) - foreach ( $dbdef->table($table)->unique->singles ) { + foreach ( $self->dbdef_table->unique->singles ) { $self->unique($_) unless $self->getfield($_); } #and also the primary key - my($primary_key)=$dbdef->table($table)->primary_key; + my $primary_key = $self->dbdef_table->primary_key; $self->unique($primary_key) if $primary_key && ! $self->getfield($primary_key); - my (@fields) = + my @fields = grep defined($self->getfield($_)) && $self->getfield($_) ne "", - fields($table) + $self->fields ; - my($sth); - my($statement)="INSERT INTO $table ( ". + my $statement = "INSERT INTO ". $self->table. " ( ". join(', ',@fields ). ") VALUES (". - join(', ',map(_quote($self->getfield($_),$table,$_), @fields)). + join(', ',map(_quote($self->getfield($_),$self->table,$_), @fields)). ")" ; - $sth = $dbh->prepare($statement) or return $dbh->errstr; + my $sth = dbh->prepare($statement) or return dbh->errstr; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -355,29 +359,37 @@ sub add { ''; } -=item del +=item add + +Depriciated (use insert instead). + +=cut + +sub add { + cluck "warning: FS::Record::add depriciated!"; + insert @_; #call method in this scope +} + +=item delete Delete this record from the database. If there is an error, returns the error, otherwise returns false. =cut -sub del { - my($self) = @_; - my($dbh)=dbh; - my($table)=$self->table; +sub delete { + my $self = shift; - my($sth); - my($statement)="DELETE FROM $table WHERE ". join(' AND ', + my($statement)="DELETE FROM ". $self->table. " WHERE ". join(' AND ', map { $self->getfield($_) eq '' ? "$_ IS NULL" - : "$_ = ". _quote($self->getfield($_),$table,$_) - } ( $dbdef->table($table)->primary_key ) - ? ($dbdef->table($table)->primary_key) - : fields($table) + : "$_ = ". _quote($self->getfield($_),$self->table,$_) + } ( $self->dbdef_table->primary_key ) + ? ( $self->dbdef_table->primary_key) + : $self->fields ); - $sth = $dbh->prepare($statement) or return $dbh->errstr; + my $sth = dbh->prepare($statement) or return dbh->errstr; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -385,8 +397,7 @@ sub del { local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; - my($rc); - $rc=$sth->execute or return $sth->errstr; + my $rc = $sth->execute or return $sth->errstr; #not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0"; undef $self; #no need to keep object! @@ -394,48 +405,57 @@ sub del { ''; } -=item rep OLD_RECORD +=item del + +Depriciated (use delete instead). + +=cut + +sub del { + cluck "warning: FS::Record::del depriciated!"; + &delete(@_); #call method in this scope +} + +=item replace OLD_RECORD Replace the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. =cut -sub rep { - my($new,$old)=@_; - my($dbh)=dbh; - my($table)=$old->table; - my(@fields)=fields($table); - my(@diff)=grep $new->getfield($_) ne $old->getfield($_), @fields; +sub replace { + my ( $new, $old ) = ( shift, shift ); - if ( scalar(@diff) == 0 ) { + my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields; + unless ( @diff ) { carp "warning: records identical"; return ''; } - return "Records not in same table!" unless $new->table eq $table; + return "Records not in same table!" unless $new->table eq $old->table; - my($sth); - my($statement)="UPDATE $table SET ". join(', ', + my $primary_key = $old->dbdef_table->primary_key; + return "Can't change $primary_key" + if $primary_key + && ( $old->getfield($primary_key) ne $new->getfield($primary_key) ); + + my $error = $new->check; + return $error if $error; + + my $statement = "UPDATE ". $old->table. " SET ". join(', ', map { - "$_ = ". _quote($new->getfield($_),$table,$_) + "$_ = ". _quote($new->getfield($_),$old->table,$_) } @diff ). ' WHERE '. join(' AND ', map { $old->getfield($_) eq '' ? "$_ IS NULL" - : "$_ = ". _quote($old->getfield($_),$table,$_) -# } @fields -# } ( primary_key($table) ? (primary_key($table)) : @fields ) - } ( $dbdef->table($table)->primary_key - ? ($dbdef->table($table)->primary_key) - : @fields - ) + : "$_ = ". _quote($old->getfield($_),$old->table,$_) + } ( $primary_key ? ( $primary_key ) : $old->fields ) ) ; - #warn $statement; - $sth = $dbh->prepare($statement) or return $dbh->errstr; + my $sth = dbh->prepare($statement) or return dbh->errstr; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -443,14 +463,34 @@ sub rep { local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; - my($rc); - $rc=$sth->execute or return $sth->errstr; + my $rc = $sth->execute or return $sth->errstr; #not portable #return "Record not found (or records identical)." if $rc eq "0E0"; ''; } +=item rep + +Depriciated (use replace instead). + +=cut + +sub rep { + cluck "warning: FS::Record::rep depriciated!"; + replace @_; #call method in this scope +} + +=item check + +Not yet implemented, croaks. Derived classes should provide a check method. + +=cut + +sub check { + croak "FS::Record::check not implemented; supply one in subclass!"; +} + =item unique COLUMN Replaces COLUMN in record with a unique number. Called by the B method @@ -655,6 +695,29 @@ sub ut_anything { ''; } +=item fields [ TABLE ] + +This can be used as both a subroutine and a method call. It returns a list +of the columns in this record's table, or an explicitly specified table. +(See L). + +=cut + +# Usage: @fields = fields($table); +# @fields = $record->fields; +sub fields { + my $something = shift; + my $table; + if ( ref($something) ) { + $table = $something->table; + } else { + $table = $something; + } + #croak "Usage: \@fields = fields(\$table)\n or: \@fields = \$record->fields" unless $table; + my($table_obj) = $dbdef->table($table); + croak "Unknown table $table" unless $table_obj; + $table_obj->columns; +} =head1 SUBROUTINES @@ -711,7 +774,7 @@ It returns a hash-type list with the fields of this record's table set true. =cut sub hfields { - carp "hfields is depriciated"; + carp "warning: hfields is depriciated"; my($table)=@_; my(%hash); foreach (fields($table)) { @@ -720,23 +783,6 @@ sub hfields { \%hash; } -=item fields TABLE - -This returns a list of the columns in this record's table -(See L). - -=cut - -# Usage: @fields = fields($table); -sub fields { - my($table) = @_; - #my(@fields) = $dbdef->table($table)->columns; - croak "Usage: \@fields = fields(\$table)" unless $table; - my($table_obj) = $dbdef->table($table); - croak "Unknown table $table" unless $table_obj; - $table_obj->columns; -} - #sub _dump { # my($self)=@_; # join("\n", map { @@ -759,7 +805,7 @@ sub fields { =head1 VERSION -$Id: Record.pm,v 1.9 1998-11-21 07:26:45 ivan Exp $ +$Id: Record.pm,v 1.10 1998-12-29 11:59:33 ivan Exp $ =head1 BUGS @@ -795,6 +841,9 @@ The _quote function should probably use ut_float instead of a regex. All the subroutines probably should be methods, here or elsewhere. +Probably should borrow/use some dbdef methods where appropriate (like sub +fields) + =head1 SEE ALSO L, L, L @@ -878,7 +927,10 @@ added pod documentation ivan@sisd.com 98-sep-6 ut_phonen got ''; at the end ivan@sisd.com 98-sep-27 $Log: Record.pm,v $ -Revision 1.9 1998-11-21 07:26:45 ivan +Revision 1.10 1998-12-29 11:59:33 ivan +mostly properly OO, some work still to be done with svc_ stuff + +Revision 1.9 1998/11/21 07:26:45 ivan "Records identical" carp tells us it is just a warning. Revision 1.8 1998/11/15 11:02:04 ivan diff --git a/site_perl/agent.pm b/site_perl/agent.pm index ab06f6798..7632d2fca 100644 --- a/site_perl/agent.pm +++ b/site_perl/agent.pm @@ -1,14 +1,12 @@ package FS::agent; use strict; -use vars qw(@ISA @EXPORT_OK); -use Exporter; -use FS::Record qw(fields qsearch qsearchs); +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs); use FS::cust_main; use FS::agent_type; -@ISA = qw(FS::Record Exporter); -@EXPORT_OK = qw(fields); +@ISA = qw( FS::Record ); =head1 NAME @@ -18,8 +16,8 @@ FS::agent - Object methods for agent records use FS::agent; - $record = create FS::agent \%hash; - $record = create FS::agent { 'column' => 'value' }; + $record = new FS::agent \%hash; + $record = new FS::agent { 'column' => 'value' }; $error = $record->insert; @@ -53,38 +51,19 @@ from FS::Record. The following fields are currently supported: =over 4 -=item create HASHREF +=item new HASHREF Creates a new agent. To add the agent to the database, see L<"insert">. =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my($field); - #foreach $field (fields('agent')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('agent',$hashref); -} +sub table { 'agent'; } =item insert Adds this agent to the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub insert { - my($self)=@_; - - $self->check or - $self->add; -} - =item delete Deletes this agent from the database. Only agents with no customers can be @@ -93,10 +72,12 @@ deleted. If there is an error, returns the error, otherwise returns false. =cut sub delete { - my($self)=@_; + my $self = shift; + return "Can't delete an agent with customers!" - if qsearch('cust_main',{'agentnum' => $self->agentnum}); - $self->del; + if qsearch( 'cust_main', { 'agentnum' => $self->agentnum } ); + + $self->SUPER::delete; } =item replace OLD_RECORD @@ -104,17 +85,6 @@ sub delete { 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)=@_; - return "(Old) Not an agent record!" unless $old->table eq "agent"; - return "Can't change agentnum!" - unless $old->getfield('agentnum') eq $new->getfield('agentnum'); - $new->check or - $new->rep($old); -} - =item check Checks all fields to make sure this is a valid agent. If there is an error, @@ -124,20 +94,19 @@ methods. =cut sub check { - my($self)=@_; - return "Not a agent record!" unless $self->table eq "agent"; + my $self = shift; - my($error)= + my $error = $self->ut_numbern('agentnum') - or $self->ut_text('agent') - or $self->ut_number('typenum') - or $self->ut_numbern('freq') - or $self->ut_textn('prog') + || $self->ut_text('agent') + || $self->ut_number('typenum') + || $self->ut_numbern('freq') + || $self->ut_textn('prog') ; return $error if $error; return "Unknown typenum!" - unless qsearchs('agent_type',{'typenum'=> $self->getfield('typenum') }); + unless qsearchs( 'agent_type', { 'typenum' => $self->typenum } ); ''; @@ -145,9 +114,11 @@ sub check { =back -=head1 BUGS +=head1 VERSION -It doesn't properly override FS::Record yet. +$Id: agent.pm,v 1.3 1998-12-29 11:59:34 ivan Exp $ + +=head1 BUGS =head1 SEE ALSO diff --git a/site_perl/agent_type.pm b/site_perl/agent_type.pm index 002c36f54..54a91c8bf 100644 --- a/site_perl/agent_type.pm +++ b/site_perl/agent_type.pm @@ -1,12 +1,10 @@ package FS::agent_type; use strict; -use vars qw(@ISA @EXPORT_OK); -use Exporter; -use FS::Record qw(qsearch fields); +use vars qw( @ISA ); +use FS::Record qw( qsearch ); -@ISA = qw(FS::Record Exporter); -@EXPORT_OK = qw(fields); +@ISA = qw( FS::Record ); =head1 NAME @@ -16,8 +14,8 @@ FS::agent_type - Object methods for agent_type records use FS::agent_type; - $record = create FS::agent_type \%hash; - $record = create FS::agent_type { 'column' => 'value' }; + $record = new FS::agent_type \%hash; + $record = new FS::agent_type { 'column' => 'value' }; $error = $record->insert; @@ -47,40 +45,20 @@ FS::Record. The following fields are currently supported: =over 4 -=item create HASHREF +=item new HASHREF Creates a new agent type. To add the agent type to the database, see L<"insert">. =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my($field); - #foreach $field (fields('agent_type')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('agent_type',$hashref); - -} +sub table { 'agent_type'; } =item insert Adds this agent type to the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub insert { - my($self)=@_; - - $self->check or - $self->add; -} - =item delete Deletes this agent type from the database. Only agent types with no agents @@ -90,10 +68,12 @@ false. =cut sub delete { - my($self)=@_; + my $self = shift; + return "Can't delete an agent_type with agents!" - if qsearch('agent',{'typenum' => $self->typenum}); - $self->del; + if qsearch( 'agent', { 'typenum' => $self->typenum } ); + + $self->SUPER::delete; } =item replace OLD_RECORD @@ -101,17 +81,6 @@ sub delete { 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)=@_; - return "(Old) Not a agent_type record!" unless $old->table eq "agent_type"; - return "Can't change typenum!" - unless $old->getfield('typenum') eq $new->getfield('typenum'); - $new->check or - $new->rep($old); -} - =item check Checks all fields to make sure this is a valid agent type. If there is an @@ -121,8 +90,7 @@ replace methods. =cut sub check { - my($self)=@_; - return "Not a agent_type record!" unless $self->table eq "agent_type"; + my $self = shift; $self->ut_numbern('typenum') or $self->ut_text('atype'); @@ -131,9 +99,11 @@ sub check { =back -=head1 BUGS +=head1 VERSION + +$Id: agent_type.pm,v 1.2 1998-12-29 11:59:35 ivan Exp $ -It doesn't properly override FS::Record yet. +=head1 BUGS =head1 SEE ALSO @@ -155,6 +125,11 @@ Changed 'type' to 'atype' because Pg6.3 reserves the type word pod, added check in delete ivan@sisd.com 98-sep-21 +$Log: agent_type.pm,v $ +Revision 1.2 1998-12-29 11:59:35 ivan +mostly properly OO, some work still to be done with svc_ stuff + + =cut 1; diff --git a/site_perl/cust_bill.pm b/site_perl/cust_bill.pm index 455fc2d4f..3706aa4bf 100644 --- a/site_perl/cust_bill.pm +++ b/site_perl/cust_bill.pm @@ -1,12 +1,16 @@ package FS::cust_bill; use strict; -use vars qw(@ISA $conf $add1 $add2 $add3 $add4); -use Exporter; +use vars qw( @ISA $conf $add1 $add2 $add3 $add4 ); use Date::Format; -use FS::Record qw(fields qsearch qsearchs); +use FS::Record qw( qsearch qsearchs ); +use FS::cust_main; +use FS::cust_bill_pkg; +use FS::cust_credit; +use FS::cust_pay; +use FS::cust_pkg; -@ISA = qw(FS::Record Exporter); +@ISA = qw( FS::Record ); #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::cust_bill'} = sub { @@ -22,8 +26,8 @@ FS::cust_bill - Object methods for cust_bill records use FS::cust_bill; - $record = create FS::cust_bill \%hash; - $record = create FS::cust_bill { 'column' => 'value' }; + $record = new FS::cust_bill \%hash; + $record = new FS::cust_bill { 'column' => 'value' }; $error = $record->insert; @@ -72,7 +76,7 @@ all payments (see L). =over 4 -=item create HASHREF +=item new HASHREF Creates a new invoice. To add the invoice to the database, see L<"insert">. Invoices are normally created by calling the bill method of a customer object @@ -80,17 +84,7 @@ Invoices are normally created by calling the bill method of a customer object =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my($field); - #foreach $field (fields('cust_bill')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('cust_bill',$hashref); -} +sub table { 'cust_bill'; } =item insert @@ -103,14 +97,13 @@ automatically set to charged). =cut sub insert { - my($self)=@_; + my $self = shift; - $self->setfield('owed',$self->charged) if $self->owed eq ''; + $self->owed( $self->charged ) if $self->owed eq ''; return "owed != charged!" unless $self->owed == $self->charged; - $self->check or - $self->add; + $self->SUPER::insert; } =item delete @@ -122,8 +115,6 @@ no record you ever posted this invoice (which is bad, no?) sub delete { return "Can't remove invoice!" - #my($self)=@_; - #$self->del; } =item replace OLD_RECORD @@ -138,21 +129,13 @@ calling the collect method of a customer object (see L). =cut sub replace { - my($new,$old)=@_; - return "(Old) Not a cust_bill record!" unless $old->table eq "cust_bill"; - return "Can't change invnum!" - unless $old->getfield('invnum') eq $new->getfield('invnum'); - return "Can't change custnum!" - unless $old->getfield('custnum') eq $new->getfield('custnum'); - return "Can't change _date!" - unless $old->getfield('_date') eq $new->getfield('_date'); - return "Can't change charged!" - unless $old->getfield('charged') eq $new->getfield('charged'); - return "(New) owed can't be > (new) charged!" - if $new->getfield('owed') > $new->getfield('charged'); - - $new->check or - $new->rep($old); + my( $new, $old ) = ( shift, shift ); + return "Can't change custnum!" unless $old->custnum eq $new->custnum; + return "Can't change _date!" unless $old->_date eq $new->_date; + return "Can't change charged!" unless $old->charged eq $new->charged; + return "(New) owed can't be > (new) charged!" if $new->owed > $new->charged; + + $new->SUPER::replace($old); } =item check @@ -164,30 +147,24 @@ methods. =cut sub check { - my($self)=@_; - return "Not a cust_bill record!" unless $self->table eq "cust_bill"; - my($recref) = $self->hashref; - - $recref->{invnum} =~ /^(\d*)$/ or return "Illegal invnum"; - $recref->{invnum} = $1; + my $self = shift; + + my $error = + $self->ut_numbern('invnum') + || $self->ut_number('custnum') + || $self->ut_numbern('_date') + || $self->ut_money('charged') + || $self->ut_money('owed') + || $self->ut_numbern('printed') + ; + return $error if $error; - $recref->{custnum} =~ /^(\d+)$/ or return "Illegal custnum"; - $recref->{custnum} = $1; return "Unknown customer" - unless qsearchs('cust_main',{'custnum'=>$recref->{custnum}}); + unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); - $recref->{_date} =~ /^(\d*)$/ or return "Illegal date"; - $recref->{_date} = $recref->{_date} ? $1 : time; + $self->_date(time) unless $self->_date; - #$recref->{charged} =~ /^(\d+(\.\d\d)?)$/ or return "Illegal charged"; - $recref->{charged} =~ /^(\-?\d+(\.\d\d)?)$/ or return "Illegal charged"; - $recref->{charged} = $1; - - $recref->{owed} =~ /^(\-?\d+(\.\d\d)?)$/ or return "Illegal owed"; - $recref->{owed} = $1; - - $recref->{printed} =~ /^(\d*)$/ or return "Illegal printed"; - $recref->{printed} = $1 || '0'; + $self->printed(0) if $self->printed eq ''; ''; #no error } @@ -200,13 +177,13 @@ followed by the previous outstanding invoices (as FS::cust_bill objects also). =cut sub previous { - my($self)=@_; - my($total)=0; - my(@cust_bill) = sort { $a->_date <=> $b->_date } + my $self = shift; + my $total = 0; + my @cust_bill = sort { $a->_date <=> $b->_date } grep { $_->owed != 0 && $_->_date < $self->_date } - qsearch('cust_bill',{ 'custnum' => $self->custnum } ) + qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ; - foreach (@cust_bill) { $total += $_->owed; } + foreach ( @cust_bill ) { $total += $_->owed; } $total, @cust_bill; } @@ -217,7 +194,7 @@ Returns the line items (see L) for this invoice. =cut sub cust_bill_pkg { - my($self)=@_; + my $self = shift; qsearch( 'cust_bill_pkg', { 'invnum' => $self->invnum } ); } @@ -230,9 +207,9 @@ credits (FS::cust_credit objects). =cut sub cust_credit { - my($self)=@_; - my($total)=0; - my(@cust_credit) = sort { $a->_date <=> $b->date } + my $self = shift; + my $total = 0; + my @cust_credit = sort { $a->_date <=> $b->date } grep { $_->credited != 0 && $_->_date < $self->_date } qsearch('cust_credit', { 'custnum' => $self->custnum } ) ; @@ -247,7 +224,7 @@ Returns all payments (see L) for this invoice. =cut sub cust_pay { - my($self)=@_; + my $self = shift; sort { $a->_date <=> $b->date } qsearch( 'cust_pay', { 'invnum' => $self->invnum } ) ; @@ -266,27 +243,25 @@ L and L for conversion functions. sub print_text { - my($self,$today)=@_; + my( $self, $today ) = ( shift, shift ); $today ||= time; - my($invnum)=$self->invnum; - my($cust_main) = qsearchs('cust_main', - { 'custnum', $self->custnum } ); - $cust_main->setfield('payname', - $cust_main->first. ' '. $cust_main->getfield('last') - ) unless $cust_main->payname; + my $invnum = $self->invnum; + my $cust_main = qsearchs('cust_main', { 'custnum', $self->custnum } ); + $cust_main->payname( $cust_main->first. ' '. $cust_main->getfield('last') ) + unless $cust_main->payname; - my($pr_total,@pr_cust_bill) = $self->previous; #previous balance - my($cr_total,@cr_cust_credit) = $self->cust_credit; #credits - my($balance_due) = $self->owed + $pr_total - $cr_total; + my( $pr_total, @pr_cust_bill ) = $self->previous; #previous balance + my( $cr_total, @cr_cust_credit ) = $self->cust_credit; #credits + my $balance_due = $self->owed + $pr_total - $cr_total; #overdue? - my($overdue) = ( + my $overdue = ( $balance_due > 0 && $today > $self->_date && $self->printed > 1 ); - #printing bits here + #printing bits here (yuck!) local($SIG{CHLD}) = sub { wait() }; $|=1; @@ -459,12 +434,14 @@ $address[4],'' =back +=head1 VERSION + +$Id: cust_bill.pm,v 1.4 1998-12-29 11:59:36 ivan Exp $ + =head1 BUGS The delete method. -It doesn't properly override FS::Record yet. - print_text formatting (and some logic :/) is in source as a format declaration, which needs to be slurped in from a file. the fork is rather kludgy as well. It could be cleaned with swrite from man perlform, and the picture could be @@ -492,7 +469,10 @@ charges can be negative ivan@sisd.com 98-jul-13 pod, ingegrate with FS::Invoice ivan@sisd.com 98-sep-20 $Log: cust_bill.pm,v $ -Revision 1.3 1998-11-13 09:56:53 ivan +Revision 1.4 1998-12-29 11:59:36 ivan +mostly properly OO, some work still to be done with svc_ stuff + +Revision 1.3 1998/11/13 09:56:53 ivan change configuration file layout to support multiple distinct databases (with own set of config files, export, etc.) diff --git a/site_perl/cust_bill_pkg.pm b/site_perl/cust_bill_pkg.pm index e41d7c12c..a52539433 100644 --- a/site_perl/cust_bill_pkg.pm +++ b/site_perl/cust_bill_pkg.pm @@ -1,12 +1,12 @@ package FS::cust_bill_pkg; use strict; -use vars qw(@ISA @EXPORT_OK); -use Exporter; -use FS::Record qw(fields qsearchs); +use vars qw( @ISA ); +use FS::Record qw( qsearchs ); +use FS::cust_pkg; +use FS::cust_bill; -@ISA = qw(FS::Record Exporter); -@EXPORT_OK = qw(fields); +@ISA = qw(FS::Record ); =head1 NAME @@ -16,8 +16,8 @@ FS::cust_bill_pkg - Object methods for cust_bill_pkg records use FS::cust_bill_pkg; - $record = create FS::cust_bill_pkg \%hash; - $record = create FS::cust_bill_pkg { 'column' => 'value' }; + $record = new FS::cust_bill_pkg \%hash; + $record = new FS::cust_bill_pkg { 'column' => 'value' }; $error = $record->insert; @@ -56,7 +56,7 @@ see L and L for conversion functions. =over 4 -=item create HASHREF +=item new HASHREF Creates a new line item. To add the line item to the database, see L<"insert">. Line items are normally created by calling the bill method of a @@ -64,33 +64,13 @@ customer object (see L). =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my($field); - #foreach $field (fields('cust_bill_pkg')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('cust_bill_pkg',$hashref); - -} +sub table { 'cust_bill_pkg'; } =item insert Adds this line item to the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub insert { - my($self)=@_; - - $self->check or - $self->add; -} - =item delete Currently unimplemented. I don't remove line items because there would then be @@ -100,8 +80,6 @@ no record the items ever existed (which is bad, no?) sub delete { return "Can't delete cust_bill_pkg records!"; - #my($self)=@_; - #$self->del; } =item replace OLD_RECORD @@ -113,12 +91,6 @@ than deleteing the items. Just don't do it. sub replace { return "Can't modify cust_bill_pkg records!"; - #my($new,$old)=@_; - #return "(Old) Not a cust_bill_pkg record!" - # unless $old->table eq "cust_bill_pkg"; - # - #$new->check or - #$new->rep($old); } =item check @@ -130,35 +102,36 @@ method. =cut sub check { - my($self)=@_; - return "Not a cust_bill_pkg record!" unless $self->table eq "cust_bill_pkg"; + my $self = shift; - my($error)= + my $error = $self->ut_number('pkgnum') - or $self->ut_number('invnum') - or $self->ut_money('setup') - or $self->ut_money('recur') - or $self->ut_numbern('sdate') - or $self->ut_numbern('edate') + || $self->ut_number('invnum') + || $self->ut_money('setup') + || $self->ut_money('recur') + || $self->ut_numbern('sdate') + || $self->ut_numbern('edate') ; return $error if $error; if ( $self->pkgnum != 0 ) { #allow unchecked pkgnum 0 for tax! (add to part_pkg?) - return "Unknown pkgnum ".$self->pkgnum - unless qsearchs('cust_pkg',{'pkgnum'=> $self->pkgnum }); + return "Unknown pkgnum ". $self->pkgnum + unless qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); } return "Unknown invnum" - unless qsearchs('cust_bill',{'invnum'=> $self->invnum }); + unless qsearchs( 'cust_bill' ,{ 'invnum' => $self->invnum } ); ''; #no error } =back -=head1 BUGS +=head1 VERSION + +$Id: cust_bill_pkg.pm,v 1.2 1998-12-29 11:59:37 ivan Exp $ -It doesn't properly override FS::Record yet. +=head1 BUGS =head1 SEE ALSO diff --git a/site_perl/cust_credit.pm b/site_perl/cust_credit.pm index b1a5e1649..321c01b34 100644 --- a/site_perl/cust_credit.pm +++ b/site_perl/cust_credit.pm @@ -1,13 +1,12 @@ package FS::cust_credit; use strict; -use vars qw(@ISA @EXPORT_OK); -use Exporter; -use FS::UID qw(getotaker); -use FS::Record qw(fields qsearchs); +use vars qw( @ISA ); +use FS::UID qw( getotaker ); +use FS::Record qw( qsearchs ); +use FS::cust_main; -@ISA = qw(FS::Record Exporter); -@EXPORT_OK = qw(fields); +@ISA = qw( FS::Record ); =head1 NAME @@ -17,8 +16,8 @@ FS::cust_credit - Object methods for cust_credit records use FS::cust_credit; - $record = create FS::cust_credit \%hash; - $record = create FS::cust_credit { 'column' => 'value' }; + $record = new FS::cust_credit \%hash; + $record = new FS::cust_credit { 'column' => 'value' }; $error = $record->insert; @@ -57,23 +56,13 @@ L and L for conversion functions. =over 4 -=item create HASHREF +=item new HASHREF Creates a new credit. To add the credit to the database, see L<"insert">. =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my($field); - #foreach $field (fields('cust_credit')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('cust_credit',$hashref); -} +sub table { 'cust_credit'; } =item insert @@ -86,14 +75,13 @@ automatically set to amount). =cut sub insert { - my($self)=@_; + my $self = shift; - $self->setfield('credited',$self->amount) if $self->credited eq ''; + $self->credited($self->amount) if $self->credited eq ''; return "credited != amount!" unless $self->credited == $self->amount; - $self->check or - $self->add; + $self->SUPER::insert; } =item delete @@ -104,8 +92,6 @@ Currently unimplemented. sub delete { return "Can't remove credit!" - #my($self)=@_; - #$self->del; } =item replace OLD_RECORD @@ -119,21 +105,15 @@ inserting a refund (see L). =cut sub replace { - my($new,$old)=@_; - return "(Old) Not a cust_credit record!" unless $old->table eq "cust_credit"; - return "Can't change crednum!" - unless $old->getfield('crednum') eq $new->getfield('crednum'); - return "Can't change custnum!" - unless $old->getfield('custnum') eq $new->getfield('custnum'); - return "Can't change date!" - unless $old->getfield('_date') eq $new->getfield('_date'); - return "Can't change amount!" - unless $old->getfield('amount') eq $new->getfield('amount'); + my ( $new, $old ) = ( shift, shift ); + + return "Can't change custnum!" unless $old->custnum eq $new->custnum; + return "Can't change date!" unless $old->_date eq $new->_date; + return "Can't change amount!" unless $old->amount eq $new->amount; return "(New) credited can't be > (new) amount!" - if $new->getfield('credited') > $new->getfield('amount'); + if $new->credited > $new->amount; - $new->check or - $new->rep($old); + $new->SUPER::replace($old); } =item check @@ -145,43 +125,38 @@ methods. =cut sub check { - my($self)=@_; - return "Not a cust_credit record!" unless $self->table eq "cust_credit"; - my($recref) = $self->hashref; + my $self = shift; + + my $error = + $self->ut_numbern('crednum') + || $self->ut_number('custnum') + || $self->ut_numbern('_date') + || $self->ut_money('amount') + || $self->ut_money('credited') + || $self->ut_textn('reason'); + ; + return $error if $error; - $recref->{crednum} =~ /^(\d*)$/ or return "Illegal crednum"; - $recref->{crednum} = $1; - - $recref->{custnum} =~ /^(\d+)$/ or return "Illegal custnum"; - $recref->{custnum} = $1; return "Unknown customer" - unless qsearchs('cust_main',{'custnum'=>$recref->{custnum}}); - - $recref->{_date} =~ /^(\d*)$/ or return "Illegal date"; - $recref->{_date} = $recref->{_date} ? $1 : time; - - $recref->{amount} =~ /^(\d+(\.\d\d)?)$/ or return "Illegal amount"; - $recref->{amount} = $1; + unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); - $recref->{credited} =~ /^(\-?\d+(\.\d\d)?)$/ or return "Illegal credited"; - $recref->{credited} = $1; + $self->_date(time) unless $self->_date; - #$recref->{otaker} =~ /^(\w+)$/ or return "Illegal otaker"; - #$recref->{otaker} = $1; $self->otaker(getotaker); - $self->ut_textn('reason'); - + ''; #no error } =back +=head1 VERSION + +$Id: cust_credit.pm,v 1.2 1998-12-29 11:59:38 ivan Exp $ + =head1 BUGS The delete method. -It doesn't properly override FS::Record yet. - =head1 SEE ALSO L, L, L, schema.html from the base @@ -193,6 +168,11 @@ ivan@sisd.com 98-mar-17 pod, otaker from FS::UID ivan@sisd.com 98-sep-21 +$Log: cust_credit.pm,v $ +Revision 1.2 1998-12-29 11:59:38 ivan +mostly properly OO, some work still to be done with svc_ stuff + + =cut 1; diff --git a/site_perl/cust_main.pm b/site_perl/cust_main.pm index 6c9c0b109..77ebb2d04 100644 --- a/site_perl/cust_main.pm +++ b/site_perl/cust_main.pm @@ -5,16 +5,15 @@ use vars qw($paymentserversecret $paymentserverport $paymentserverhost); package FS::cust_main; use strict; -use vars qw(@ISA @EXPORT_OK $conf $lpr $processor $xaction $E_NoErr); +use vars qw(@ISA $conf $lpr $processor $xaction $E_NoErr); use Safe; -use Exporter; use Carp; use Time::Local; use Date::Format; use Date::Manip; use Business::CreditCard; -use FS::UID qw(getotaker); -use FS::Record qw(fields hfields qsearchs qsearch); +use FS::UID qw( getotaker ); +use FS::Record qw( qsearchs qsearch ); use FS::cust_pkg; use FS::cust_bill; use FS::cust_bill_pkg; @@ -26,8 +25,7 @@ use FS::cust_main_county; use FS::agent; use FS::cust_main_invoice; -@ISA = qw(FS::Record Exporter); -@EXPORT_OK = qw(hfields); +@ISA = qw( FS::Record ); #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::cust_main'} = sub { @@ -75,8 +73,8 @@ FS::cust_main - Object methods for cust_main records use FS::cust_main; - $record = create FS::cust_main \%hash; - $record = create FS::cust_main { 'column' => 'value' }; + $record = new FS::cust_main \%hash; + $record = new FS::cust_main { 'column' => 'value' }; $error = $record->insert; @@ -158,7 +156,7 @@ FS::Record. The following fields are currently supported: =over 4 -=item create HASHREF +=item new HASHREF Creates a new customer. To add the customer to the database, see L<"insert">. @@ -167,39 +165,13 @@ points to. You can ask the object for a copy with the I method. =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my $field; - #foreach $field (fields('cust_main')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('cust_main',$hashref); -} +sub table { 'cust_main'; } =item insert Adds this customer to the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub insert { - my($self)=@_; - - #no callbacks in check, only data checks - #local $SIG{HUP} = 'IGNORE'; - #local $SIG{INT} = 'IGNORE'; - #local $SIG{QUIT} = 'IGNORE'; - #local $SIG{TERM} = 'IGNORE'; - #local $SIG{TSTP} = 'IGNORE'; - - $self->check or - $self->add; -} - =item delete Currently unimplemented. Maybe cancel all of this customer's @@ -210,12 +182,8 @@ be no record the customer ever existed (which is bad, no?) =cut -# Usage: $error = $record -> delete; sub delete { return "Can't (yet?) delete customers."; -# my($self)=@_; -# -# $self->del; } =item replace OLD_RECORD @@ -223,17 +191,6 @@ sub delete { Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub replace { - my($new,$old)=@_; - return "(Old) Not a cust_main record!" unless $old->table eq "cust_main"; - return "Can't change custnum!" - unless $old->getfield('custnum') eq $new->getfield('custnum'); - $new->check or - $new->rep($old); -} - =item check Checks all fields to make sure this is a valid customer record. If there is @@ -243,9 +200,7 @@ and repalce methods. =cut sub check { - my($self)=@_; - - return "Not a cust_main record!" unless $self->table eq "cust_main"; + my $self = shift; my $error = $self->ut_number('agentnum') @@ -263,10 +218,10 @@ sub check { return $error if $error; return "Unknown agent" - unless qsearchs('agent',{'agentnum'=>$self->agentnum}); + unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); return "Unknown referral" - unless qsearchs('part_referral',{'refnum'=>$self->refnum}); + unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } ); $self->getfield('last') =~ /^([\w \,\.\-\']+)$/ or return "Illegal last name"; $self->setfield('last',$1); @@ -314,22 +269,17 @@ sub check { $payinfo = $1; $self->payinfo($payinfo); validate($payinfo) or return "Illegal credit card number"; - my $type = cardtype($payinfo); - return "Unknown credit card type" - unless ( $type =~ /^VISA/ || - $type =~ /^MasterCard/ || - $type =~ /^American Express/ || - $type =~ /^Discover/ ); + return "Unknown card type" if cardtype($self->payinfo) eq "Unknown"; } elsif ( $self->payby eq 'BILL' ) { - $self->payinfo =~ /^([\w \-]*)$/ or return "Illegal P.O. number"; - $self->payinfo($1); + $error = $self->ut_textn('payinfo'); + return "Illegal P.O. number" if $error; } elsif ( $self->payby eq 'COMP' ) { - $self->payinfo =~ /^(\w{2,8})$/ or return "Illegal comp account issuer"; - $self->payinfo($1); + $error = $self->ut_textn('payinfo'); + return "Illegal comp account issuer" if $error; } @@ -371,7 +321,7 @@ Returns all packages (see L) for this customer. =cut sub all_pkgs { - my($self)=@_; + my $self = shift; qsearch( 'cust_pkg', { 'custnum' => $self->custnum }); } @@ -382,7 +332,7 @@ Returns all non-cancelled packages (see L) for this customer. =cut sub ncancelled_pkgs { - my($self)=@_; + my $self = shift; qsearch( 'cust_pkg', { 'custnum' => $self->custnum, 'cancel' => '', @@ -404,10 +354,10 @@ If there is an error, returns the error, otherwise returns false. =cut sub bill { - my($self,%options)=@_; - my($time) = $options{'time'} || $^T; + my( $self, %options ) = @_; + my $time = $options{'time'} || $^T; - my($error); + my $error; #put below somehow? local $SIG{HUP} = 'IGNORE'; @@ -419,38 +369,33 @@ sub bill { # find the packages which are due for billing, find out how much they are # & generate invoice database. - my($total_setup,$total_recur)=(0,0); - - my(@cust_bill_pkg); + my( $total_setup, $total_recur ) = ( 0, 0 ); + my @cust_bill_pkg; - my($cust_pkg); - foreach $cust_pkg ( + foreach my $cust_pkg ( qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } ) ) { - bless($cust_pkg,"FS::cust_pkg"); - - next if ( $cust_pkg->getfield('cancel') ); + next if $cust_pkg->getfield('cancel'); #? to avoid use of uninitialized value errors... ? $cust_pkg->setfield('bill', '') unless defined($cust_pkg->bill); - my($part_pkg)= - qsearchs('part_pkg',{'pkgpart'=> $cust_pkg->pkgpart } ); + my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } ); #so we don't modify cust_pkg record unnecessarily - my($cust_pkg_mod_flag)=0; - my(%hash)=$cust_pkg->hash; - my($old_cust_pkg)=create FS::cust_pkg(\%hash); + my $cust_pkg_mod_flag = 0; + my %hash = $cust_pkg->hash; + my $old_cust_pkg = new FS::cust_pkg \%hash; # bill setup - my($setup)=0; + my $setup = 0; unless ( $cust_pkg->setup ) { - my($setup_prog)=$part_pkg->getfield('setup'); - my($cpt) = new Safe; + my $setup_prog = $part_pkg->getfield('setup'); + my $cpt = new Safe; #$cpt->permit(); #what is necessary? - $cpt->share(qw($cust_pkg)); #can $cpt now use $cust_pkg methods? + $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods? $setup = $cpt->reval($setup_prog); unless ( defined($setup) ) { warn "Error reval-ing part_pkg->setup pkgpart ", @@ -462,16 +407,16 @@ sub bill { } #bill recurring fee - my($recur)=0; - my($sdate); + my $recur = 0; + my $sdate; if ( $part_pkg->getfield('freq') > 0 && ! $cust_pkg->getfield('susp') && ( $cust_pkg->getfield('bill') || 0 ) < $time ) { - my($recur_prog)=$part_pkg->getfield('recur'); - my($cpt) = new Safe; + my $recur_prog = $part_pkg->getfield('recur'); + my $cpt = new Safe; #$cpt->permit(); #what is necessary? - $cpt->share(qw($cust_pkg)); #can $cpt now use $cust_pkg methods? + $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods? $recur = $cpt->reval($recur_prog); unless ( defined($recur) ) { warn "Error reval-ing part_pkg->recur pkgpart ", @@ -480,13 +425,14 @@ sub bill { #change this bit to use Date::Manip? #$sdate=$cust_pkg->bill || time; #$sdate=$cust_pkg->bill || $time; - $sdate=$cust_pkg->bill || $cust_pkg->setup || $time; - my($sec,$min,$hour,$mday,$mon,$year)= + $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; + my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($sdate) )[0,1,2,3,4,5]; $mon += $part_pkg->getfield('freq'); until ( $mon < 12 ) { $mon -= 12; $year++; } - $cust_pkg->setfield('bill',timelocal($sec,$min,$hour,$mday,$mon,$year)); - $cust_pkg_mod_flag=1; + $cust_pkg->setfield('bill', + timelocal($sec,$min,$hour,$mday,$mon,$year)); + $cust_pkg_mod_flag = 1; } } @@ -494,15 +440,14 @@ sub bill { warn "recur is undefinded" unless defined($recur); warn "cust_pkg bill is undefinded" unless defined($cust_pkg->bill); - if ($cust_pkg_mod_flag) { + if ( $cust_pkg_mod_flag ) { $error=$cust_pkg->replace($old_cust_pkg); - if ( $error ) { + if ( $error ) { #just in case warn "Error modifying pkgnum ", $cust_pkg->pkgnum, ": $error"; } else { - #just in case - $setup=sprintf("%.2f",$setup); - $recur=sprintf("%.2f",$recur); - my($cust_bill_pkg)=create FS::cust_bill_pkg ({ + $setup = sprintf( "%.2f", $setup ); + $recur = sprintf( "%.2f", $recur ); + my $cust_bill_pkg = new FS::cust_bill_pkg ({ 'pkgnum' => $cust_pkg->pkgnum, 'setup' => $setup, 'recur' => $recur, @@ -517,24 +462,24 @@ sub bill { } - my($charged)=sprintf("%.2f",$total_setup + $total_recur); + my $charged = sprintf( "%.2f", $total_setup + $total_recur ); return '' if scalar(@cust_bill_pkg) == 0; - unless ( $self->getfield('tax') eq 'Y' || - $self->getfield('tax') eq 'y' || - $self->getfield('payby') eq 'COMP' + unless ( $self->getfield('tax') =~ /Y/i + || $self->getfield('payby') eq 'COMP' ) { - my($cust_main_county) = qsearchs('cust_main_county',{ - 'county' => $self->getfield('county'), - 'state' => $self->getfield('state'), + my $cust_main_county = qsearchs('cust_main_county',{ + 'state' => $self->state, + 'county' => $self->county, + 'country' => $self->country, } ); - my($tax) = sprintf("%.2f", + my $tax = sprintf( "%.2f", $charged * ( $cust_main_county->getfield('tax') / 100 ) ); - $charged = sprintf("%.2f",$charged+$tax); + $charged = sprintf( "%.2f", $charged+$tax ); - my($cust_bill_pkg)=create FS::cust_bill_pkg ({ + my $cust_bill_pkg = new FS::cust_bill_pkg ({ 'pkgnum' => 0, 'setup' => $tax, 'recur' => 0, @@ -544,23 +489,23 @@ sub bill { push @cust_bill_pkg, $cust_bill_pkg; } - my($cust_bill) = create FS::cust_bill ( { + my $cust_bill = new FS::cust_bill ( { 'custnum' => $self->getfield('custnum'), '_date' => $time, 'charged' => $charged, } ); - $error=$cust_bill->insert; + $error = $cust_bill->insert; #shouldn't happen, but how else to handle this? (wrap me in eval, to catch # fatal errors) die "Error creating cust_bill record: $error!\n", "Check updated but unbilled packages for customer", $self->custnum, "\n" if $error; - my($invnum)=$cust_bill->invnum; - my($cust_bill_pkg); + my $invnum = $cust_bill->invnum; + my $cust_bill_pkg; foreach $cust_bill_pkg ( @cust_bill_pkg ) { - $cust_bill_pkg->setfield('invnum',$invnum); - $error=$cust_bill_pkg->insert; + $cust_bill_pkg->setfield( 'invnum', $invnum ); + $error = $cust_bill_pkg->insert; #shouldn't happen, but how else tohandle this? die "Error creating cust_bill_pkg record: $error!\n", "Check incomplete invoice ", $invnum, "\n" @@ -596,10 +541,10 @@ return an error. By default, they don't. =cut sub collect { - my($self,%options)=@_; - my($invoice_time) = $options{'invoice_time'} || $^T; + my( $self, %options ) = @_; + my $invoice_time = $options{'invoice_time'} || $^T; - my($total_owed) = $self->balance; + my $total_owed = $self->balance; return '' unless $total_owed > 0; #redundant????? #put below somehow? @@ -609,90 +554,84 @@ sub collect { local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; - foreach my $cust_bill ( qsearch('cust_bill', { - 'custnum' => $self->getfield('custnum'), - } ) ) { - - bless($cust_bill,"FS::cust_bill"); + foreach my $cust_bill ( + qsearch('cust_bill', { 'custnum' => $self->custnum, } ) + ) { #this has to be before next's - my($amount) = sprintf("%.2f", $total_owed < $cust_bill->owed + my $amount = sprintf( "%.2f", $total_owed < $cust_bill->owed ? $total_owed : $cust_bill->owed ); - $total_owed = sprintf("%.2f",$total_owed-$amount); + $total_owed = sprintf( "%.2f", $total_owed - $amount ); next unless $cust_bill->owed > 0; - next if qsearchs('cust_pay_batch',{'invnum'=> $cust_bill->invnum }); + next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } ); #warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)"; next unless $amount > 0; - if ( $self->getfield('payby') eq 'BILL' ) { + if ( $self->payby eq 'BILL' ) { #30 days 2592000 - my($since)=$invoice_time - ( $cust_bill->_date || 0 ); + my $since = $invoice_time - ( $cust_bill->_date || 0 ); #warn "$invoice_time ", $cust_bill->_date, " $since"; if ( $since >= 0 #don't print future invoices && ( $cust_bill->printed * 2592000 ) <= $since ) { - open(LPR,"|$lpr") or die "Can't open $lpr: $!"; + open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!"; print LPR $cust_bill->print_text; #( date ) close LPR or die $! ? "Error closing $lpr: $!" : "Exit status $? from $lpr"; - my(%hash)=$cust_bill->hash; + my %hash = $cust_bill->hash; $hash{'printed'}++; - my($new_cust_bill)=create FS::cust_bill(\%hash); - my($error)=$new_cust_bill->replace($cust_bill); - if ( $error ) { - warn "Error updating $cust_bill->printed: $error"; - } + my $new_cust_bill = new FS::cust_bill(\%hash); + my $error = $new_cust_bill->replace($cust_bill); + warn "Error updating $cust_bill->printed: $error" if $error; } - } elsif ( $self->getfield('payby') eq 'COMP' ) { - my($cust_pay) = create FS::cust_pay ( { - 'invnum' => $cust_bill->getfield('invnum'), + } elsif ( $self->payby eq 'COMP' ) { + my $cust_pay = new FS::cust_pay ( { + 'invnum' => $cust_bill->invnum, 'paid' => $amount, '_date' => '', 'payby' => 'COMP', - 'payinfo' => $self->getfield('payinfo'), + 'payinfo' => $self->payinfo, 'paybatch' => '' } ); - my($error)=$cust_pay->insert; - return 'Error COMPing invnum #' . $cust_bill->getfield('invnum') . + my $error = $cust_pay->insert; + return 'Error COMPing invnum #' . $cust_bill->invnum . ':' . $error if $error; - } elsif ( $self->getfield('payby') eq 'CARD' ) { + } elsif ( $self->payby eq 'CARD' ) { if ( $options{'batch_card'} ne 'yes' ) { return "Real time card processing not enabled!" unless $processor; - if ( $processor =~ /cybercash/ ) { + if ( $processor =~ /^cybercash/ ) { #fix exp. date for cybercash - $self->getfield('paydate') =~ /^(\d+)\/\d*(\d{2})$/; - my($exp)="$1/$2"; + $self->paydate =~ /^(\d+)\/\d*(\d{2})$/; + my $exp = "$1/$2"; - my($paybatch)= $cust_bill->getfield('invnum') . - '-' . time2str("%y%m%d%H%M%S",time); + my $paybatch = $cust_bill->invnum. + '-' . time2str("%y%m%d%H%M%S", time); - my($payname)= $self->getfield('payname') || - $self->getfield('first') . ' ' .$self->getfield('last'); + my $payname = $self->payname || + $self->getfield('first'). ' '. $self->getfield('last'); - my($address)= $self->getfield('address1'); - $address .= ", " . $self->getfield('address2') - if $self->getfield('address2'); + my $address = $self->address1; + $address .= ", ". $self->address2 if $self->address2; - my($country) = $self->getfield('country') eq 'US' ? - 'USA' : $self->getfield('country'); + my $country = 'USA' if $self->country eq 'US'; - my(@full_xaction)=($xaction, + my @full_xaction = ( $xaction, 'Order-ID' => $paybatch, 'Amount' => "usd $amount", 'Card-Number' => $self->getfield('payinfo'), @@ -705,7 +644,7 @@ sub collect { 'Card-Exp' => $exp, ); - my(%result); + my %result; if ( $processor eq 'cybercash2' ) { $^W=0; #CCLib isn't -w safe, ugh! %result = &CCLib::sendmserver(@full_xaction); @@ -719,21 +658,21 @@ sub collect { #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3 #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1 if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3 - my($cust_pay) = create FS::cust_pay ( { - 'invnum' => $cust_bill->getfield('invnum'), + my $cust_pay = new FS::cust_pay ( { + 'invnum' => $cust_bill->invnum, 'paid' => $amount, '_date' => '', 'payby' => 'CARD', - 'payinfo' => $self->getfield('payinfo'), + 'payinfo' => $self->payinfo, 'paybatch' => "$processor:$paybatch", } ); - my($error)=$cust_pay->insert; + my $error = $cust_pay->insert; return 'Error applying payment, invnum #' . - $cust_bill->getfield('invnum') . ':' . $error if $error; + $cust_bill->invnum. ':'. $error if $error; } elsif ( $result{'Mstatus'} ne 'failure-bad-money' || $options{'report_badcard'} ) { return 'Cybercash error, invnum #' . - $cust_bill->getfield('invnum') . ':' . $result{'MErrMsg'}; + $cust_bill->invnum. ':'. $result{'MErrMsg'}; } else { return ''; } @@ -744,8 +683,7 @@ sub collect { } else { #batch card -# my($cust_pay_batch) = create FS::cust_pay_batch ( { - my($cust_pay_batch) = new FS::Record ('cust_pay_batch', { + my $cust_pay_batch = new FS::Record ('cust_pay_batch', { 'invnum' => $cust_bill->getfield('invnum'), 'custnum' => $self->getfield('custnum'), 'last' => $self->getfield('last'), @@ -762,14 +700,13 @@ sub collect { 'payname' => $self->getfield('payname'), 'amount' => $amount, } ); -# my($error)=$cust_pay_batch->insert; - my($error)=$cust_pay_batch->add; + my $error = $cust_pay_batch->insert; return "Error adding to cust_pay_batch: $error" if $error; } } else { - return "Unknown payment type ".$self->getfield('payby'); + return "Unknown payment type ". $self->payby; } } @@ -785,15 +722,14 @@ Returns the total owed for this customer on all invoices =cut sub total_owed { - my($self) = @_; - my($total_bill) = 0; - my($cust_bill); - foreach $cust_bill ( qsearch('cust_bill', { - 'custnum' => $self->getfield('custnum'), + my $self = shift; + my $total_bill = 0; + foreach my $cust_bill ( qsearch('cust_bill', { + 'custnum' => $self->custnum, } ) ) { - $total_bill += $cust_bill->getfield('owed'); + $total_bill += $cust_bill->owed; } - sprintf("%.2f",$total_bill); + sprintf( "%.2f", $total_bill ); } =item total_credited @@ -803,15 +739,14 @@ Returns the total credits (see L) for this customer. =cut sub total_credited { - my($self) = @_; - my($total_credit) = 0; - my($cust_credit); - foreach $cust_credit ( qsearch('cust_credit', { - 'custnum' => $self->getfield('custnum'), + my $self = shift; + my $total_credit = 0; + foreach my $cust_credit ( qsearch('cust_credit', { + 'custnum' => $self->custnum, } ) ) { - $total_credit += $cust_credit->getfield('credited'); + $total_credit += $cust_credit->credited; } - sprintf("%.2f",$total_credit); + sprintf( "%.2f", $total_credit ); } =item balance @@ -821,8 +756,8 @@ Returns the balance for this customer (total owed minus total credited). =cut sub balance { - my($self) = @_; - sprintf("%.2f",$self->total_owed - $self->total_credited); + my $self = shift; + sprintf( "%.2f", $self->total_owed - $self->total_credited ); } =item invoicing_list [ ITEM, ITEM, ... ] @@ -836,20 +771,20 @@ Returns a list of email addresses (with svcnum entries expanded). =cut sub invoicing_list { - my($self, @addresses) = @_; + my( $self, @addresses ) = @_; if ( @addresses ) { my @cust_main_invoice = - qsearch('cust_main_invoice', { 'custnum' => $self->custnum } ); + qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ); foreach my $cust_main_invoice ( @cust_main_invoice ) { unless ( grep { $cust_main_invoice->address eq $_ } @addresses ) { $cust_main_invoice->delete; } } @cust_main_invoice = - qsearch('cust_main_invoice', { 'custnum' => $self->custnum } ); + qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ); foreach my $address ( @addresses ) { unless ( grep { $address eq $_->address } @cust_main_invoice ) { - my $cust_main_invoice = create FS::cust_main_invoice ( + my $cust_main_invoice = new FS::cust_main_invoice ( 'custnum' => $self->custnum, 'dest' => $address, ); @@ -859,7 +794,7 @@ sub invoicing_list { } } map { $_->address } - qsearch('cust_main_invoice', { 'custnum' => $self->custnum } ); + qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ); } =item check_invoicing_list ITEM, ITEM @@ -870,9 +805,9 @@ is an error, returns the error, otherwise returns false. =cut sub check_invoicing_list { - my($self, @addresses) = @_; + my( $self, @addresses ) = @_; foreach my $address ( @addresses ) { - my $cust_main_invoice = create FS::cust_main_invoice ( + my $cust_main_invoice = new FS::cust_main_invoice ( 'custnum' => $self->custnum, 'dest' => $address, ); @@ -884,19 +819,26 @@ sub check_invoicing_list { =back -=head1 BUGS +=head1 VERSION -The delete method. +$Id: cust_main.pm,v 1.8 1998-12-29 11:59:39 ivan Exp $ -It doesn't properly override FS::Record yet. +=head1 BUGS -hfields should be removed. +The delete method. Bill and collect options should probably be passed as references instead of a list. CyberCash v2 forces us to define some variables in package main. +There should probably be a configuration file with a list of allowed credit +card types. + +CyberCash is the only processor. + +No multiple currency support (probably a larger project than just this module). + =head1 SEE ALSO L, L, L, L @@ -935,7 +877,10 @@ enable cybercash, cybercash v3 support, don't need to import FS::UID::{datasrc,checkruid} ivan@sisd.com 98-sep-19-21 $Log: cust_main.pm,v $ -Revision 1.7 1998-12-16 09:58:52 ivan +Revision 1.8 1998-12-29 11:59:39 ivan +mostly properly OO, some work still to be done with svc_ stuff + +Revision 1.7 1998/12/16 09:58:52 ivan library support for editing email invoice destinations (not in sub collect yet) Revision 1.6 1998/11/18 09:01:42 ivan diff --git a/site_perl/cust_main_county.pm b/site_perl/cust_main_county.pm index 9c81406ae..1ecaed1ec 100644 --- a/site_perl/cust_main_county.pm +++ b/site_perl/cust_main_county.pm @@ -1,12 +1,10 @@ package FS::cust_main_county; use strict; -use vars qw(@ISA @EXPORT_OK); -use Exporter; -use FS::Record qw(fields hfields qsearch qsearchs); +use vars qw( @ISA ); +use FS::Record; -@ISA = qw(FS::Record Exporter); -@EXPORT_OK = qw(hfields); +@ISA = qw( FS::Record ); =head1 NAME @@ -16,8 +14,8 @@ FS::cust_main_county - Object methods for cust_main_county objects use FS::cust_main_county; - $record = create FS::cust_main_county \%hash; - $record = create FS::cust_main_county { 'column' => 'value' }; + $record = new FS::cust_main_county \%hash; + $record = new FS::cust_main_county { 'column' => 'value' }; $error = $record->insert; @@ -51,68 +49,29 @@ currently supported: =over 4 -=item create HASHREF +=item new HASHREF Creates a new tax rate. To add the tax rate to the database, see L<"insert">. =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my($field); - #foreach $field (fields('cust_main_county')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('cust_main_county',$hashref); -} +sub table { 'cust_main_county'; } =item insert Adds this tax rate to the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub insert { - my($self)=@_; - - $self->check or - $self->add; -} - =item delete Deletes this tax rate from the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub delete { - my($self)=@_; - - $self->del; -} - =item replace OLD_RECORD Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub replace { - my($new,$old)=@_; - return "(Old) Not a cust_main_county record!" - unless $old->table eq "cust_main_county"; - return "Can't change taxnum!" - unless $old->getfield('taxnum') eq $new->getfield('taxnum'); - $new->check or - $new->rep($old); -} - =item check Checks all fields to make sure this is a valid tax rate. If there is an error, @@ -122,15 +81,12 @@ methods. =cut sub check { - my($self)=@_; - return "Not a cust_main_county record!" - unless $self->table eq "cust_main_county"; - my($recref) = $self->hashref; + my $self = shift; $self->ut_numbern('taxnum') - or $self->ut_textn('state') - or $self->ut_textn('county') - or $self->ut_float('tax') + || $self->ut_textn('state') + || $self->ut_textn('county') + || $self->ut_float('tax') ; } @@ -139,12 +95,10 @@ sub check { =head1 VERSION -$Id: cust_main_county.pm,v 1.2 1998-11-18 09:01:43 ivan Exp $ +$Id: cust_main_county.pm,v 1.3 1998-12-29 11:59:41 ivan Exp $ =head1 BUGS -It doesn't properly override FS::Record yet. - =head1 SEE ALSO L, L, L, schema.html from the base @@ -160,7 +114,10 @@ Changed check for 'tax' to use the new ut_float subroutine pod ivan@sisd.com 98-sep-21 $Log: cust_main_county.pm,v $ -Revision 1.2 1998-11-18 09:01:43 ivan +Revision 1.3 1998-12-29 11:59:41 ivan +mostly properly OO, some work still to be done with svc_ stuff + +Revision 1.2 1998/11/18 09:01:43 ivan i18n! i18n! diff --git a/site_perl/cust_main_invoice.pm b/site_perl/cust_main_invoice.pm index 90d653a4a..9c1a86a12 100644 --- a/site_perl/cust_main_invoice.pm +++ b/site_perl/cust_main_invoice.pm @@ -3,10 +3,12 @@ package FS::cust_main_invoice; use strict; use vars qw(@ISA $conf $mydomain); use Exporter; -use FS::Record; # qw(qsearch qsearchs); +use FS::Record qw( qsearchs ); use FS::Conf; +use FS::cust_main; +use FS::svc_acct; -@ISA = qw(FS::Record); +@ISA = qw( FS::Record ); #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::cust_main_invoice'} = sub { @@ -22,8 +24,8 @@ FS::cust_main_invoice - Object methods for cust_main_invoice records use FS::cust_main_invoice; - $record = create FS::cust_main_invoice \%hash; - $record = create FS::cust_main_invoice { 'column' => 'value' }; + $record = new FS::cust_main_invoice \%hash; + $record = new FS::cust_main_invoice { 'column' => 'value' }; $error = $record->insert; @@ -54,7 +56,7 @@ FS::Record. The following fields are currently supported: =over 4 -=item create HASHREF +=item new HASHREF Creates a new invoice destination. To add the invoice destination to the database, see L<"insert">. @@ -63,45 +65,17 @@ points to. You can ask the object for a copy with the I method. =cut -sub create { - my($proto,$hashref)=@_; - - $proto->new('cust_main_invoice',$hashref); - -} +sub table { 'cust_main_invoice'; } =item insert Adds this record to the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub insert { - my($self)=@_; - - #local $SIG{HUP} = 'IGNORE'; - #local $SIG{INT} = 'IGNORE'; - #local $SIG{QUIT} = 'IGNORE'; - #local $SIG{TERM} = 'IGNORE'; - #local $SIG{TSTP} = 'IGNORE'; - - $self->check or - $self->add; -} - =item delete Delete this record from the database. -=cut - -sub delete { - my($self)=@_; - - $self->del; -} - =item replace OLD_RECORD Replaces the OLD_RECORD with this one in the database. If there is an error, @@ -110,16 +84,11 @@ returns the error, otherwise returns false. =cut sub replace { - my($new,$old)=@_; - return "(Old) Not a cust_main_invoice record!" unless $old->table eq "cust_main_invoice"; + my ( $new, $old ) = ( shift, shift ); - return "Can't change destnum!" - unless $old->getfield('destnum') eq $new->getfield('destnum'); - return "Can't change custnum!" - unless $old->getfield('custnum') eq $new->getfield('custnum'); + return "Can't change custnum!" unless $old->custnum eq $new->custnum; - $new->check or - $new->rep($old); + $new->SUPER::replace; } @@ -132,8 +101,7 @@ and repalce methods. =cut sub check { - my($self)=@_; - return "Not a cust_main_invoice record!" unless $self->table eq "cust_main_invoice"; + my $self = shift; my $error = $self->ut_number('destnum') or $self->ut_number('custnum') @@ -148,11 +116,11 @@ sub check { #contemplate our navel } elsif ( $self->dest =~ /^(\d+)$/ ) { return "Unknown local account (specified by svcnum)" - unless qsearchs('svc_acct', { 'svcnum' => $self->dest } ); + 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 } ); + my $svc_acct = qsearchs( 'svc_acct', { 'username' => $user } ); return "Unknown local account (specified literally)" unless $svc_acct; $svc_acct->svcnum =~ /^(\d+)$/ or die "Non-numeric svcnum?!"; $self->dest($1); @@ -173,7 +141,7 @@ Returns the literal email address for this record (or `POST'). sub address { my $self = shift; if ( $self->dest =~ /(\d+)$/ ) { - my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $1 } ); + my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $1 } ); $svc_acct->username . '@' . $mydomain; } else { $self->dest; @@ -184,7 +152,7 @@ sub address { =head1 VERSION -$Id: cust_main_invoice.pm,v 1.2 1998-12-16 09:58:53 ivan Exp $ +$Id: cust_main_invoice.pm,v 1.3 1998-12-29 11:59:42 ivan Exp $ =head1 BUGS @@ -200,7 +168,10 @@ added hfields ivan@sisd.com 97-nov-13 $Log: cust_main_invoice.pm,v $ -Revision 1.2 1998-12-16 09:58:53 ivan +Revision 1.3 1998-12-29 11:59:42 ivan +mostly properly OO, some work still to be done with svc_ stuff + +Revision 1.2 1998/12/16 09:58:53 ivan library support for editing email invoice destinations (not in sub collect yet) Revision 1.1 1998/12/16 07:40:02 ivan diff --git a/site_perl/cust_pay.pm b/site_perl/cust_pay.pm index 6e30c595b..fc9112b00 100644 --- a/site_perl/cust_pay.pm +++ b/site_perl/cust_pay.pm @@ -1,14 +1,12 @@ package FS::cust_pay; use strict; -use vars qw(@ISA @EXPORT_OK); -use Exporter; +use vars qw( @ISA ); use Business::CreditCard; -use FS::Record qw(fields qsearchs); +use FS::Record qw( qsearchs ); use FS::cust_bill; -@ISA = qw(FS::Record Exporter); -@EXPORT_OK = qw(fields); +@ISA = qw( FS::Record ); =head1 NAME @@ -18,8 +16,8 @@ FS::cust_pay - Object methods for cust_pay objects use FS::cust_pay; - $record = create FS::cust_pay \%hash; - $record = create FS::cust_pay { 'column' => 'value' }; + $record = new FS::cust_pay \%hash; + $record = new FS::cust_pay { 'column' => 'value' }; $error = $record->insert; @@ -57,24 +55,13 @@ L and L for conversion functions. =over 4 -=item create HASHREF +=item new HASHREF Creates a new payment. To add the payment to the databse, see L<"insert">. =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my($field); - #foreach $field (fields('cust_pay')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('cust_pay',$hashref); - -} +sub table { 'cust_pay'; } =item insert @@ -84,20 +71,18 @@ L). =cut sub insert { - my($self)=@_; + my $self = shift; - my($error); + my $error; - $error=$self->check; + $error = $self->check; return $error if $error; - my($old_cust_bill) = qsearchs('cust_bill', { - 'invnum' => $self->getfield('invnum') - } ); + my $old_cust_bill = qsearchs( 'cust_bill', { 'invnum' => $self->invnum } ); return "Unknown invnum" unless $old_cust_bill; - my(%hash)=$old_cust_bill->hash; - $hash{owed} = sprintf("%.2f",$hash{owed} - $self->getfield('paid') ); - my($new_cust_bill) = create FS::cust_bill ( \%hash ); + my %hash = $old_cust_bill->hash; + $hash{'owed'} = sprintf("%.2f", $hash{owed} - $self->paid ); + my $new_cust_bill = new FS::cust_bill ( \%hash ); local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -105,10 +90,10 @@ sub insert { local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; - $error=$new_cust_bill -> replace($old_cust_bill); + $error = $new_cust_bill->replace($old_cust_bill); return "Error modifying cust_bill: $error" if $error; - $self->add; + $self->SUPER::insert; } =item delete @@ -119,10 +104,6 @@ Currently unimplemented (accounting reasons). sub delete { return "Can't (yet?) delete cust_pay records!"; -#template code below -# my($self)=@_; -# -# $self->del; } =item replace OLD_RECORD @@ -133,12 +114,6 @@ Currently unimplemented (accounting reasons). sub replace { return "Can't (yet?) modify cust_pay records!"; -#template code below -# my($new,$old)=@_; -# return "(Old) Not a cust_pay record!" unless $old->table eq "cust_pay"; -# -# $new->check or -# $new->rep($old); } =item check @@ -149,61 +124,43 @@ returns the error, otherwise returns false. Called by the insert method. =cut sub check { - my($self)=@_; - return "Not a cust_pay record!" unless $self->table eq "cust_pay"; - my($recref) = $self->hashref; - - $recref->{paynum} =~ /^(\d*)$/ or return "Illegal paynum"; - $recref->{paynum} = $1; + my $self = shift; - $recref->{invnum} =~ /^(\d+)$/ or return "Illegal invnum"; - $recref->{invnum} = $1; + my $error; - $recref->{paid} =~ /^(\d+(\.\d\d)?)$/ or return "Illegal paid"; - $recref->{paid} = $1; - - $recref->{_date} =~ /^(\d*)$/ or return "Illegal date"; - $recref->{_date} = $recref->{_date} ? $1 : time; + $error = + $self->ut_numbern('paynum') + || $self->ut_number('invnum') + || $self->ut_money('paid') + || $self->ut_numbern('_date') + ; + return $error if $error; - $recref->{payby} =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby"; - $recref->{payby} = $1; + $self->_date(time) unless $self->_date; - if ( $recref->{payby} eq 'CARD' ) { + $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby"; + $self->payby($1); - $recref->{payinfo} =~ s/\D//g; - if ( $recref->{payinfo} ) { - $recref->{payinfo} =~ /^(\d{13,16})$/ + if ( $self->payby eq 'CARD' ) { + my $payinfo = $self->payinfo; + $self->payinfo($payinfo =~ s/\D//g); + if ( $self->payinfo ) { + $self->payinfo =~ /^(\d{13,16})$/ or return "Illegal (mistyped?) credit card number (payinfo)"; - $recref->{payinfo} = $1; - #validate($recref->{payinfo}) - # or return "Illegal credit card number"; - my($type)=cardtype($recref->{payinfo}); - return "Unknown credit card type" - unless ( $type =~ /^VISA/ || - $type =~ /^MasterCard/ || - $type =~ /^American Express/ || - $type =~ /^Discover/ ); + $self->payinfo($1); + validate($self->payinfo) or return "Illegal credit card number"; + return "Unknown card type" if cardtype($self->payinfo) eq "Unknown"; } else { - $recref->{payinfo}='N/A'; + $self->payinfo('N/A'); } - } elsif ( $recref->{payby} eq 'BILL' ) { - - $recref->{payinfo} =~ /^([\w \-]*)$/ - or return "Illegal P.O. number (payinfo)"; - $recref->{payinfo} = $1; - - } elsif ( $recref->{payby} eq 'COMP' ) { - - $recref->{payinfo} =~ /^([\w]{2,8})$/ - or return "Illegal comp account issuer (payinfo)"; - $recref->{payinfo} = $1; - + } else { + $error = $self->ut_textn('payinfo'); + return $error if $error; } - $recref->{paybatch} =~ /^([\w\-\:]*)$/ - or return "Illegal paybatch"; - $recref->{paybatch} = $1; + $error = $self->ut_textn('paybatch'); + return $error if $error; ''; #no error @@ -211,9 +168,11 @@ sub check { =back -=head1 BUGS +=head1 VERSION -It doesn't properly override FS::Record yet. +$Id: cust_pay.pm,v 1.2 1998-12-29 11:59:43 ivan Exp $ + +=head1 BUGS Delete and replace methods. @@ -229,6 +188,11 @@ new api ivan@sisd.com 98-mar-13 pod ivan@sisd.com 98-sep-21 +$Log: cust_pay.pm,v $ +Revision 1.2 1998-12-29 11:59:43 ivan +mostly properly OO, some work still to be done with svc_ stuff + + =cut 1; diff --git a/site_perl/cust_pay_batch.pm b/site_perl/cust_pay_batch.pm index f40a04970..f7350c116 100644 --- a/site_perl/cust_pay_batch.pm +++ b/site_perl/cust_pay_batch.pm @@ -1,24 +1,22 @@ package FS::cust_pay_batch; use strict; -use vars qw (@ISA); -use Exporter; -#use FS::UID qw(getotaker); -use FS::Record qw(hfields qsearch qsearchs); +use vars qw( @ISA ); +use FS::Record; use Business::CreditCard; -@ISA = qw(FS::Record); +@ISA = qw( FS::Record ); =head1 NAME -FS::cust_pay_batdh - Object methods for batch cards +FS::cust_pay_batch - Object methods for batch cards =head1 SYNOPSIS use FS::cust_pay_batch; - $record = create FS::cust_pay_batch \%hash; - $record = create FS::cust_pay_batch { 'column' => 'value' }; + $record = new FS::cust_pay_batch \%hash; + $record = new FS::cust_pay_batch { 'column' => 'value' }; $error = $record->insert; @@ -73,7 +71,7 @@ following fields are currently supported: =over 4 -=item create HASHREF +=item new HASHREF Creates a new record. To add the record to the database, see L<"insert">. @@ -82,48 +80,17 @@ points to. You can ask the object for a copy with the I method. =cut -sub create { - my($proto,$hashref)=@_; - - $proto->new('cust_pay_batch',$hashref); - -} +sub table { 'cust_pay_batch'; } =item insert Adds this record to the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub insert { - my($self)=@_; - - #local $SIG{HUP} = 'IGNORE'; - #local $SIG{INT} = 'IGNORE'; - #local $SIG{QUIT} = 'IGNORE'; - #local $SIG{TERM} = 'IGNORE'; - #local $SIG{TSTP} = 'IGNORE'; - - $self->check or - $self->add; -} - =item delete -#inactive -# -#Delete this record from the database. - -=cut - -sub delete { - my($self)=@_; - - #$self->del; - - return "Can't (yet?) delete batched transactions!"; -} +Delete this record from the database. If there is an error, returns the error, +otherwise returns false. =item replace OLD_RECORD @@ -135,40 +102,30 @@ sub delete { =cut sub replace { - my($new,$old)=@_; - #return "(Old) Not a table_name record!" unless $old->table eq "table_name"; - # - #return "Can't change keyfield!" - # unless $old->getfield('keyfield') eq $new->getfield('keyfield'); - # - #$new->check or - #$new->rep($old); - return "Can't (yet?) replace batched transactions!"; } =item check -Checks all fields to make sure this is a valid example. If there is +Checks all fields to make sure this is a valid transaction. If there is an error, returns the error, otherwise returns false. Called by the insert and repalce methods. =cut sub check { - my($self)=@_; - return "Not a cust_pay_batch record!" unless $self->table eq "cust_pay_batch"; + my $self = shift; my $error = $self->ut_numbern('trancode') - or $self->ut_number('cardnum') - or $self->ut_money('amount') - or $self->ut_number('invnum') - or $self->ut_number('custnum') - or $self->ut_text('address1') - or $self->ut_textn('address2') - or $self->ut_text('city') - or $self->ut_text('state') + || $self->ut_number('cardnum') + || $self->ut_money('amount') + || $self->ut_number('invnum') + || $self->ut_number('custnum') + || $self->ut_text('address1') + || $self->ut_textn('address2') + || $self->ut_text('city') + || $self->ut_text('state') ; return $error if $error; @@ -186,12 +143,7 @@ sub check { $cardnum = $1; $self->cardnum($cardnum); validate($cardnum) or return "Illegal credit card number"; - my $type = cardtype($cardnum); - return "Unknown credit card type" - unless ( $type =~ /^VISA/ || - $type =~ /^MasterCard/ || - $type =~ /^American Express/ || - $type =~ /^Discover/ ); + return "Unknown card type" if cardtype($self->payinfo) eq "Unknown"; if ( $self->exp eq '' ) { return "Expriation date required"; @@ -231,10 +183,13 @@ sub check { =head1 VERSION -$Id: cust_pay_batch.pm,v 1.2 1998-11-18 09:01:44 ivan Exp $ +$Id: cust_pay_batch.pm,v 1.3 1998-12-29 11:59:44 ivan Exp $ =head1 BUGS +There should probably be a configuration file with a list of allowed credit +card types. + =head1 SEE ALSO L, L @@ -247,7 +202,10 @@ added hfields ivan@sisd.com 97-nov-13 $Log: cust_pay_batch.pm,v $ -Revision 1.2 1998-11-18 09:01:44 ivan +Revision 1.3 1998-12-29 11:59:44 ivan +mostly properly OO, some work still to be done with svc_ stuff + +Revision 1.2 1998/11/18 09:01:44 ivan i18n! i18n! Revision 1.1 1998/11/15 05:19:58 ivan diff --git a/site_perl/cust_pkg.pm b/site_perl/cust_pkg.pm index 5640e24b6..66193510e 100644 --- a/site_perl/cust_pkg.pm +++ b/site_perl/cust_pkg.pm @@ -2,14 +2,20 @@ package FS::cust_pkg; use strict; use vars qw(@ISA); -use Exporter; -use FS::UID qw(getotaker); -use FS::Record qw(fields qsearch qsearchs); +use FS::UID qw( getotaker ); +use FS::Record qw( qsearch qsearchs ); use FS::cust_svc; use FS::part_pkg; use FS::cust_main; -@ISA = qw(FS::Record Exporter); +# need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend, +# 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; + +@ISA = qw( FS::Record ); =head1 NAME @@ -19,8 +25,8 @@ FS::cust_pkg - Object methods for cust_pkg objects use FS::cust_pkg; - $record = create FS::cust_pkg \%hash; - $record = create FS::cust_pkg { 'column' => 'value' }; + $record = new FS::cust_pkg \%hash; + $record = new FS::cust_pkg { 'column' => 'value' }; $error = $record->insert; @@ -76,44 +82,27 @@ conversion functions. =over 4 -=item create HASHREF +=item new HASHREF Create a new billing item. To add the item to the database, see L<"insert">. =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my($field); - #foreach $field (fields('cust_pkg')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('cust_pkg',$hashref); -} +sub table { 'cust_pkg'; } =item insert Adds this billing item to the database ("Orders" the item). If there is an error, returns the error, otherwise returns false. -=cut - -sub insert { - my($self)=@_; - - $self->check or - $self->add; -} - =item delete Currently unimplemented. You don't want to delete billing items, because there would then be no record the customer ever purchased the item. Instead, see the cancel method. +=cut + sub delete { return "Can't delete cust_pkg records!"; } @@ -138,21 +127,16 @@ in some cases). =cut sub replace { - my($new,$old)=@_; - return "(Old) Not a cust_pkg record!" if $old->table ne "cust_pkg"; - return "Can't change pkgnum!" - if $old->getfield('pkgnum') ne $new->getfield('pkgnum'); - #return "Can't (yet?) change pkgpart!" - # if $old->getfield('pkgpart') ne $new->getfield('pkgpart'); - return "Can't change otaker!" - if $old->getfield('otaker') ne $new->getfield('otaker'); + my( $new, $old ) = ( shift, shift ); + + #return "Can't (yet?) change pkgpart!" if $old->pkgpart ne $new->pkgpart; + return "Can't change otaker!" if $old->otaker ne $new->otaker; return "Can't change setup once it exists!" if $old->getfield('setup') && $old->getfield('setup') != $new->getfield('setup'); #some logic for bill, susp, cancel? - $new->check or - $new->rep($old); + $new->SUPER::replace($old); } =item check @@ -164,38 +148,28 @@ replace methods. =cut sub check { - my($self)=@_; - return "Not a cust_pkg record!" if $self->table ne "cust_pkg"; - my($recref) = $self->hashref; + my $self = shift; + + my $error = + $self->ut_numbern('pkgnum') + || $self->ut_number('custnum') + || $self->ut_number('pkgpart') + || $self->ut_numbern('setup') + || $self->ut_numbern('bill') + || $self->ut_numbern('susp') + || $self->ut_numbern('cancel') + ; + return $error if $error; - $recref->{pkgnum} =~ /^(\d*)$/ or return "Illegal pkgnum"; - $recref->{pkgnum}=$1; - - $recref->{custnum} =~ /^(\d+)$/ or return "Illegal custnum"; - $recref->{custnum}=$1; return "Unknown customer" - unless qsearchs('cust_main',{'custnum'=>$recref->{custnum}}); + unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); - $recref->{pkgpart} =~ /^(\d+)$/ or return "Illegal pkgpart"; - $recref->{pkgpart}=$1; return "Unknown pkgpart" - unless qsearchs('part_pkg',{'pkgpart'=>$recref->{pkgpart}}); - - $recref->{otaker} ||= &getotaker; - $recref->{otaker} =~ /^(\w{0,8})$/ or return "Illegal otaker"; - $recref->{otaker}=$1; - - $recref->{setup} =~ /^(\d*)$/ or return "Illegal setup date"; - $recref->{setup}=$1; + unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); - $recref->{bill} =~ /^(\d*)$/ or return "Illegal bill date"; - $recref->{bill}=$1; - - $recref->{susp} =~ /^(\d*)$/ or return "Illegal susp date"; - $recref->{susp}=$1; - - $recref->{cancel} =~ /^(\d*)$/ or return "Illegal cancel date"; - $recref->{cancel}=$1; + $self->otaker(getotaker) unless $self->otaker; + $self->otaker =~ /^(\w{0,16})$/ or return "Illegal otaker"; + $self->otaker($1); ''; #no error } @@ -211,8 +185,8 @@ If there is an error, returns the error, otherwise returns false. =cut sub cancel { - my($self)=@_; - my($error); + my $self = shift; + my $error; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -220,38 +194,34 @@ sub cancel { local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; - my($cust_svc); - foreach $cust_svc ( - qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } ) + foreach my $cust_svc ( + qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ) { - my($part_svc)= - qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } ); + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } ); - $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/ + $part_svc->svcdb =~ /^([\w\-]+)$/ or return "Illegal svcdb value in part_svc!"; - my($svcdb) = $1; + my $svcdb = $1; require "FS/$svcdb.pm"; - my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->svcnum } ); + my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } ); if ($svc) { - bless($svc,"FS::$svcdb"); $error = $svc->cancel; return "Error cancelling service: $error" if $error; $error = $svc->delete; return "Error deleting service: $error" if $error; } - bless($cust_svc,"FS::cust_svc"); $error = $cust_svc->delete; return "Error deleting cust_svc: $error" if $error; } unless ( $self->getfield('cancel') ) { - my(%hash) = $self->hash; - $hash{'cancel'}=$^T; - my($new) = create FS::cust_pkg ( \%hash ); - $error=$new->replace($self); + my %hash = $self->hash; + $hash{'cancel'} = $^T; + my $new = new FS::cust_pkg ( \%hash ); + $error = $new->replace($self); return $error if $error; } @@ -268,30 +238,27 @@ If there is an error, returns the error, otherwise returns false. =cut sub suspend { - my($self)=@_; - my($error); + 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'; - my($cust_svc); - foreach $cust_svc ( - qsearch('cust_svc',{'pkgnum'=> $self->getfield('pkgnum') } ) + foreach my $cust_svc ( + qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ) { - my($part_svc)= - qsearchs('part_svc',{'svcpart'=> $cust_svc->getfield('svcpart') } ); + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } ); - $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/ + $part_svc->svcdb =~ /^([\w\-]+)$/ or return "Illegal svcdb value in part_svc!"; - my($svcdb) = $1; + my $svcdb = $1; require "FS/$svcdb.pm"; - my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } ); - + my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } ); if ($svc) { - bless($svc,"FS::$svcdb"); $error = $svc->suspend; return $error if $error; } @@ -299,10 +266,10 @@ sub suspend { } unless ( $self->getfield('susp') ) { - my(%hash) = $self->hash; - $hash{'susp'}=$^T; - my($new) = create FS::cust_pkg ( \%hash ); - $error=$new->replace($self); + my %hash = $self->hash; + $hash{'susp'} = $^T; + my $new = new FS::cust_pkg ( \%hash ); + $error = $new->replace($self); return $error if $error; } @@ -319,7 +286,7 @@ If there is an error, returns the error, otherwise returns false. =cut sub unsuspend { - my($self)=@_; + my $self = shift; my($error); local $SIG{HUP} = 'IGNORE'; @@ -328,21 +295,18 @@ sub unsuspend { local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; - my($cust_svc); - foreach $cust_svc ( - qsearch('cust_svc',{'pkgnum'=> $self->getfield('pkgnum') } ) + foreach my $cust_svc ( + qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } ) ) { - my($part_svc)= - qsearchs('part_svc',{'svcpart'=> $cust_svc->getfield('svcpart') } ); + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } ); - $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/ + $part_svc->svcdb =~ /^([\w\-]+)$/ or return "Illegal svcdb value in part_svc!"; - my($svcdb) = $1; + my $svcdb = $1; require "FS/$svcdb.pm"; - my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } ); + my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } ); if ($svc) { - bless($svc,"FS::$svcdb"); $error = $svc->unsuspend; return $error if $error; } @@ -350,10 +314,10 @@ sub unsuspend { } unless ( ! $self->getfield('susp') ) { - my(%hash) = $self->hash; - $hash{'susp'}=''; - my($new) = create FS::cust_pkg ( \%hash ); - $error=$new->replace($self); + my %hash = $self->hash; + $hash{'susp'} = ''; + my $new = new FS::cust_pkg ( \%hash ); + $error = $new->replace($self); return $error if $error; } @@ -368,8 +332,8 @@ L $self->pkgpart }); + my $self = shift; + qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); } =back @@ -495,12 +459,10 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.3 1998-11-15 13:01:35 ivan Exp $ +$Id: cust_pkg.pm,v 1.4 1998-12-29 11:59:45 ivan Exp $ =head1 BUGS -It doesn't properly override FS::Record yet. - sub order is not OO. Perhaps it should be moved to FS::cust_main and made so? In sub order, the @pkgparts array (passed by reference) is clobbered. @@ -508,6 +470,12 @@ 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_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. + =head1 SEE ALSO L, L, L, L @@ -522,7 +490,10 @@ fixed for new agent->agent_type->type_pkgs in &order ivan@sisd.com 98-mar-7 pod ivan@sisd.com 98-sep-21 $Log: cust_pkg.pm,v $ -Revision 1.3 1998-11-15 13:01:35 ivan +Revision 1.4 1998-12-29 11:59:45 ivan +mostly properly OO, some work still to be done with svc_ stuff + +Revision 1.3 1998/11/15 13:01:35 ivan allow pkgpart changing (for per-customer custom pricing). warn about it in doc Revision 1.2 1998/11/12 03:42:45 ivan diff --git a/site_perl/cust_refund.pm b/site_perl/cust_refund.pm index a30f21716..0778473a9 100644 --- a/site_perl/cust_refund.pm +++ b/site_perl/cust_refund.pm @@ -1,15 +1,13 @@ package FS::cust_refund; use strict; -use vars qw(@ISA @EXPORT_OK); -use Exporter; +use vars qw( @ISA ); use Business::CreditCard; -use FS::Record qw(fields qsearchs); +use FS::Record qw( qsearchs ); use FS::UID qw(getotaker); use FS::cust_credit; -@ISA = qw(FS::Record Exporter); -@EXPORT_OK = qw(fields); +@ISA = qw( FS::Record ); =head1 NAME @@ -19,8 +17,8 @@ FS::cust_refund - Object method for cust_refund objects use FS::cust_refund; - $record = create FS::cust_refund \%hash; - $record = create FS::cust_refund { 'column' => 'value' }; + $record = new FS::cust_refund \%hash; + $record = new FS::cust_refund { 'column' => 'value' }; $error = $record->insert; @@ -58,24 +56,13 @@ L and L for conversion functions. =over 4 -=item create HASHREF +=item new HASHREF Creates a new refund. To add the refund to the database, see L<"insert">. =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my($field); - #foreach $field (fields('cust_refund')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('cust_refund',$hashref); - -} +sub table { 'cust_refund'; } =item insert @@ -85,20 +72,19 @@ L). =cut sub insert { - my($self)=@_; + my $self = shift; - my($error); + my $error; $error=$self->check; return $error if $error; - my($old_cust_credit) = qsearchs('cust_credit', { - 'crednum' => $self->getfield('crednum') - } ); + my $old_cust_credit = + qsearchs( 'cust_credit', { 'crednum' => $self->crednum } ); return "Unknown crednum" unless $old_cust_credit; - my(%hash)=$old_cust_credit->hash; - $hash{credited} = sprintf("%.2f",$hash{credited} - $self->getfield('refund') ); - my($new_cust_credit) = create FS::cust_credit ( \%hash ); + my %hash = $old_cust_credit->hash; + $hash{credited} = sprintf("%.2f", $hash{credited} - $self->refund ); + my($new_cust_credit) = new FS::cust_credit ( \%hash ); local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -106,10 +92,10 @@ sub insert { local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; - $error=$new_cust_credit -> replace($old_cust_credit); + $error = $new_cust_credit->replace($old_cust_credit); return "Error modifying cust_credit: $error" if $error; - $self->add; + $self->SUPER::insert; } =item delete @@ -120,10 +106,6 @@ Currently unimplemented (accounting reasons). sub delete { return "Can't (yet?) delete cust_refund records!"; -#template code below -# my($self)=@_; -# -# $self->del; } =item replace OLD_RECORD @@ -134,12 +116,6 @@ Currently unimplemented (accounting reasons). sub replace { return "Can't (yet?) modify cust_refund records!"; -#template code below -# my($new,$old)=@_; -# return "(Old) Not a cust_refund record!" unless $old->table eq "cust_refund"; -# -# $new->check or -# $new->rep($old); } =item check @@ -150,10 +126,11 @@ returns the error, otherwise returns false. Called by the insert method. =cut sub check { - my($self)=@_; - return "Not a cust_refund record!" unless $self->table eq "cust_refund"; + my $self = shift; - my $error = + my $error; + + $error = $self->ut_number('refundnum') || $self->ut_number('crednum') || $self->ut_money('amount') @@ -161,44 +138,27 @@ sub check { ; return $error if $error; - my($recref) = $self->hashref; - - $recref->{_date} ||= time; + $self->_date(time) unless $self->_date; - $recref->{payby} =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby"; - $recref->{payby} = $1; + $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby"; + $self->payby($1); - if ( $recref->{payby} eq 'CARD' ) { - - $recref->{payinfo} =~ s/\D//g; - if ( $recref->{payinfo} ) { - $recref->{payinfo} =~ /^(\d{13,16})$/ + if ( $self->payby eq 'CARD' ) { + my $payinfo = $self->payinfo; + $self->payinfo($payinfo =~ s/\D//g); + if ( $self->payinfo ) { + $self->payinfo =~ /^(\d{13,16})$/ or return "Illegal (mistyped?) credit card number (payinfo)"; - $recref->{payinfo} = $1; - #validate($recref->{payinfo}) - # or return "Illegal (checksum) credit card number (payinfo)"; - my($type)=cardtype($recref->{payinfo}); - return "Unknown credit card type" - unless ( $type =~ /^VISA/ || - $type =~ /^MasterCard/ || - $type =~ /^American Express/ || - $type =~ /^Discover/ ); + $self->payinfo($1); + validate($self->payinfo) or return "Illegal credit card number"; + return "Unknown card type" if cardtype($self->payinfo) eq "Unknown"; } else { - $recref->{payinfo}='N/A'; + $self->payinfo('N/A'); } - } elsif ( $recref->{payby} eq 'BILL' ) { - - $recref->{payinfo} =~ /^([\w \-]*)$/ - or return "Illegal P.O. number (payinfo)"; - $recref->{payinfo} = $1; - - } elsif ( $recref->{payby} eq 'COMP' ) { - - $recref->{payinfo} =~ /^([\w]{2,8})$/ - or return "Illegal comp account issuer (payinfo)"; - $recref->{payinfo} = $1; - + } else { + $error = $self->ut_textn('payinfo'); + return $error if $error; } $self->otaker(getotaker); @@ -208,9 +168,11 @@ sub check { =back -=head1 BUGS +=head1 VERSION -It doesn't properly override FS::Record yet. +$Id: cust_refund.pm,v 1.2 1998-12-29 11:59:46 ivan Exp $ + +=head1 BUGS Delete and replace methods. @@ -227,6 +189,11 @@ ivan@sisd.com 98-mar-18 pod and finish up ivan@sisd.com 98-sep-21 +$Log: cust_refund.pm,v $ +Revision 1.2 1998-12-29 11:59:46 ivan +mostly properly OO, some work still to be done with svc_ stuff + + =cut 1; diff --git a/site_perl/cust_svc.pm b/site_perl/cust_svc.pm index ef93f86da..f97f5fe9d 100644 --- a/site_perl/cust_svc.pm +++ b/site_perl/cust_svc.pm @@ -1,10 +1,9 @@ package FS::cust_svc; use strict; -use vars qw(@ISA); -use Carp; -use Exporter; -use FS::Record qw(fields qsearchs); +use vars qw( @ISA ); +use Carp qw( cluck ); +use FS::Record qw( qsearchs ); use FS::cust_pkg; use FS::part_pkg; use FS::part_svc; @@ -12,7 +11,7 @@ use FS::svc_acct; use FS::svc_acct_sm; use FS::svc_domain; -@ISA = qw(FS::Record Exporter); +@ISA = qw( FS::Record ); =head1 NAME @@ -22,8 +21,8 @@ FS::cust_svc - Object method for cust_svc objects use FS::cust_svc; - $record = create FS::cust_svc \%hash - $record = create FS::cust_svc { 'column' => 'value' }; + $record = new FS::cust_svc \%hash + $record = new FS::cust_svc { 'column' => 'value' }; $error = $record->insert; @@ -54,7 +53,7 @@ The following fields are currently supported: =over 4 -=item create HASHREF +=item new HASHREF Creates a new service. To add the refund to the database, see L<"insert">. Services are normally created by creating FS::svc_ objects (see @@ -62,32 +61,13 @@ L, L, and L, among others). =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my($field); - #foreach $field (fields('cust_svc')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('cust_svc',$hashref); -} +sub table { 'cust_svc'; } =item insert Adds this service to the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub insert { - my($self)=@_; - - $self->check or - $self->add; -} - =item delete Deletes this service from the database. If there is an error, returns the @@ -95,30 +75,11 @@ error, otherwise returns false. Called by the cancel method of the package (see L). -=cut - -sub delete { - my($self)=@_; - # anything else here? - $self->del; -} - =item replace OLD_RECORD Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub replace { - my($new,$old)=@_; - return "(Old) Not a cust_svc record!" unless $old->table eq "cust_svc"; - return "Can't change svcnum!" - unless $old->getfield('svcnum') eq $new->getfield('svcnum'); - $new->check or - $new->rep($old); -} - =item check Checks all fields to make sure this is a valid service. If there is an error, @@ -128,23 +89,21 @@ replace methods. =cut sub check { - my($self)=@_; - return "Not a cust_svc record!" unless $self->table eq "cust_svc"; - my($recref) = $self->hashref; + my $self = shift; - $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum"; - $recref->{svcnum}=$1; + my $error = + $self->ut_numbern('svcnum') + || $self->ut_numbern('pkgnum') + || $self->ut_number('svcpart') + ; + return $error if $error; - $recref->{pkgnum} =~ /^(\d*)$/ or return "Illegal pkgnum"; - $recref->{pkgnum}=$1; - return "Unknown pkgnum" unless - ! $recref->{pkgnum} || - qsearchs('cust_pkg',{'pkgnum'=>$recref->{pkgnum}}); + return "Unknown pkgnum" + unless ! $self->pkgnum + || qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); - $recref->{svcpart} =~ /^(\d+)$/ or return "Illegal svcpart"; - $recref->{svcpart}=$1; return "Unknown svcpart" unless - qsearchs('part_svc',{'svcpart'=>$recref->{svcpart}}); + qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); ''; #no error } @@ -159,12 +118,12 @@ Returns a list consisting of: =cut sub label { - my($self)=@_; - my($part_svc) = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); - my($svcdb) = $part_svc->svcdb; - my($svc_x) = qsearchs( $svcdb, { 'svcnum' => $self->svcnum } ); - my($svc) = $part_svc->svc; - my($tag); + my $self = shift; + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); + my $svcdb = $part_svc->svcdb; + my $svc_x = qsearchs( $svcdb, { 'svcnum' => $self->svcnum } ); + my $svc = $part_svc->svc; + my $tag; if ( $svcdb eq 'svc_acct' ) { $tag = $svc_x->getfield('username'); } elsif ( $svcdb eq 'svc_acct_sm' ) { @@ -173,9 +132,9 @@ sub label { my $domain = $svc_domain->domain; $tag = "$domuser\@$domain"; } elsif ( $svcdb eq 'svc_domain' ) { - return $svc, $svc_x->getfield('domain'); + $tag = $svc_x->getfield('domain'); } else { - carp "warning: asked for label of unsupported svcdb; using svcnum"; + cluck "warning: asked for label of unsupported svcdb; using svcnum"; $tag = $svc_x->getfield('svcnum'); } $svc, $tag, $svcdb; @@ -183,6 +142,10 @@ sub label { =back +=head1 VERSION + +$Id: cust_svc.pm,v 1.5 1998-12-29 11:59:47 ivan Exp $ + =head1 BUGS Behaviour of changing the svcpart of cust_svc records is undefined and should @@ -190,6 +153,9 @@ possibly be prohibited, and pkg_svc records are not checked. pkg_svc records are not checked in general (here). +Deleting this record doesn't check or delete the svc_* record associated +with this record. + =head1 SEE ALSO L, L, L, L, @@ -204,7 +170,10 @@ no TableUtil, no FS::Lock ivan@sisd.com 98-mar-7 pod ivan@sisd.com 98-sep-21 $Log: cust_svc.pm,v $ -Revision 1.4 1998-11-12 07:58:15 ivan +Revision 1.5 1998-12-29 11:59:47 ivan +mostly properly OO, some work still to be done with svc_ stuff + +Revision 1.4 1998/11/12 07:58:15 ivan added svcdb to label Revision 1.3 1998/11/12 03:45:38 ivan diff --git a/site_perl/part_pkg.pm b/site_perl/part_pkg.pm index 4643b9f15..82c7aec28 100644 --- a/site_perl/part_pkg.pm +++ b/site_perl/part_pkg.pm @@ -1,12 +1,10 @@ package FS::part_pkg; use strict; -use vars qw(@ISA @EXPORT_OK); -use Exporter; -use FS::Record qw(fields hfields); +use vars qw( @ISA ); +use FS::Record; -@ISA = qw(FS::Record Exporter); -@EXPORT_OK = qw(hfields fields); +@ISA = qw( FS::Record ); =head1 NAME @@ -16,8 +14,8 @@ FS::part_pkg - Object methods for part_pkg objects use FS::part_pkg; - $record = create FS::part_pkg \%hash - $record = create FS::part_pkg { 'column' => 'value' }; + $record = new FS::part_pkg \%hash + $record = new FS::part_pkg { 'column' => 'value' }; $custom_record = $template_record->clone; @@ -57,40 +55,33 @@ just as you would normally. More advanced semantics are not yet defined. =over 4 -=item create HASHREF +=item new HASHREF Creates a new billing item definition. To add the billing item definition to the database, see L<"insert">. =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my($field); - #foreach $field (fields('part_pkg')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('part_pkg',$hashref); -} +sub table { 'part_pkg'; } =item clone -Creates a new billing item definition by duplicating an existing definition. -A new pkgpart is assigned and "(CUSTOM) " is prepended to the comment field. -To add the billing item definition to the database, see L<"insert">. +An alternate constructor. Creates a new billing item definition by duplicating +an existing definition. A new pkgpart is assigned and `(CUSTOM) ' is prepended +to the comment field. To add the billing item definition to the database, see +L<"insert">. =cut sub clone { my $self = shift; + my $class = ref($self); my %hash = $self->hash; $hash{'pkgpart'} = ''; $hash{'comment'} = "(CUSTOM) ". $hash{'comment'} unless $hash{'comment'} =~ /^\(CUSTOM\) /; - create FS::part_pkg ( \%hash ); # ? + #new FS::part_pkg ( \%hash ); # ? + new $class ( \%hash ); # ? } =item insert @@ -98,15 +89,6 @@ sub clone { Adds this billing item definition to the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub insert { - my($self)=@_; - - $self->check or - $self->add; -} - =item delete Currently unimplemented. @@ -115,10 +97,7 @@ Currently unimplemented. sub delete { return "Can't (yet?) delete package definitions."; -# maybe check & make sure the pkgpart isn't in cust_pkg or type_pkgs? -# my($self)=@_; -# -# $self->del; +# check & make sure the pkgpart isn't in cust_pkg or type_pkgs? } =item replace OLD_RECORD @@ -126,17 +105,6 @@ sub delete { 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)=@_; - return "(Old) Not a part_pkg record!" unless $old->table eq "part_pkg"; - return "Can't change pkgpart!" - unless $old->getfield('pkgpart') eq $new->getfield('pkgpart'); - $new->check or - $new->rep($old); -} - =item check Checks all fields to make sure this is a valid billing item definition. If @@ -146,29 +114,25 @@ insert and replace methods. =cut sub check { - my($self)=@_; - return "Not a part_pkg record!" unless $self->table eq "part_pkg"; + my $self = shift; $self->ut_numbern('pkgpart') - or $self->ut_text('pkg') - or $self->ut_text('comment') - or $self->ut_anything('setup') - or $self->ut_number('freq') - or $self->ut_anything('recur') + || $self->ut_text('pkg') + || $self->ut_text('comment') + || $self->ut_anything('setup') + || $self->ut_number('freq') + || $self->ut_anything('recur') ; - } =back =head1 VERSION -$Id: part_pkg.pm,v 1.3 1998-11-15 13:00:15 ivan Exp $ +$Id: part_pkg.pm,v 1.4 1998-12-29 11:59:48 ivan Exp $ =head1 BUGS -It doesn't properly override FS::Record yet. - The delete method is unimplemented. setup and recur semantics are not yet defined (and are implemented in @@ -186,7 +150,10 @@ ivan@sisd.com 97-dec-5 pod ivan@sisd.com 98-sep-21 $Log: part_pkg.pm,v $ -Revision 1.3 1998-11-15 13:00:15 ivan +Revision 1.4 1998-12-29 11:59:48 ivan +mostly properly OO, some work still to be done with svc_ stuff + +Revision 1.3 1998/11/15 13:00:15 ivan bugfix in clone method, clone method doc clarification diff --git a/site_perl/part_referral.pm b/site_perl/part_referral.pm index 1b4a1b65a..e63e822a8 100644 --- a/site_perl/part_referral.pm +++ b/site_perl/part_referral.pm @@ -1,12 +1,10 @@ package FS::part_referral; use strict; -use vars qw(@ISA @EXPORT_OK); -use Exporter; -use FS::Record qw(fields qsearchs); +use vars qw( @ISA ); +use FS::Record; -@ISA = qw(FS::Record Exporter); -@EXPORT_OK = qw(fields); +@ISA = qw( FS::Record ); =head1 NAME @@ -16,8 +14,8 @@ FS::part_referral - Object methods for part_referral objects use FS::part_referral; - $record = create FS::part_referral \%hash - $record = create FS::part_referral { 'column' => 'value' }; + $record = new FS::part_referral \%hash + $record = new FS::part_referral { 'column' => 'value' }; $error = $record->insert; @@ -46,38 +44,19 @@ following fields are currently supported: =over 4 -=item create HASHREF +=item new HASHREF Creates a new referral. To add the referral to the database, see L<"insert">. =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my($field); - #foreach $field (fields('part_referral')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('part_referral',$hashref); -} +sub table { 'part_referral'; } =item insert Adds this referral to the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub insert { - my($self)=@_; - - $self->check or - $self->add; -} - =item delete Currently unimplemented. @@ -85,9 +64,9 @@ Currently unimplemented. =cut sub delete { - my($self)=@_; + my $self = shift; return "Can't (yet?) delete part_referral records"; - #$self->del; + #need to make sure no customers have this referral! } =item replace OLD_RECORD @@ -95,18 +74,6 @@ sub delete { 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)=@_; - return "(Old) Not an part_referral record!" - unless $old->table eq "part_referral"; - return "Can't change refnum!" - unless $old->getfield('refnum') eq $new->getfield('refnum'); - $new->check or - $new->rep($old); -} - =item check Checks all fields to make sure this is a valid referral. If there is an error, @@ -116,24 +83,20 @@ methods. =cut sub check { - my($self)=@_; - return "Not a part_referral record!" unless $self->table eq "part_referral"; + my $self = shift; - my($error)= - $self->ut_numbern('refnum') - or $self->ut_text('referral') + $self->ut_numbern('refnum') + || $self->ut_text('referral') ; - return $error if $error; - - ''; - } =back -=head1 BUGS +=head1 VERSION -It doesn't properly override FS::Record yet. +$Id: part_referral.pm,v 1.2 1998-12-29 11:59:49 ivan Exp $ + +=head1 BUGS The delete method is unimplemented. @@ -149,6 +112,11 @@ ivan@sisd.com 98-feb-23 pod ivan@sisd.com 98-sep-21 +$Log: part_referral.pm,v $ +Revision 1.2 1998-12-29 11:59:49 ivan +mostly properly OO, some work still to be done with svc_ stuff + + =cut 1; diff --git a/site_perl/part_svc.pm b/site_perl/part_svc.pm index 0fd8ee47d..fa3462350 100644 --- a/site_perl/part_svc.pm +++ b/site_perl/part_svc.pm @@ -1,12 +1,10 @@ package FS::part_svc; use strict; -use vars qw(@ISA @EXPORT_OK); -use Exporter; -use FS::Record qw(fields hfields); +use vars qw( @ISA ); +use FS::Record qw( fields ); -@ISA = qw(FS::Record Exporter); -@EXPORT_OK = qw(hfields fields); +@ISA = qw(FS::Record); =head1 NAME @@ -16,8 +14,8 @@ FS::part_svc - Object methods for part_svc objects use FS::part_svc; - $record = create FS::part_referral \%hash - $record = create FS::part_referral { 'column' => 'value' }; + $record = new FS::part_referral \%hash + $record = new FS::part_referral { 'column' => 'value' }; $error = $record->insert; @@ -51,39 +49,20 @@ L, and L, among others. =over 4 -=item create HASHREF +=item new HASHREF Creates a new service definition. To add the service definition to the database, see L<"insert">. =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my($field); - #foreach $field (fields('part_svc')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('part_svc',$hashref); -} +sub table { 'part_svc'; } =item insert Adds this service definition to the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub insert { - my($self)=@_; - - $self->check or - $self->add; -} - =item delete Currently unimplemented. @@ -92,10 +71,7 @@ Currently unimplemented. sub delete { return "Can't (yet?) delete service definitions."; -# maybe check & make sure the svcpart isn't in cust_svc or (in any packages)? -# my($self)=@_; -# -# $self->del; +# check & make sure the svcpart isn't in cust_svc or pkg_svc (in any packages)? } =item replace OLD_RECORD @@ -106,14 +82,12 @@ returns the error, otherwise returns false. =cut sub replace { - my($new,$old)=@_; - return "(Old) Not a part_svc record!" unless $old->table eq "part_svc"; - return "Can't change svcpart!" - unless $old->getfield('svcpart') eq $new->getfield('svcpart'); + my ( $new, $old ) = shift, shift; + return "Can't change svcdb!" - unless $old->getfield('svcdb') eq $new->getfield('svcdb'); - $new->check or - $new->rep($old); + unless $old->svcdb eq $new->svcdb; + + $new->SUPER::replace( $old ); } =item check @@ -125,30 +99,29 @@ and replace methods. =cut sub check { - my($self)=@_; - return "Not a part_svc record!" unless $self->table eq "part_svc"; - my($recref) = $self->hashref; + my $self = shift; + my $recref = $self->hashref; - my($error); - return $error if $error= + my $error; + $error= $self->ut_numbern('svcpart') || $self->ut_text('svc') || $self->ut_alpha('svcdb') ; + return $error if $error; - my(@fields) = eval { fields($recref->{svcdb}) }; #might die + my @fields = eval { fields( $recref->{svcdb} ) }; #might die return "Unknown svcdb!" unless @fields; - my($svcdb); + my $svcdb; foreach $svcdb ( qw( - svc_acct svc_acct_sm svc_charge svc_domain svc_wo + svc_acct svc_acct_sm svc_domain ) ) { - my(@rows)=map { /^${svcdb}__(.*)$/; $1 } + my @rows = map { /^${svcdb}__(.*)$/; $1 } grep ! /_flag$/, grep /^${svcdb}__/, fields('part_svc'); - my($row); - foreach $row (@rows) { + foreach my $row (@rows) { unless ( $svcdb eq $recref->{svcdb} ) { $recref->{$svcdb.'__'.$row}=''; $recref->{$svcdb.'__'.$row.'_flag'}=''; @@ -158,11 +131,8 @@ sub check { or return "Illegal flag for $svcdb $row"; $recref->{$svcdb.'__'.$row.'_flag'} = $1; -# $recref->{$svcdb.'__'.$row} =~ /^(.*)$/ #not restrictive enough? -# or return "Illegal value for $svcdb $row"; -# $recref->{$svcdb.'__'.$row} = $1; - my($error); - return $error if $error=$self->ut_anything($svcdb.'__'.$row); + my $error = $self->ut_anything($svcdb.'__'.$row); + return $error if $error; } } @@ -172,12 +142,17 @@ sub check { =back -=head1 BUGS +=head1 VERSION + +$Id: part_svc.pm,v 1.2 1998-12-29 11:59:50 ivan Exp $ -It doesn't properly override FS::Record yet. +=head1 BUGS Delete is unimplemented. +The list of svc_* tables is hardcoded. When svc_acct_pop is renamed, this +should be fixed. + =head1 SEE ALSO L, L, L, L, @@ -193,6 +168,11 @@ ivan@sisd.com 97-dec-6 pod ivan@sisd.com 98-sep-21 +$Log: part_svc.pm,v $ +Revision 1.2 1998-12-29 11:59:50 ivan +mostly properly OO, some work still to be done with svc_ stuff + + =cut 1; diff --git a/site_perl/pkg_svc.pm b/site_perl/pkg_svc.pm index 517125c01..9db0a12da 100644 --- a/site_perl/pkg_svc.pm +++ b/site_perl/pkg_svc.pm @@ -1,12 +1,10 @@ package FS::pkg_svc; use strict; -use vars qw(@ISA @EXPORT_OK); -use Exporter; -use FS::Record qw(fields hfields qsearchs); +use vars qw( @ISA ); +use FS::Record qw( qsearchs ); -@ISA = qw(FS::Record Exporter); -@EXPORT_OK = qw(hfields); +@ISA = qw( FS::Record ); =head1 NAME @@ -16,8 +14,8 @@ FS::pkg_svc - Object methods for pkg_svc records use FS::pkg_svc; - $record = create FS::pkg_svc \%hash; - $record = create FS::pkg_svc { 'column' => 'value' }; + $record = new FS::pkg_svc \%hash; + $record = new FS::pkg_svc { 'column' => 'value' }; $error = $record->insert; @@ -48,52 +46,24 @@ definition includes =over 4 -=item create HASHREF +=item new HASHREF Create a new record. To add the record to the database, see L<"insert">. =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my($field); - #foreach $field (fields('pkg_svc')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('pkg_svc',$hashref); - -} +sub table { 'pkg_svc'; } =item insert Adds this record to the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub insert { - my($self)=@_; - - $self->check or - $self->add; -} - =item delete Deletes this record from the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub delete { - my($self)=@_; - - $self->del; -} - =item replace OLD_RECORD Replaces OLD_RECORD with this one in the database. If there is an error, @@ -102,15 +72,12 @@ returns the error, otherwise returns false. =cut sub replace { - my($new,$old)=@_; - return "(Old) Not a pkg_svc record!" unless $old->table eq "pkg_svc"; - return "Can't change pkgpart!" - if $old->getfield('pkgpart') ne $new->getfield('pkgpart'); - return "Can't change svcpart!" - if $old->getfield('svcpart') ne $new->getfield('svcpart'); - - $new->check or - $new->rep($old); + my ( $new, $old ) = ( shift, shift ); + + return "Can't change pkgpart!" if $old->pkgpart ne $new->pkgpart; + return "Can't change svcpart!" if $old->svcpart ne $new->svcpart; + + $new->SUPER::replace($old); } =item check @@ -122,31 +89,32 @@ methods. =cut sub check { - my($self)=@_; - return "Not a pkg_svc record!" unless $self->table eq "pkg_svc"; - my($recref) = $self->hashref; + my $self = shift; - my($error); - return $error if $error = + my $error; + $error = $self->ut_number('pkgpart') || $self->ut_number('svcpart') || $self->ut_number('quantity') ; + return $error if $error; return "Unknown pkgpart!" - unless qsearchs('part_pkg',{'pkgpart'=> $self->getfield('pkgpart')}); + unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); return "Unknown svcpart!" - unless qsearchs('part_svc',{'svcpart'=> $self->getfield('svcpart')}); + unless qsearchs('part_svc', { 'svcpart' => $self->svcpart } ); ''; #no error } =back -=head1 BUGS +=head1 VERSION + +$Id: pkg_svc.pm,v 1.2 1998-12-29 11:59:51 ivan Exp $ -It doesn't properly override FS::Record yet. +=head1 BUGS =head1 SEE ALSO @@ -162,6 +130,11 @@ ivan@sisd.com 97-nov-13 pod ivan@sisd.com 98-sep-22 +$Log: pkg_svc.pm,v $ +Revision 1.2 1998-12-29 11:59:51 ivan +mostly properly OO, some work still to be done with svc_ stuff + + =cut 1; diff --git a/site_perl/svc_acct.pm b/site_perl/svc_acct.pm index fdc9f0bc1..1d3085969 100644 --- a/site_perl/svc_acct.pm +++ b/site_perl/svc_acct.pm @@ -1,16 +1,14 @@ package FS::svc_acct; use strict; -use vars qw(@ISA @EXPORT_OK $nossh_hack $conf $dir_prefix @shells +use vars qw(@ISA $nossh_hack $conf $dir_prefix @shells $shellmachine @saltset @pw_set); -use Exporter; use FS::Conf; -use FS::Record qw(fields qsearchs); +use FS::Record qw( qsearchs fields ); use FS::SSH qw(ssh); use FS::cust_svc; -@ISA = qw(FS::Record Exporter); -@EXPORT_OK = qw(fields); +@ISA = qw( FS::Record ); #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::svc_acct'} = sub { @@ -33,8 +31,8 @@ FS::svc_acct - Object methods for svc_acct records use FS::svc_acct; - $record = create FS::svc_acct \%hash; - $record = create FS::svc_acct { 'column' => 'value' }; + $record = new FS::svc_acct \%hash; + $record = new FS::svc_acct { 'column' => 'value' }; $error = $record->insert; @@ -87,24 +85,13 @@ FS::Record. The following fields are currently supported: =over 4 -=item create HASHREF +=item new HASHREF Creates a new account. To add the account to the database, see L<"insert">. =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my($field); - #foreach $field (fields('svc_acct')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('svc_acct',$hashref); - -} +sub table { 'svc_acct'; } =item insert @@ -125,8 +112,8 @@ setting $FS::svc_acct::nossh_hack true. =cut sub insert { - my($self)=@_; - my($error); + my $self = shift; + my $error; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -134,41 +121,40 @@ sub insert { local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; - $error=$self->check; + $error = $self->check; return $error if $error; return "Username ". $self->username. " in use" - if qsearchs('svc_acct',{'username'=> $self->username } ); + if qsearchs( 'svc_acct', { 'username' => $self->username } ); - my($part_svc) = qsearchs('part_svc',{ 'svcpart' => $self->svcpart }); + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); return "Unkonwn svcpart" unless $part_svc; return "uid in use" if $part_svc->svc_acct__uid_flag ne 'F' - && qsearchs('svc_acct',{'uid'=> $self->uid } ) + && qsearchs( 'svc_acct', { 'uid' => $self->uid } ) && $self->username !~ /^(hyla)?fax$/ ; - my($svcnum)=$self->svcnum; - my($cust_svc); + my $svcnum = $self->svcnum; + my $cust_svc; unless ( $svcnum ) { - $cust_svc=create FS::cust_svc ( { + $cust_svc = new FS::cust_svc ( { 'svcnum' => $svcnum, 'pkgnum' => $self->pkgnum, 'svcpart' => $self->svcpart, } ); - my($error) = $cust_svc->insert; + my $error = $cust_svc->insert; return $error if $error; $svcnum = $self->svcnum($cust_svc->svcnum); } - $error = $self->add; + $error = $self->SUPER::insert; if ($error) { - #$cust_svc->del if $cust_svc; $cust_svc->delete if $cust_svc; return $error; } - my($username,$uid,$dir,$shell) = ( + my ( $username, $uid, $dir, $shell ) = ( $self->username, $self->uid, $self->dir, @@ -210,8 +196,8 @@ setting $FS::svc_acct::nossh_hack true. =cut sub delete { - my($self)=@_; - my($error); + my $self = shift; + my $error; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -219,16 +205,16 @@ sub delete { local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; - my($svcnum)=$self->getfield('svcnum'); + my $svcnum = $self->getfield('svcnum'); - $error = $self->del; + $error = $self->SUPER::delete; return $error if $error; - my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}); - $error = $cust_svc->del; + my $cust_svc = qsearchs( 'cust_svc' , { 'svcnum' => $svcnum } ); + $error = $cust_svc->delete; return $error if $error; - my($username) = $self->getfield('username'); + my $username = $self->username; if ( $username && $shellmachine && ! $nossh_hack ) { ssh("root\@$shellmachine","userdel $username"); } @@ -261,27 +247,17 @@ setting $FS::svc_acct::nossh_hack true. =cut sub replace { - my($new,$old)=@_; - my($error); - - return "(Old) Not a svc_acct record!" unless $old->table eq "svc_acct"; - return "Can't change svcnum!" - unless $old->getfield('svcnum') eq $new->getfield('svcnum'); + my ( $new, $old ) = @_; + my $error; return "Username in use" - if $old->getfield('username') ne $new->getfield('username') && - qsearchs('svc_acct',{'username'=> $new->getfield('username') } ); + if $old->username ne $new->username && + qsearchs( 'svc_acct', { 'username' => $new->username } ); - return "Can't change uid!" - if $old->getfield('uid') ne $new->getfield('uid'); + return "Can't change uid!" if $old->uid ne $new->uid; #change homdir when we change username - if ( $old->getfield('username') ne $new->getfield('username') ) { - $new->setfield('dir',''); - } - - $error=$new->check; - return $error if $error; + $new->setfield('dir', '') if $old->username ne $new->username; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -289,11 +265,11 @@ sub replace { local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; - $error = $new->rep($old); + $error = $new->SUPER::replace($old); return $error if $error; - my($old_dir,$new_dir)=( $old->getfield('dir'),$new->getfield('dir') ); - my($uid,$gid)=( $new->getfield('uid'), $new->getfield('gid') ); + my ( $old_dir, $new_dir ) = ( $old->getfield('dir'), $new->getfield('dir') ); + my ( $uid, $gid) = ( $new->getfield('uid'), $new->getfield('gid') ); if ( $old_dir && $new_dir && $old_dir ne $new_dir @@ -322,17 +298,15 @@ Called by the suspend method of FS::cust_pkg (see L). =cut sub suspend { - my($old) = @_; - my(%hash) = $old->hash; + my $self = shift; + my %hash = $self->hash; unless ( $hash{_password} =~ /^\*SUSPENDED\* / ) { $hash{_password} = '*SUSPENDED* '.$hash{_password}; - my($new) = create FS::svc_acct ( \%hash ); -# $new->replace($old); - $new->rep($old); #to avoid password checking :) + my $new = new FS::svc_acct ( \%hash ); + $new->replace($self); } else { ''; #no error (already suspended) } - } =item unsuspend @@ -345,13 +319,12 @@ Called by the unsuspend method of FS::cust_pkg (see L). =cut sub unsuspend { - my($old) = @_; - my(%hash) = $old->hash; + my $self = shift; + my %hash = $self->hash; if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) { $hash{_password} = $1; - my($new) = create FS::svc_acct ( \%hash ); -# $new->replace($old); - $new->rep($old); #to avoid password checking :) + my $new = new FS::svc_acct ( \%hash ); + $new->replace($self); } else { ''; #no error (already unsuspended) } @@ -365,7 +338,6 @@ Called by the cancel method of FS::cust_pkg (see L). =cut -# Usage: $error = $record -> cancel; sub cancel { ''; #stub (no error) - taken care of in delete } @@ -381,8 +353,8 @@ Sets any fixed values; see L. =cut sub check { - my($self)=@_; - return "Not a svc_acct record!" unless $self->table eq "svc_acct"; + my $self = shift; + my($recref) = $self->hashref; $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum"; @@ -514,15 +486,21 @@ sub check { =back -=head1 BUGS +=head1 VERSION + +$Id: svc_acct.pm,v 1.3 1998-12-29 11:59:52 ivan Exp $ -It doesn't properly override FS::Record yet. +=head1 BUGS The remote commands should be configurable. -The create method should set defaults from part_svc (like the check method +The new method should set defaults from part_svc (like the check method sets fixed values). +The bits which ssh should fork before doing so. + +The $recref stuff in sub check should be cleaned up. + =head1 SEE ALSO L, L, L, L, L, @@ -555,7 +533,10 @@ arbitrary radius attributes ivan@sisd.com 98-aug-13 pod and FS::conf ivan@sisd.com 98-sep-22 $Log: svc_acct.pm,v $ -Revision 1.2 1998-11-13 09:56:55 ivan +Revision 1.3 1998-12-29 11:59:52 ivan +mostly properly OO, some work still to be done with svc_ stuff + +Revision 1.2 1998/11/13 09:56:55 ivan change configuration file layout to support multiple distinct databases (with own set of config files, export, etc.) diff --git a/site_perl/svc_acct_pop.pm b/site_perl/svc_acct_pop.pm index a6f801f22..fe2b5f3ac 100644 --- a/site_perl/svc_acct_pop.pm +++ b/site_perl/svc_acct_pop.pm @@ -1,12 +1,10 @@ package FS::svc_acct_pop; use strict; -use vars qw(@ISA @EXPORT_OK); -use Exporter; -use FS::Record qw(fields qsearchs); +use vars qw( @ISA ); +use FS::Record qw( qsearchs ); -@ISA = qw(FS::Record Exporter); -@EXPORT_OK = qw(fields); +@ISA = qw( FS::Record ); =head1 NAME @@ -16,8 +14,8 @@ FS::svc_acct_pop - Object methods for svc_acct_pop records use FS::svc_acct_pop; - $record = create FS::svc_acct_pop \%hash; - $record = create FS::svc_acct_pop { 'column' => 'value' }; + $record = new FS::svc_acct_pop \%hash; + $record = new FS::svc_acct_pop { 'column' => 'value' }; $error = $record->insert; @@ -50,68 +48,29 @@ inherits from FS::Record. The following fields are currently supported: =over 4 -=item create HASHREF +=item new HASHREF Creates a new point of presence (if only it were that easy!). To add the point of presence to the database, see L<"insert">. =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my($field); - #foreach $field (fields('svc_acct_pop')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('svc_acct_pop',$hashref); -} +sub table { 'svc_acct_pop'; } =item insert -Adds this point of presence to the databaes. If there is an error, returns the +Adds this point of presence to the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub insert { - my($self)=@_; - - $self->check or - $self->add; -} - =item delete -Currently unimplemented. - -=cut - -sub delete { - my($self)=@_; - return "Can't (yet) delete POPs!"; - #$self->del; -} +Removes this point of presence from the database. =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)=@_; - return "(Old) Not an svc_acct_pop record!" - unless $old->table eq "svc_acct_pop"; - return "Can't change popnum!" - unless $old->getfield('popnum') eq $new->getfield('popnum'); - $new->check or - $new->rep($old); -} - =item check Checks all fields to make sure this is a valid point of presence. If there is @@ -121,27 +80,24 @@ and replace methods. =cut sub check { - my($self)=@_; - return "Not a svc_acct_pop record!" unless $self->table eq "svc_acct_pop"; + my $self = shift; - my($error)= $self->ut_numbern('popnum') or $self->ut_text('city') or $self->ut_text('state') or $self->ut_number('ac') or $self->ut_number('exch') ; - return $error if $error; - - ''; } =back -=head1 BUGS +=head1 VERSION + +$Id: svc_acct_pop.pm,v 1.2 1998-12-29 11:59:53 ivan Exp $ -It doesn't properly override FS::Record yet. +=head1 BUGS It should be renamed to part_pop. @@ -157,6 +113,11 @@ ivan@sisd.com 98-mar-8 pod ivan@sisd.com 98-sep-23 +$Log: svc_acct_pop.pm,v $ +Revision 1.2 1998-12-29 11:59:53 ivan +mostly properly OO, some work still to be done with svc_ stuff + + =cut 1; diff --git a/site_perl/svc_acct_sm.pm b/site_perl/svc_acct_sm.pm index 4293e0365..f1c049263 100644 --- a/site_perl/svc_acct_sm.pm +++ b/site_perl/svc_acct_sm.pm @@ -1,15 +1,13 @@ package FS::svc_acct_sm; use strict; -use vars qw(@ISA @EXPORT_OK $nossh_hack $conf $shellmachine @qmailmachines); -use Exporter; -use FS::Record qw(fields qsearch qsearchs); +use vars qw( @ISA $nossh_hack $conf $shellmachine @qmailmachines ); +use FS::Record qw( fields qsearch qsearchs ); use FS::cust_svc; use FS::SSH qw(ssh); use FS::Conf; -@ISA = qw(FS::Record Exporter); -@EXPORT_OK = qw(fields); +@ISA = qw( FS::Record ); #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::svc_acct_sm'} = sub { @@ -27,8 +25,8 @@ FS::svc_acct_sm - Object methods for svc_acct_sm records use FS::svc_acct_sm; - $record = create FS::svc_acct_sm \%hash; - $record = create FS::svc_acct_sm { 'column' => 'value' }; + $record = new FS::svc_acct_sm \%hash; + $record = new FS::svc_acct_sm { 'column' => 'value' }; $error = $record->insert; @@ -65,25 +63,14 @@ from FS::Record. The following fields are currently supported: =over 4 -=item create HASHREF +=item new HASHREF Creates a new virtual mail alias. To add the virtual mail alias to the database, see L<"insert">. =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my($field); - #foreach $field (fields('svc_acct_sm')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('svc_acct_sm',$hashref); - -} +sub table { 'svc_acct_sm'; } =item insert @@ -320,9 +307,11 @@ sub check { =back -=head1 BUGS +=head1 VERSION + +$Id: svc_acct_sm.pm,v 1.3 1998-12-29 11:59:54 ivan Exp $ -It doesn't properly override FS::Record yet. +=head1 BUGS The remote commands should be configurable. diff --git a/site_perl/svc_domain.pm b/site_perl/svc_domain.pm index 69b225eb5..c7e1e70bd 100644 --- a/site_perl/svc_domain.pm +++ b/site_perl/svc_domain.pm @@ -1,10 +1,9 @@ package FS::svc_domain; use strict; -use vars qw(@ISA @EXPORT_OK $whois_hack $conf $mydomain $smtpmachine +use vars qw( @ISA $whois_hack $conf $mydomain $smtpmachine $tech_contact $from $to @nameservers @nameserver_ips @template ); -use Exporter; use Carp; use Mail::Internet; use Mail::Header; @@ -14,7 +13,6 @@ use FS::cust_svc; use FS::Conf; @ISA = qw(FS::Record Exporter); -@EXPORT_OK = qw(fields); #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::domain'} = sub { @@ -50,8 +48,8 @@ FS::svc_domain - Object methods for svc_domain records use FS::svc_domain; - $record = create FS::svc_domain \%hash; - $record = create FS::svc_domain { 'column' => 'value' }; + $record = new FS::svc_domain \%hash; + $record = new FS::svc_domain { 'column' => 'value' }; $error = $record->insert; @@ -84,24 +82,13 @@ FS::Record. The following fields are currently supported: =over 4 -=item create HASHREF +=item new HASHREF Creates a new domain. To add the domain to the database, see L<"insert">. =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my($field); - #foreach $field (fields('svc_domain')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('svc_domain',$hashref); - -} +sub table { 'svc_domain'; } =item insert @@ -125,8 +112,8 @@ in the same package, it is automatically used. Otherwise an error is returned. =cut sub insert { - my($self)=@_; - my($error); + my $self = shift; + my $error; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -134,34 +121,34 @@ sub insert { local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; - $error=$self->check; + $error = $self->check; return $error if $error; return "Domain in use (here)" - if qsearchs('svc_domain',{'domain'=> $self->domain } ); + if qsearchs( 'svc_domain', { 'domain' => $self->domain } ); - my($whois)=(($self->_whois)[0]); + my $whois = ($self->_whois)[0]; return "Domain in use (see whois)" if ( $self->action eq "N" && $whois !~ /^No match for/ ); return "Domain not found (see whois)" if ( $self->action eq "M" && $whois =~ /^No match for/ ); - my($svcnum)=$self->getfield('svcnum'); - my($cust_svc); + my $svcnum = $self->svcnum; + my $cust_svc; unless ( $svcnum ) { - $cust_svc=create FS::cust_svc ( { + $cust_svc = new FS::cust_svc ( { 'svcnum' => $svcnum, - 'pkgnum' => $self->getfield('pkgnum'), - 'svcpart' => $self->getfield('svcpart'), + 'pkgnum' => $self->pkgnum, + 'svcpart' => $self->svcpart, } ); - my($error) = $cust_svc->insert; + my $error = $cust_svc->insert; return $error if $error; - $svcnum = $self->setfield('svcnum',$cust_svc->getfield('svcnum')); + $svcnum = $self->setfield( 'svcnum', $cust_svc->svcnum ); } - $error = $self->add; - if ($error) { - $cust_svc->del if $cust_svc; + $error = $self->SUPER::insert; + if ( $error ) { + $cust_svc->delete if $cust_svc; return $error; } @@ -180,16 +167,16 @@ The corresponding FS::cust_svc record will be deleted as well. =cut sub delete { - my($self)=@_; - my($error); + my $self = shift; + my $error; - my($svcnum)=$self->getfield('svcnum'); + my $svcnum = $self->svcnum; - $error = $self->del; + $error = $self->delete; return $error if $error; - my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum}); - $error = $cust_svc->del; + my $cust_svc = qsearchs( 'cust_svc', { 'svcnum' => $svcnum } ); + $error = $cust_svc->delete; return $error if $error; ''; @@ -203,29 +190,13 @@ returns the error, otherwise returns false. =cut sub replace { - my($new,$old)=@_; - my($error); - - return "(Old) Not a svc_domain record!" unless $old->table eq "svc_domain"; - return "Can't change svcnum!" - unless $old->getfield('svcnum') eq $new->getfield('svcnum'); + my ( $new, $old ) = ( shift, shift ); + my $error; return "Can't change domain - reorder." if $old->getfield('domain') ne $new->getfield('domain'); - $error=$new->check; - return $error if $error; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - - $error = $new->rep($old); - return $error if $error; - - ''; + $new->SUPER::replace($old); } @@ -276,12 +247,16 @@ Sets any fixed values; see L. =cut sub check { - my($self)=@_; - return "Not a svc_domain record!" unless $self->table eq "svc_domain"; + my $self = shift; + my($recref) = $self->hashref; - $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum"; - $recref->{svcnum} = $1; + my $error; + + $error = + $self->ut_numbern('svcnum') + ; + return $error if $error; #get part_svc (and pkgnum) my($svcpart,$pkgnum); @@ -356,10 +331,10 @@ $FS::svc_domain::whois_hack is set true.) =cut sub _whois { - my($self)=@_; - my($domain)=$self->domain; + my $self = shift; + my $domain = $self->domain; return ( "No match for domain \"$domain\"." ) if $whois_hack; - open(WHOIS,"whois do $domain |"); + open(WHOIS, "whois do $domain |"); return ; } @@ -370,14 +345,14 @@ Submits a registration email for this domain. =cut sub submit_internic { - my($self)=@_; + my $self = shift; - my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$self->pkgnum}); + my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); return unless $cust_pkg; - my($cust_main)=qsearchs('cust_main',{'custnum'=>$cust_pkg->custnum}); + my cust_main) = qsearchs( 'cust_main', { 'custnum' => $cust_pkg->custnum } ); return unless $cust_main; - my(%subs)=( + my %subs = ( 'action' => $self->action, 'purpose' => $self->purpose, 'domain' => $self->domain, @@ -400,18 +375,18 @@ sub submit_internic { ); #yuck - my(@xtemplate)=@template; - my(@body); - my($line); - OLOOP: while ( defined($line = shift @xtemplate) ) { + my @xtemplate = @template; + my @body; + my $line; + OLOOP: while ( defined( $line = shift @xtemplate ) ) { if ( $line =~ /^###LOOP###$/ ) { my(@buffer); - LOADBUF: while ( defined($line = shift @xtemplate) ) { + LOADBUF: while ( defined( $line = shift @xtemplate ) ) { last LOADBUF if ( $line =~ /^###ENDLOOP###$/ ); push @buffer, $line; } - my(%lubs)=( + my %lubs = ( 'address' => $cust_main->address2 ? [ $cust_main->address1, $cust_main->address2 ] : [ $cust_main->address1 ] @@ -420,8 +395,8 @@ sub submit_internic { 'secondary_ip' => [ @nameserver_ips ], ); LOOP: while (1) { - my(@xbuffer)=@buffer; - SUBLOOP: while ( defined($line = shift @xbuffer) ) { + my @xbuffer = @buffer; + SUBLOOP: while ( defined( $line = shift @xbuffer ) ) { if ( $line =~ /###(\w+)###/ ) { #last LOOP unless my($lub)=shift@{$lubs{$1}}; next OLOOP unless my $lub = shift @{$lubs{$1}}; @@ -445,23 +420,23 @@ sub submit_internic { } #OLOOP - my($subject); + my $subject; if ( $self->action eq "M" ) { $subject = "MODIFY DOMAIN ". $self->domain; - } elsif ($self->action eq "N" ) { + } elsif ( $self->action eq "N" ) { $subject = "NEW DOMAIN ". $self->domain; } else { croak "submit_internic called with action ". $self->action; } - $ENV{SMTPHOSTS}=$smtpmachine; - $ENV{MAILADDRESS}=$from; - my($header)=Mail::Header->new( [ + $ENV{SMTPHOSTS} = $smtpmachine; + $ENV{MAILADDRESS} = $from; + my $header = Mail::Header->new( [ "From: $from", "To: $to", "Sender: $from", "Reply-To: $from", - "Date: ". time2str("%a, %d %b %Y %X %z",time), + "Date: ". time2str("%a, %d %b %Y %X %z", time), "Subject: $subject", ] ); @@ -476,15 +451,17 @@ sub submit_internic { =back -=head1 BUGS +=head1 VERSION -It doesn't properly override FS::Record yet. +$Id: svc_domain.pm,v 1.4 1998-12-29 11:59:55 ivan Exp $ + +=head1 BUGS All BIND/DNS fields should be included (and exported). -All registries should be supported. +Delete doesn't send a registration template. -Not all configuration access is through FS::Conf! +All registries should be supported. Should change action to a real field. @@ -494,10 +471,6 @@ L, L, L, L, L, L, L, L, schema.html from the base documentation, config.html from the base documentation. -=head1 VERSION - -$Id: svc_domain.pm,v 1.3 1998-11-13 09:56:57 ivan Exp $ - =head1 HISTORY ivan@voicenet.com 97-jul-21 @@ -515,7 +488,10 @@ ivan@sisd.com 98-jul-17-19 pod, some FS::Conf (not complete) ivan@sisd.com 98-sep-23 $Log: svc_domain.pm,v $ -Revision 1.3 1998-11-13 09:56:57 ivan +Revision 1.4 1998-12-29 11:59:55 ivan +mostly properly OO, some work still to be done with svc_ stuff + +Revision 1.3 1998/11/13 09:56:57 ivan change configuration file layout to support multiple distinct databases (with own set of config files, export, etc.) diff --git a/site_perl/table_template-svc.pm b/site_perl/table_template-svc.pm index d4536e5f6..4180d8d13 100644 --- a/site_perl/table_template-svc.pm +++ b/site_perl/table_template-svc.pm @@ -2,7 +2,6 @@ package FS::svc_table; use strict; use vars qw(@ISA); -use Exporter; use FS::Record qw(fields qsearch qsearchs); use FS::cust_svc; @@ -16,8 +15,8 @@ FS::table_name - Object methods for table_name records use FS::table_name; - $record = create FS::table_name \%hash; - $record = create FS::table_name { 'column' => 'value' }; + $record = new FS::table_name \%hash; + $record = new FS::table_name { 'column' => 'value' }; $error = $record->insert; @@ -48,7 +47,7 @@ FS::Record. The following fields are currently supported: =over 4 -=item create HASHREF +=item new HASHREF Creates a new example. To add the example to the database, see L<"insert">. @@ -57,12 +56,7 @@ points to. You can ask the object for a copy with the I method. =cut -sub create { - my($proto,$hashref)=@_; - - $proto->new('svc_table',$hashref); - -} +sub table { 'table_name'; } =item insert @@ -226,7 +220,7 @@ sub check { =head1 VERSION -$Id: table_template-svc.pm,v 1.2 1998-11-15 04:33:01 ivan Exp $ +$Id: table_template-svc.pm,v 1.3 1998-12-29 11:59:56 ivan Exp $ =head1 BUGS @@ -242,7 +236,10 @@ froom the base documentation. ivan@voicenet.com 97-jul-21 $Log: table_template-svc.pm,v $ -Revision 1.2 1998-11-15 04:33:01 ivan +Revision 1.3 1998-12-29 11:59:56 ivan +mostly properly OO, some work still to be done with svc_ stuff + +Revision 1.2 1998/11/15 04:33:01 ivan updates for newest versoin diff --git a/site_perl/table_template.pm b/site_perl/table_template.pm index 8945a39d7..0173bc5cf 100644 --- a/site_perl/table_template.pm +++ b/site_perl/table_template.pm @@ -1,10 +1,8 @@ package FS::table_name; use strict; -use vars qw (@ISA); -use Exporter; -#use FS::UID qw(getotaker); -use FS::Record qw(hfields qsearch qsearchs); +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs ); @ISA = qw(FS::Record); @@ -16,8 +14,8 @@ FS::table_name - Object methods for table_name records use FS::table_name; - $record = create FS::table_name \%hash; - $record = create FS::table_name { 'column' => 'value' }; + $record = new FS::table_name \%hash; + $record = new FS::table_name { 'column' => 'value' }; $error = $record->insert; @@ -42,7 +40,7 @@ FS::Record. The following fields are currently supported: =over 4 -=item create HASHREF +=item new HASHREF Creates a new example. To add the example to the database, see L<"insert">. @@ -51,12 +49,9 @@ points to. You can ask the object for a copy with the I method. =cut -sub create { - my($proto,$hashref)=@_; +# the new method can be inherited from FS::Record, if a table method is defined - $proto->new('table_name',$hashref); - -} +sub table { 'table_name'; } =item insert @@ -65,18 +60,7 @@ otherwise returns false. =cut -sub insert { - my($self)=@_; - - #local $SIG{HUP} = 'IGNORE'; - #local $SIG{INT} = 'IGNORE'; - #local $SIG{QUIT} = 'IGNORE'; - #local $SIG{TERM} = 'IGNORE'; - #local $SIG{TSTP} = 'IGNORE'; - - $self->check or - $self->add; -} +# the insert method can be inherited from FS::Record =item delete @@ -84,11 +68,7 @@ Delete this record from the database. =cut -sub delete { - my($self)=@_; - - $self->del; -} +# the delete method can be inherited from FS::Record =item replace OLD_RECORD @@ -97,30 +77,21 @@ returns the error, otherwise returns false. =cut -sub replace { - my($new,$old)=@_; - return "(Old) Not a table_name record!" unless $old->table eq "table_name"; - - return "Can't change keyfield!" - unless $old->getfield('keyfield') eq $new->getfield('keyfield'); - - $new->check or - $new->rep($old); -} - +# the replace method can be inherited from FS::Record =item check Checks all fields to make sure this is a valid example. If there is an error, returns the error, otherwise returns false. Called by the insert -and repalce methods. +and replace methods. =cut -sub check { - my($self)=@_; - return "Not a table_name record!" unless $self->table eq "table_name"; +# the check method should currently be supplied - FS::Record contains some +# data checking routines +sub check { + my $self = shift; ''; #no error } @@ -129,7 +100,7 @@ sub check { =head1 VERSION -$Id: table_template.pm,v 1.3 1998-11-15 04:33:00 ivan Exp $ +$Id: table_template.pm,v 1.4 1998-12-29 11:59:57 ivan Exp $ =head1 BUGS @@ -137,7 +108,7 @@ The author forgot to customize this manpage. =head1 SEE ALSO -L +L, schema.html from the base documentation. =head1 HISTORY @@ -147,7 +118,10 @@ added hfields ivan@sisd.com 97-nov-13 $Log: table_template.pm,v $ -Revision 1.3 1998-11-15 04:33:00 ivan +Revision 1.4 1998-12-29 11:59:57 ivan +mostly properly OO, some work still to be done with svc_ stuff + +Revision 1.3 1998/11/15 04:33:00 ivan updates for newest versoin Revision 1.2 1998/11/15 03:48:49 ivan diff --git a/site_perl/type_pkgs.pm b/site_perl/type_pkgs.pm index a71579603..e19345e7c 100644 --- a/site_perl/type_pkgs.pm +++ b/site_perl/type_pkgs.pm @@ -1,12 +1,12 @@ package FS::type_pkgs; use strict; -use vars qw(@ISA @EXPORT_OK); -use Exporter; -use FS::Record qw(fields qsearchs); +use vars qw( @ISA ); +use FS::Record qw( qsearchs ); +use FS::agent_type; +use FS::part_pkg; -@ISA = qw(FS::Record Exporter); -@EXPORT_OK = qw(fields); +@ISA = qw( FS::Record ); =head1 NAME @@ -16,8 +16,8 @@ FS::type_pkgs - Object methods for type_pkgs records use FS::type_pkgs; - $record = create FS::type_pkgs \%hash; - $record = create FS::type_pkgs { 'column' => 'value' }; + $record = new FS::type_pkgs \%hash; + $record = new FS::type_pkgs { 'column' => 'value' }; $error = $record->insert; @@ -45,67 +45,29 @@ FS::Record. The following fields are currently supported: =over 4 -=item create HASHREF +=item new HASHREF Create a new record. To add the record to the database, see L<"insert">. =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my($field); - #foreach $field (fields('type_pkgs')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('type_pkgs',$hashref); - -} +sub table { 'type_pkgs'; } =item insert Adds this record to the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub insert { - my($self)=@_; - - $self->check or - $self->add; -} - =item delete Deletes this record from the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub delete { - my($self)=@_; - - $self->del; -} - =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)=@_; - return "(Old) Not a type_pkgs record!" unless $old->table eq "type_pkgs"; - - $new->check or - $new->rep($old); -} - =item check Checks all fields to make sure this is a valid record. If there is an error, @@ -115,25 +77,36 @@ methods. =cut sub check { - my($self)=@_; - return "Not a type_pkgs record!" unless $self->table eq "type_pkgs"; - my($recref) = $self->hashref; + my $self = shift; + + my $error = + $self->ut_number('typenum') + || $self->ut_number('pkgpart') + ; + return $error if $error; - $recref->{typenum} =~ /^(\d+)$/ or return "Illegal typenum"; - $recref->{typenum} = $1; return "Unknown typenum" - unless qsearchs('agent_type',{'typenum'=>$recref->{typenum}}); + unless qsearchs( 'agent_type', { 'typenum' => $self->typenum } ); - $recref->{pkgpart} =~ /^(\d+)$/ or return "Illegal pkgpart"; - $recref->{pkgpart} = $1; return "Unknown pkgpart" - unless qsearchs('part_pkg',{'pkgpart'=>$recref->{pkgpart}}); + unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); ''; #no error } =back +=head1 VERSION + +$Id: type_pkgs.pm,v 1.2 1998-12-29 11:59:58 ivan Exp $ + +=head1 BUGS + +=head1 SEE ALSO + +L, L, L, schema.html from the base +documentation. + =head1 HISTORY Defines the relation between agent types and pkgparts @@ -144,6 +117,11 @@ ivan@sisd.com 97-nov-13 change to ut_ FS::Record, fixed bugs ivan@sisd.com 97-dec-10 +$Log: type_pkgs.pm,v $ +Revision 1.2 1998-12-29 11:59:58 ivan +mostly properly OO, some work still to be done with svc_ stuff + + =cut 1;