mostly properly OO, some work still to be done with svc_ stuff

diff --git a/TODO b/TODO
index 24461b6..5c8e02c 100644 (file)
--- 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 
 
 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 --
 
 
 -- 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
 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 b8d565c..0f098b4 100644 (file)
--- a/site_perl/Record.pm
+++ b/site_perl/Record.pm
@@ -26,7 +26,7 @@ FS::Record - Database record objects
 =head1 SYNOPSIS
 
     use FS::Record;
 =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', ... };
 
     $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;
 
 
     $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');
 
 
     $value = $record->unique('column');
 


@@ -80,7 +83,8 @@ FS::Record - Database record objects
     $fields = hfields('table');
     if ( $fields->{Field} ) { # etc.
 
     $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
 
 
 =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.
 
 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
 
 
 =over 4
 

-=item new TABLE, HASHREF
+=item new [ TABLE, ] HASHREF

 
 Creates a new record.  It doesn't store it in the database, though.  See
 
 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<hash> 
 method.
 
 
 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<hash> 
 method.
 

+TABLE can only be omitted when a dervived class overrides the table method.
+

 =cut
 
 sub new { 
 =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/ 
     #(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);
   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
 }
 
 =item qsearch TABLE, HASHREF


@@ -158,8 +155,6 @@ objects.
 
 =cut
 
 
 =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;
 sub qsearch {
   my($table,$record) = @_;
   my($dbh) = dbh;


@@ -181,7 +176,7 @@ sub qsearch {
 
   if ( eval ' scalar(@FS::'. $table. '::ISA);' ) {
     map {
 
   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";
     } ( 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(@_);
 
 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];
 }
 
     #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.
 =item table
 
 Returns the table name.


@@ -214,7 +215,8 @@ Returns the table name.
 =cut
 
 sub table {
 =cut
 
 sub table {

-  my($self) = @_;
+#  cluck "warning: FS::Record::table depriciated; supply one in subclass!";
+  my $self = shift;

   $self -> {'Table'};
 }
 
   $self -> {'Table'};
 }
 


@@ -246,7 +248,8 @@ sub get {
   }
 }
 sub getfield {
   }
 }
 sub getfield {

-  get(@_);
+  my $self = shift;
+  $self->get(@_);

 }
 
 =item set, setfield COLUMN, VALUE
 }
 
 =item set, setfield COLUMN, VALUE


@@ -260,7 +263,8 @@ sub set {
   $self->{'Hash'}->{$field} = $value;
 }
 sub setfield {
   $self->{'Hash'}->{$field} = $value;
 }
 sub setfield {

-  set(@_);
+  my $self = shift;
+  $self->set(@_);

 }
 
 =item AUTLOADED METHODS
 }
 
 =item AUTLOADED METHODS


@@ -308,41 +312,41 @@ sub hashref {
   $self->{'Hash'};
 }
 
   $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
 
 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)
 
   #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
     $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);
 
   $self->unique($primary_key) 
     if $primary_key && ! $self->getfield($primary_key);
 

-  my (@fields) =
+  my @fields =

     grep defined($self->getfield($_)) && $self->getfield($_) ne "",
     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(', ',@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';
 
   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
 
 
 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"
     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';
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';


@@ -385,8 +397,7 @@ sub del {
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
 
   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!
   #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
 
 
 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 '';
   }
 
     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 {
     map {

-      "$_ = ". _quote($new->getfield($_),$table,$_) 
+      "$_ = ". _quote($new->getfield($_),$old->table,$_) 

     } @diff
   ). ' WHERE '.
     join(' AND ',
       map {
         $old->getfield($_) eq ''
           ? "$_ IS NULL"
     } @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';
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';


@@ -443,14 +463,34 @@ sub rep {
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
 
   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";
 
   '';
 
 }
 
   #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<add> method
 =item unique COLUMN
 
 Replaces COLUMN in record with a unique number.  Called by the B<add> 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<dbdef_table>).
+
+=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
 
 
 =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 {
 =cut
 
 sub hfields {

-  carp "hfields is depriciated";
+  carp "warning: hfields is depriciated";

   my($table)=@_;
   my(%hash);
   foreach (fields($table)) {
   my($table)=@_;
   my(%hash);
   foreach (fields($table)) {


@@ -720,23 +783,6 @@ sub hfields {
   \%hash;
 }
 
   \%hash;
 }
 

-=item fields TABLE
-
-This returns a list of the columns in this record's table
-(See L<dbdef_table>).
-
-=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 {
 #sub _dump {
 #  my($self)=@_;
 #  join("\n", map {


@@ -759,7 +805,7 @@ sub fields {
 
 =head1 VERSION
 
 
 =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
 
 
 =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.
 
 
 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<FS::dbdef>, L<FS::UID>, L<DBI>
 =head1 SEE ALSO
 
 L<FS::dbdef>, L<FS::UID>, L<DBI>


@@ -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 $
 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
 "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 ab06f67..7632d2f 100644 (file)
--- a/site_perl/agent.pm
+++ b/site_perl/agent.pm
@@ -1,14 +1,12 @@
 package FS::agent;
 
 use strict;
 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;
 
 use FS::cust_main;
 use FS::agent_type;
 

-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
+@ISA = qw( FS::Record );

 
 =head1 NAME
 
 
 =head1 NAME
 


@@ -18,8 +16,8 @@ FS::agent - Object methods for agent records
 
   use FS::agent;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -53,38 +51,19 @@ from FS::Record.  The following fields are currently supported:
 
 =over 4
 
 
 =over 4
 

-=item create HASHREF
+=item new HASHREF

 
 Creates a new agent.  To add the agent to the database, see L<"insert">.
 
 =cut
 
 
 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.
 
 
 =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
 =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 {
 =cut
 
 sub delete {

-  my($self)=@_;
+  my $self = shift;
+

   return "Can't delete an agent with customers!"
   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
 }
 
 =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.
 
 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,
 =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 {
 =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')
     $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!"
   ;
   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
 
 
 =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
 
 
 =head1 SEE ALSO
 

diff --git a/site_perl/agent_type.pm b/site_perl/agent_type.pm
index 002c36f..54a91c8 100644 (file)
--- a/site_perl/agent_type.pm
+++ b/site_perl/agent_type.pm
@@ -1,12 +1,10 @@
 package FS::agent_type;
 
 use strict;
 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
 
 
 =head1 NAME
 


@@ -16,8 +14,8 @@ FS::agent_type - Object methods for agent_type records
 
   use FS::agent_type;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -47,40 +45,20 @@ FS::Record.  The following fields are currently supported:
 
 =over 4
 
 
 =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
 
 
 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.
 
 
 =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
 =item delete
 
 Deletes this agent type from the database.  Only agent types with no agents


@@ -90,10 +68,12 @@ false.
 =cut
 
 sub delete {
 =cut
 
 sub delete {

-  my($self)=@_;
+  my $self = shift;
+

   return "Can't delete an agent_type with agents!"
   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
 }
 
 =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.
 
 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
 =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 {
 =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');
 
   $self->ut_numbern('typenum')
   or $self->ut_text('atype');


@@ -131,9 +99,11 @@ sub check {
 
 =back
 
 
 =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
 
 
 =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
 
 
 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;
 =cut
 
 1;

diff --git a/site_perl/cust_bill.pm b/site_perl/cust_bill.pm
index 455fc2d..3706aa4 100644 (file)
--- a/site_perl/cust_bill.pm
+++ b/site_perl/cust_bill.pm
@@ -1,12 +1,16 @@
 package FS::cust_bill;
 
 use strict;
 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 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 { 
 
 #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;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -72,7 +76,7 @@ all payments (see L<FS::cust_pay>).
 
 =over 4
 
 
 =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
 
 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
 
 
 =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
 
 
 =item insert
 


@@ -103,14 +97,13 @@ automatically set to charged).
 =cut
 
 sub insert {
 =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;
 
   return "owed != charged!"
     unless $self->owed == $self->charged;
 

-  $self->check or
-  $self->add;
+  $self->SUPER::insert;

 }
 
 =item delete
 }
 
 =item delete


@@ -122,8 +115,6 @@ no record you ever posted this invoice (which is bad, no?)
 
 sub delete {
   return "Can't remove invoice!"
 
 sub delete {
   return "Can't remove invoice!"

-  #my($self)=@_;
-  #$self->del;

 }
 
 =item replace OLD_RECORD
 }
 
 =item replace OLD_RECORD


@@ -138,21 +129,13 @@ calling the collect method of a customer object (see L<FS::cust_main>).
 =cut
 
 sub replace {
 =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
 }
 
 =item check


@@ -164,30 +147,24 @@ methods.
 =cut
 
 sub check {
 =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"
   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
 }
 
   ''; #no error
 }


@@ -200,13 +177,13 @@ followed by the previous outstanding invoices (as FS::cust_bill objects also).
 =cut
 
 sub previous {
 =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 }
     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;
 }
 
   $total, @cust_bill;
 }
 


@@ -217,7 +194,7 @@ Returns the line items (see L<FS::cust_bill_pkg>) for this invoice.
 =cut
 
 sub cust_bill_pkg {
 =cut
 
 sub cust_bill_pkg {

-  my($self)=@_;
+  my $self = shift;

   qsearch( 'cust_bill_pkg', { 'invnum' => $self->invnum } );
 }
 
   qsearch( 'cust_bill_pkg', { 'invnum' => $self->invnum } );
 }
 


@@ -230,9 +207,9 @@ credits (FS::cust_credit objects).
 =cut
 
 sub cust_credit {
 =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 } )
   ;
     grep { $_->credited != 0 && $_->_date < $self->_date }
       qsearch('cust_credit', { 'custnum' => $self->custnum } )
   ;


@@ -247,7 +224,7 @@ Returns all payments (see L<FS::cust_pay>) for this invoice.
 =cut
 
 sub cust_pay {
 =cut
 
 sub cust_pay {

-  my($self)=@_;
+  my $self = shift;

   sort { $a->_date <=> $b->date }
     qsearch( 'cust_pay', { 'invnum' => $self->invnum } )
   ;
   sort { $a->_date <=> $b->date }
     qsearch( 'cust_pay', { 'invnum' => $self->invnum } )
   ;


@@ -266,27 +243,25 @@ L<Time::Local> and L<Date::Parse> for conversion functions.
 
 sub print_text {
 
 
 sub print_text {
 

-  my($self,$today)=@_;
+  my( $self, $today ) = ( shift, shift );

   $today ||= time;
   $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?
 
   #overdue?

-  my($overdue) = ( 
+  my $overdue = ( 

     $balance_due > 0
     && $today > $self->_date 
     && $self->printed > 1
   );
 
     $balance_due > 0
     && $today > $self->_date 
     && $self->printed > 1
   );
 

-  #printing bits here
+  #printing bits here (yuck!)

 
   local($SIG{CHLD}) = sub { wait() };
   $|=1;
 
   local($SIG{CHLD}) = sub { wait() };
   $|=1;


@@ -459,12 +434,14 @@ $address[4],''
 
 =back
 
 
 =back
 

+=head1 VERSION
+
+$Id: cust_bill.pm,v 1.4 1998-12-29 11:59:36 ivan Exp $
+

 =head1 BUGS
 
 The delete method.
 
 =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
 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 $
 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.)
 
 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 e41d7c1..a525394 100644 (file)
--- 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;
 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
 
 
 =head1 NAME
 


@@ -16,8 +16,8 @@ FS::cust_bill_pkg - Object methods for cust_bill_pkg records
 
   use FS::cust_bill_pkg;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -56,7 +56,7 @@ see L<Time::Local> and L<Date::Parse> for conversion functions.
 
 =over 4
 
 
 =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
 
 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<FS::cust_main>).
 
 =cut
 
 
 =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.
 
 
 =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
 =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!";
 
 sub delete {
   return "Can't delete cust_bill_pkg records!";

-  #my($self)=@_;
-  #$self->del;

 }
 
 =item replace OLD_RECORD
 }
 
 =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!";
 
 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
 }
 
 =item check


@@ -130,35 +102,36 @@ method.
 =cut
 
 sub check {
 =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')
     $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 $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"
   }
 
   return "Unknown invnum"

-    unless qsearchs('cust_bill',{'invnum'=> $self->invnum });
+    unless qsearchs( 'cust_bill' ,{ 'invnum' => $self->invnum } );

 
   ''; #no error
 }
 
 =back
 
 
   ''; #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
 
 
 =head1 SEE ALSO
 

diff --git a/site_perl/cust_credit.pm b/site_perl/cust_credit.pm
index b1a5e16..321c01b 100644 (file)
--- a/site_perl/cust_credit.pm
+++ b/site_perl/cust_credit.pm
@@ -1,13 +1,12 @@
 package FS::cust_credit;
 
 use strict;
 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
 
 
 =head1 NAME
 


@@ -17,8 +16,8 @@ FS::cust_credit - Object methods for cust_credit records
 
   use FS::cust_credit;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -57,23 +56,13 @@ L<Time::Local> and L<Date::Parse> for conversion functions.
 
 =over 4
 
 
 =over 4
 

-=item create HASHREF
+=item new HASHREF

 
 Creates a new credit.  To add the credit to the database, see L<"insert">.
 
 =cut
 
 
 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
 
 
 =item insert
 


@@ -86,14 +75,13 @@ automatically set to amount).
 =cut
 
 sub insert {
 =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;
 
   return "credited != amount!"
     unless $self->credited == $self->amount;
 

-  $self->check or
-  $self->add;
+  $self->SUPER::insert;

 }
 
 =item delete
 }
 
 =item delete


@@ -104,8 +92,6 @@ Currently unimplemented.
 
 sub delete {
   return "Can't remove credit!"
 
 sub delete {
   return "Can't remove credit!"

-  #my($self)=@_;
-  #$self->del;

 }
 
 =item replace OLD_RECORD
 }
 
 =item replace OLD_RECORD


@@ -119,21 +105,15 @@ inserting a refund (see L<FS::cust_refund>).
 =cut
 
 sub replace {
 =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!"
   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
 }
 
 =item check


@@ -145,43 +125,38 @@ methods.
 =cut
 
 sub check {
 =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"
   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->otaker(getotaker);
 

-  $self->ut_textn('reason');
-
+  ''; #no error

 }
 
 =back
 
 }
 
 =back
 

+=head1 VERSION
+
+$Id: cust_credit.pm,v 1.2 1998-12-29 11:59:38 ivan Exp $
+

 =head1 BUGS
 
 The delete method.
 
 =head1 BUGS
 
 The delete method.
 

-It doesn't properly override FS::Record yet.
-

 =head1 SEE ALSO
 
 L<FS::Record>, L<FS::cust_refund>, L<FS::cust_bill>, schema.html from the base
 =head1 SEE ALSO
 
 L<FS::Record>, L<FS::cust_refund>, L<FS::cust_bill>, 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
 
 
 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;
 =cut
 
 1;

diff --git a/site_perl/cust_main.pm b/site_perl/cust_main.pm
index 6c9c0b1..77ebb2d 100644 (file)
--- 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;
 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 Safe;

-use Exporter;

 use Carp;
 use Time::Local;
 use Date::Format;
 use Date::Manip;
 use Business::CreditCard;
 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;
 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;
 
 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 { 
 
 #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;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -158,7 +156,7 @@ FS::Record.  The following fields are currently supported:
 
 =over 4
 
 
 =over 4
 

-=item create HASHREF
+=item new HASHREF

 
 Creates a new customer.  To add the customer to the database, see L<"insert">.
 
 
 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<hash> method.
 
 =cut
 
 
 =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.
 
 
 =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
 =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
 
 
 =cut
 

-# Usage: $error = $record -> delete;

 sub delete {
    return "Can't (yet?) delete customers.";
 sub delete {
    return "Can't (yet?) delete customers.";

-#  my($self)=@_;
-#
-#  $self->del;

 }
 
 =item replace OLD_RECORD
 }
 
 =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.
 
 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
 =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 {
 =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')
 
   my $error =
     $self->ut_number('agentnum')


@@ -263,10 +218,10 @@ sub check {
   return $error if $error;
 
   return "Unknown agent"
   return $error if $error;
 
   return "Unknown agent"

-    unless qsearchs('agent',{'agentnum'=>$self->agentnum});
+    unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );

 
   return "Unknown referral"
 
   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);
 
   $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";
     $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' ) {
 
 
   } 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' ) {
 
 
   } 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<FS::cust_pkg>) for this customer.
 =cut
 
 sub all_pkgs {
 =cut
 
 sub all_pkgs {

-  my($self)=@_;
+  my $self = shift;

   qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
 }
 
   qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
 }
 


@@ -382,7 +332,7 @@ Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
 =cut
 
 sub ncancelled_pkgs {
 =cut
 
 sub ncancelled_pkgs {

-  my($self)=@_;
+  my $self = shift;

   qsearch( 'cust_pkg', {
     'custnum' => $self->custnum,
     'cancel'  => '',
   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 {
 =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';
 
   #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.
  
   # 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') } )
   ) {
 
     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);
  
 
     #? 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
 
     #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
 
     # bill setup

-    my($setup)=0;
+    my $setup = 0;

     unless ( $cust_pkg->setup ) {
     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->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 ", 
       $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
     }
 
     #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
     ) {
     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->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 ",
       $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;
         #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++; }
           (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);
 
     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);
       $error=$cust_pkg->replace($old_cust_pkg);

-      if ( $error ) {
+      if ( $error ) { #just in case

         warn "Error modifying pkgnum ", $cust_pkg->pkgnum, ": $error";
       } else {
         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,
           '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;
 
 
   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 * ( $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,
       'pkgnum' => 0,
       'setup'  => $tax,
       'recur'  => 0,


@@ -544,23 +489,23 @@ sub bill {
     push @cust_bill_pkg, $cust_bill_pkg;
   }
 
     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,
   } );
     '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;
 
   #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 ) {
   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"
     #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 {
 =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?
   return '' unless $total_owed > 0; #redundant?????
 
   #put below somehow?


@@ -609,90 +554,84 @@ sub collect {
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
 
   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
 
     #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
                                   : $cust_bill->owed
     );

-    $total_owed = sprintf("%.2f",$total_owed-$amount);
+    $total_owed = sprintf( "%.2f", $total_owed - $amount );

 
     next unless $cust_bill->owed > 0;
 
 
     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;
 
 
     #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
 
       #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
       ) {
 
       #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";
 
         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'}++;
         $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',
          'paid' => $amount,
          '_date' => '',
          'payby' => 'COMP',

-         'payinfo' => $self->getfield('payinfo'),
+         'payinfo' => $self->payinfo,

          'paybatch' => ''
       } );
          '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;
              ':' . $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 ( $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
 
           #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'),
             'Order-ID'     => $paybatch,
             'Amount'       => "usd $amount",
             'Card-Number'  => $self->getfield('payinfo'),


@@ -705,7 +644,7 @@ sub collect {
             'Card-Exp'     => $exp,
           );
 
             'Card-Exp'     => $exp,
           );
 

-          my(%result);
+          my %result;

           if ( $processor eq 'cybercash2' ) {
             $^W=0; #CCLib isn't -w safe, ugh!
             %result = &CCLib::sendmserver(@full_xaction);
           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
           #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',
                'paid'     => $amount,
                '_date'     => '',
                'payby'    => 'CARD',

-               'payinfo'  => $self->getfield('payinfo'),
+               'payinfo'  => $self->payinfo,

                'paybatch' => "$processor:$paybatch",
             } );
                'paybatch' => "$processor:$paybatch",
             } );

-            my($error)=$cust_pay->insert;
+            my $error = $cust_pay->insert;

             return 'Error applying payment, invnum #' . 
             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 #' . 
           } 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 '';
           }
           } else {
             return '';
           }


@@ -744,8 +683,7 @@ sub collect {
 
       } else { #batch card
 
 
       } 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'),
          '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,
        } );
          '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 "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 {
 =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
 }
 
 =item total_credited


@@ -803,15 +739,14 @@ Returns the total credits (see L<FS::cust_credit>) for this customer.
 =cut
 
 sub total_credited {
 =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
 }
 
 =item balance


@@ -821,8 +756,8 @@ Returns the balance for this customer (total owed minus total credited).
 =cut
 
 sub balance {
 =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, ... ]
 }
 
 =item invoicing_list [ ITEM, ITEM, ... ]


@@ -836,20 +771,20 @@ Returns a list of email addresses (with svcnum entries expanded).
 =cut
 
 sub invoicing_list {
 =cut
 
 sub invoicing_list {

-  my($self, @addresses) = @_;
+  my( $self, @addresses ) = @_;

   if ( @addresses ) {
     my @cust_main_invoice = 
   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 =
     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 ) {
     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,
         );
           'custnum' => $self->custnum,
           'dest'    => $address,
         );


@@ -859,7 +794,7 @@ sub invoicing_list {
     }
   }
   map { $_->address }
     }
   }
   map { $_->address }

-    qsearch('cust_main_invoice', { 'custnum' => $self->custnum } );
+    qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );

 }
 
 =item check_invoicing_list ITEM, ITEM
 }
 
 =item check_invoicing_list ITEM, ITEM


@@ -870,9 +805,9 @@ is an error, returns the error, otherwise returns false.
 =cut
 
 sub check_invoicing_list {
 =cut
 
 sub check_invoicing_list {

-  my($self, @addresses) = @_;
+  my( $self, @addresses ) = @_;

   foreach my $address ( @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,
     );
       'custnum' => $self->custnum,
       'dest'    => $address,
     );


@@ -884,19 +819,26 @@ sub check_invoicing_list {
 
 =back
 
 
 =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.
 
 
 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<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
 =head1 SEE ALSO
 
 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>


@@ -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 $
 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
 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 9c81406..1ecaed1 100644 (file)
--- 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;
 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
 
 
 =head1 NAME
 


@@ -16,8 +14,8 @@ FS::cust_main_county - Object methods for cust_main_county objects
 
   use FS::cust_main_county;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -51,68 +49,29 @@ currently supported:
 
 =over 4
 
 
 =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
 
 
 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.
 
 
 =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.
 
 =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.
 
 =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,
 =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 {
 =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')
 
   $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
 
 
 =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
 
 
 =head1 BUGS
 

-It doesn't properly override FS::Record yet.
-

 =head1 SEE ALSO
 
 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base
 =head1 SEE ALSO
 
 L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, 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 $
 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!
 
 
 i18n! i18n!
 
 

diff --git a/site_perl/cust_main_invoice.pm b/site_perl/cust_main_invoice.pm
index 90d653a..9c1a86a 100644 (file)
--- 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 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::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 { 
 
 #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;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -54,7 +56,7 @@ FS::Record.  The following fields are currently supported:
 
 =over 4
 
 
 =over 4
 

-=item create HASHREF
+=item new HASHREF

 
 Creates a new invoice destination.  To add the invoice destination to the database, see L<"insert">.
 
 
 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<hash> method.
 
 =cut
 
 
 =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.
 
 
 =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.
 
 =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,
 =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 {
 =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 {
 =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')
 
   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)"
     #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 ) {
   } 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);
       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+)$/ ) {
 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;
     $svc_acct->username . '@' . $mydomain;
   } else {
     $self->dest;


@@ -184,7 +152,7 @@ sub address {
 
 =head1 VERSION
 
 
 =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
 
 
 =head1 BUGS
 


@@ -200,7 +168,10 @@ added hfields
 ivan@sisd.com 97-nov-13
 
 $Log: cust_main_invoice.pm,v $
 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
 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 6e30c59..fc9112b 100644 (file)
--- a/site_perl/cust_pay.pm
+++ b/site_perl/cust_pay.pm
@@ -1,14 +1,12 @@
 package FS::cust_pay;
 
 use strict;
 package FS::cust_pay;
 
 use strict;

-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
+use vars qw( @ISA );

 use Business::CreditCard;
 use Business::CreditCard;

-use FS::Record qw(fields qsearchs);
+use FS::Record qw( qsearchs );

 use FS::cust_bill;
 
 use FS::cust_bill;
 

-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
+@ISA = qw( FS::Record );

 
 =head1 NAME
 
 
 =head1 NAME
 


@@ -18,8 +16,8 @@ FS::cust_pay - Object methods for cust_pay objects
 
   use FS::cust_pay;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -57,24 +55,13 @@ L<Time::Local> and L<Date::Parse> for conversion functions.
 
 =over 4 
 
 
 =over 4 
 

-=item create HASHREF
+=item new HASHREF

 
 Creates a new payment.  To add the payment to the databse, see L<"insert">.
 
 =cut
 
 
 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
 
 
 =item insert
 


@@ -84,20 +71,18 @@ L<FS::cust_bill>).
 =cut
 
 sub insert {
 =cut
 
 sub insert {

-  my($self)=@_;
+  my $self = shift;

 
 

-  my($error);
+  my $error;

 
 

-  $error=$self->check;
+  $error = $self->check;

   return $error if $error;
 
   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;
   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';
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';


@@ -105,10 +90,10 @@ sub insert {
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
 
   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;
 
   return "Error modifying cust_bill: $error" if $error;
 

-  $self->add;
+  $self->SUPER::insert;

 }
 
 =item delete
 }
 
 =item delete


@@ -119,10 +104,6 @@ Currently unimplemented (accounting reasons).
 
 sub delete {
   return "Can't (yet?) delete cust_pay records!";
 
 sub delete {
   return "Can't (yet?) delete cust_pay records!";

-#template code below
-#  my($self)=@_;
-#
-#  $self->del;

 }
 
 =item replace OLD_RECORD
 }
 
 =item replace OLD_RECORD


@@ -133,12 +114,6 @@ Currently unimplemented (accounting reasons).
 
 sub replace {
    return "Can't (yet?) modify cust_pay records!";
 
 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
 }
 
 =item check


@@ -149,61 +124,43 @@ returns the error, otherwise returns false.  Called by the insert method.
 =cut
 
 sub check {
 =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)";
         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 {
     } 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
 
 
   ''; #no error
 


@@ -211,9 +168,11 @@ sub check {
 
 =back
 
 
 =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.
 
 
 Delete and replace methods.
 


@@ -229,6 +188,11 @@ new api ivan@sisd.com 98-mar-13
 
 pod ivan@sisd.com 98-sep-21
 
 
 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;
 =cut
 
 1;

diff --git a/site_perl/cust_pay_batch.pm b/site_perl/cust_pay_batch.pm
index f40a049..f7350c1 100644 (file)
--- 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;
 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;
 
 use Business::CreditCard;
 

-@ISA = qw(FS::Record);
+@ISA = qw( FS::Record );

 
 =head1 NAME
 
 
 =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;
 
 
 =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;
 
 
   $error = $record->insert;
 


@@ -73,7 +71,7 @@ following fields are currently supported:
 
 =over 4
 
 
 =over 4
 

-=item create HASHREF
+=item new HASHREF

 
 Creates a new record.  To add the record to the database, see L<"insert">.
 
 
 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<hash> method.
 
 =cut
 
 
 =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.
 
 
 =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
 
 =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
 
 
 =item replace OLD_RECORD
 


@@ -135,40 +102,30 @@ sub delete {
 =cut
 
 sub replace {
 =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
 
   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 {
 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')
 
   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;
   ;
 
   return $error if $error;


@@ -186,12 +143,7 @@ sub check {
   $cardnum = $1;
   $self->cardnum($cardnum);
   validate($cardnum) or return "Illegal credit card number";
   $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";
 
   if ( $self->exp eq '' ) {
     return "Expriation date required";


@@ -231,10 +183,13 @@ sub check {
 
 =head1 VERSION
 
 
 =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
 
 
 =head1 BUGS
 

+There should probably be a configuration file with a list of allowed credit
+card types.
+

 =head1 SEE ALSO
 
 L<FS::cust_main>, L<FS::Record>
 =head1 SEE ALSO
 
 L<FS::cust_main>, L<FS::Record>


@@ -247,7 +202,10 @@ added hfields
 ivan@sisd.com 97-nov-13
 
 $Log: cust_pay_batch.pm,v $
 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
 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 5640e24..6619351 100644 (file)
--- 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 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;
 
 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
 
 
 =head1 NAME
 


@@ -19,8 +25,8 @@ FS::cust_pkg - Object methods for cust_pkg objects
 
   use FS::cust_pkg;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -76,44 +82,27 @@ conversion functions.
 
 =over 4
 
 
 =over 4
 

-=item create HASHREF
+=item new HASHREF

 
 Create a new billing item.  To add the item to the database, see L<"insert">.
 
 =cut
 
 
 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.
 
 
 =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.
 
 =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!";
 }
 sub delete {
   return "Can't delete cust_pkg records!";
 }


@@ -138,21 +127,16 @@ in some cases).
 =cut
 
 sub replace {
 =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?
 
   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
 }
 
 =item check


@@ -164,38 +148,28 @@ replace methods.
 =cut
 
 sub check {
 =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"
   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"
   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
 }
 
   ''; #no error
 }


@@ -211,8 +185,8 @@ If there is an error, returns the error, otherwise returns false.
 =cut
 
 sub cancel {
 =cut
 
 sub cancel {

-  my($self)=@_;
-  my($error);
+  my $self = shift;
+  my $error;

 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';


@@ -220,38 +194,34 @@ sub cancel {
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
 
   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!";
       or return "Illegal svcdb value in part_svc!";

-    my($svcdb) = $1;
+    my $svcdb = $1;

     require "FS/$svcdb.pm";
 
     require "FS/$svcdb.pm";
 

-    my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->svcnum } );
+    my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );

     if ($svc) {
     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;
     }
 
       $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') ) {
     $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;
   }
 
     return $error if $error;
   }
 


@@ -268,30 +238,27 @@ If there is an error, returns the error, otherwise returns false.
 =cut
 
 sub suspend {
 =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';
 
   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!";
       or return "Illegal svcdb value in part_svc!";

-    my($svcdb) = $1;
+    my $svcdb = $1;

     require "FS/$svcdb.pm";
 
     require "FS/$svcdb.pm";
 

-    my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } );
-
+    my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );

     if ($svc) {
     if ($svc) {

-      bless($svc,"FS::$svcdb");

       $error = $svc->suspend;
       return $error if $error;
     }
       $error = $svc->suspend;
       return $error if $error;
     }


@@ -299,10 +266,10 @@ sub suspend {
   }
 
   unless ( $self->getfield('susp') ) {
   }
 
   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;
   }
 
     return $error if $error;
   }
 


@@ -319,7 +286,7 @@ If there is an error, returns the error, otherwise returns false.
 =cut
 
 sub unsuspend {
 =cut
 
 sub unsuspend {

-  my($self)=@_;
+  my $self = shift;

   my($error);
 
   local $SIG{HUP} = 'IGNORE';
   my($error);
 
   local $SIG{HUP} = 'IGNORE';


@@ -328,21 +295,18 @@ sub unsuspend {
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = '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!";
       or return "Illegal svcdb value in part_svc!";

-    my($svcdb) = $1;
+    my $svcdb = $1;

     require "FS/$svcdb.pm";
 
     require "FS/$svcdb.pm";
 

-    my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } );
+    my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );

     if ($svc) {
     if ($svc) {

-      bless($svc,"FS::$svcdb");

       $error = $svc->unsuspend;
       return $error if $error;
     }
       $error = $svc->unsuspend;
       return $error if $error;
     }


@@ -350,10 +314,10 @@ sub unsuspend {
   }
 
   unless ( ! $self->getfield('susp') ) {
   }
 
   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;
   }
 
     return $error if $error;
   }
 


@@ -368,8 +332,8 @@ L<FS::part_pkg).
 =cut
 
 sub part_pkg {
 =cut
 
 sub part_pkg {

-  my($self)=@_;
-  qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart });
+  my $self = shift;
+  qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );

 }
 
 =back
 }
 
 =back


@@ -495,12 +459,10 @@ sub order {
 
 =head1 VERSION
 
 
 =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
 
 
 =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.
 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.
 
 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<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>
 =head1 SEE ALSO
 
 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>


@@ -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 $
 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
 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 a30f217..0778473 100644 (file)
--- a/site_perl/cust_refund.pm
+++ b/site_perl/cust_refund.pm
@@ -1,15 +1,13 @@
 package FS::cust_refund;
 
 use strict;
 package FS::cust_refund;
 
 use strict;

-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
+use vars qw( @ISA );

 use Business::CreditCard;
 use Business::CreditCard;

-use FS::Record qw(fields qsearchs);
+use FS::Record qw( qsearchs );

 use FS::UID qw(getotaker);
 use FS::cust_credit;
 
 use FS::UID qw(getotaker);
 use FS::cust_credit;
 

-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
+@ISA = qw( FS::Record );

 
 =head1 NAME
 
 
 =head1 NAME
 


@@ -19,8 +17,8 @@ FS::cust_refund - Object method for cust_refund objects
 
   use FS::cust_refund;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -58,24 +56,13 @@ L<Time::Local> and L<Date::Parse> for conversion functions.
 
 =over 4
 
 
 =over 4
 

-=item create HASHREF
+=item new HASHREF

 
 Creates a new refund.  To add the refund to the database, see L<"insert">.
 
 =cut
 
 
 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
 
 
 =item insert
 


@@ -85,20 +72,19 @@ L<FS::cust_credit>).
 =cut
 
 sub insert {
 =cut
 
 sub insert {

-  my($self)=@_;
+  my $self = shift;

 
 

-  my($error);
+  my $error;

 
   $error=$self->check;
   return $error if $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;
   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';
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';


@@ -106,10 +92,10 @@ sub insert {
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
 
   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;
 
   return "Error modifying cust_credit: $error" if $error;
 

-  $self->add;
+  $self->SUPER::insert;

 }
 
 =item delete
 }
 
 =item delete


@@ -120,10 +106,6 @@ Currently unimplemented (accounting reasons).
 
 sub delete {
   return "Can't (yet?) delete cust_refund records!";
 
 sub delete {
   return "Can't (yet?) delete cust_refund records!";

-#template code below
-#  my($self)=@_;
-#
-#  $self->del;

 }
 
 =item replace OLD_RECORD
 }
 
 =item replace OLD_RECORD


@@ -134,12 +116,6 @@ Currently unimplemented (accounting reasons).
 
 sub replace {
    return "Can't (yet?) modify cust_refund records!";
 
 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
 }
 
 =item check


@@ -150,10 +126,11 @@ returns the error, otherwise returns false.  Called by the insert method.
 =cut
 
 sub check {
 =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')
     $self->ut_number('refundnum')
     || $self->ut_number('crednum')
     || $self->ut_money('amount')


@@ -161,44 +138,27 @@ sub check {
   ;
   return $error if $error;
 
   ;
   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)";
         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 {
     } 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);
   }
 
   $self->otaker(getotaker);


@@ -208,9 +168,11 @@ sub check {
 
 =back
 
 
 =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.
 
 
 Delete and replace methods.
 


@@ -227,6 +189,11 @@ ivan@sisd.com 98-mar-18
 
 pod and finish up ivan@sisd.com 98-sep-21
 
 
 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;
 =cut
 
 1;

diff --git a/site_perl/cust_svc.pm b/site_perl/cust_svc.pm
index ef93f86..f97f5fe 100644 (file)
--- a/site_perl/cust_svc.pm
+++ b/site_perl/cust_svc.pm
@@ -1,10 +1,9 @@
 package FS::cust_svc;
 
 use strict;
 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;
 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;
 
 use FS::svc_acct_sm;
 use FS::svc_domain;
 

-@ISA = qw(FS::Record Exporter);
+@ISA = qw( FS::Record );

 
 =head1 NAME
 
 
 =head1 NAME
 


@@ -22,8 +21,8 @@ FS::cust_svc - Object method for cust_svc objects
 
   use FS::cust_svc;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -54,7 +53,7 @@ The following fields are currently supported:
 
 =over 4
 
 
 =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
 
 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<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_acct_sm>, among others).
 
 =cut
 
 
 =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.
 
 
 =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
 =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<FS::cust_pkg>).
 
 
 Called by the cancel method of the package (see L<FS::cust_pkg>).
 

-=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.
 
 =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,
 =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 {
 =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
   return "Unknown svcpart" unless

-    qsearchs('part_svc',{'svcpart'=>$recref->{svcpart}});
+    qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );

 
   ''; #no error
 }
 
   ''; #no error
 }


@@ -159,12 +118,12 @@ Returns a list consisting of:
 =cut
 
 sub label {
 =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' ) {
   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' ) {
     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 {
   } 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;
     $tag = $svc_x->getfield('svcnum');
   }
   $svc, $tag, $svcdb;


@@ -183,6 +142,10 @@ sub label {
 
 =back
 
 
 =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
 =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).
 
 
 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<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>, 
 =head1 SEE ALSO
 
 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>, 


@@ -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 $
 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
 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 4643b9f..82c7aec 100644 (file)
--- a/site_perl/part_pkg.pm
+++ b/site_perl/part_pkg.pm
@@ -1,12 +1,10 @@
 package FS::part_pkg;
 
 use strict;
 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
 
 
 =head1 NAME
 


@@ -16,8 +14,8 @@ FS::part_pkg - Object methods for part_pkg objects
 
   use FS::part_pkg;
 
 
   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;
 
 
   $custom_record = $template_record->clone;
 


@@ -57,40 +55,33 @@ just as you would normally.  More advanced semantics are not yet defined.
 
 =over 4 
 
 
 =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
 
 
 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
 
 
 =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;
 
 =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\) /;
   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
 }
 
 =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.
 
 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.
 =item delete
 
 Currently unimplemented.


@@ -115,10 +97,7 @@ Currently unimplemented.
 
 sub delete {
   return "Can't (yet?) delete package definitions.";
 
 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
 }
 
 =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.
 
 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
 =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 {
 =cut
 
 sub check {

-  my($self)=@_;
-  return "Not a part_pkg record!" unless $self->table eq "part_pkg";
+  my $self = shift;

 
   $self->ut_numbern('pkgpart')
 
   $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
 
 }
 
 =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
 
 
 =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
 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 $
 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
 
 
 bugfix in clone method, clone method doc clarification
 
 

diff --git a/site_perl/part_referral.pm b/site_perl/part_referral.pm
index 1b4a1b6..e63e822 100644 (file)
--- a/site_perl/part_referral.pm
+++ b/site_perl/part_referral.pm
@@ -1,12 +1,10 @@
 package FS::part_referral;
 
 use strict;
 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
 
 
 =head1 NAME
 


@@ -16,8 +14,8 @@ FS::part_referral - Object methods for part_referral objects
 
   use FS::part_referral;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -46,38 +44,19 @@ following fields are currently supported:
 
 =over 4
 
 
 =over 4
 

-=item create HASHREF
+=item new HASHREF

 
 Creates a new referral.  To add the referral to the database, see L<"insert">.
 
 =cut
 
 
 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.
 
 
 =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.
 =item delete
 
 Currently unimplemented.


@@ -85,9 +64,9 @@ Currently unimplemented.
 =cut
 
 sub delete {
 =cut
 
 sub delete {

-  my($self)=@_;
+  my $self = shift;

   return "Can't (yet?) delete part_referral records";
   return "Can't (yet?) delete part_referral records";

-  #$self->del;
+  #need to make sure no customers have this referral!

 }
 
 =item replace OLD_RECORD
 }
 
 =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.
 
 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,
 =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 {
 =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
 
 }
 
 =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.
 
 
 The delete method is unimplemented.
 


@@ -149,6 +112,11 @@ ivan@sisd.com 98-feb-23
 
 pod ivan@sisd.com 98-sep-21
 
 
 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;
 =cut
 
 1;

diff --git a/site_perl/part_svc.pm b/site_perl/part_svc.pm
index 0fd8ee4..fa34623 100644 (file)
--- a/site_perl/part_svc.pm
+++ b/site_perl/part_svc.pm
@@ -1,12 +1,10 @@
 package FS::part_svc;
 
 use strict;
 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
 
 
 =head1 NAME
 


@@ -16,8 +14,8 @@ FS::part_svc - Object methods for part_svc objects
 
   use FS::part_svc;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -51,39 +49,20 @@ L<FS::svc_domain>, and L<FS::svc_acct_sm>, among others.
 
 =over 4
 
 
 =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
 
 
 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.
 
 
 =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.
 =item delete
 
 Currently unimplemented.


@@ -92,10 +71,7 @@ Currently unimplemented.
 
 sub delete {
   return "Can't (yet?) delete service definitions.";
 
 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
 }
 
 =item replace OLD_RECORD


@@ -106,14 +82,12 @@ returns the error, otherwise returns false.
 =cut
 
 sub replace {
 =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!"
   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
 }
 
 =item check


@@ -125,30 +99,29 @@ and replace methods.
 =cut
 
 sub check {
 =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')
   ;
     $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;
 
   return "Unknown svcdb!" unless @fields;
 

-  my($svcdb);
+  my $svcdb;

   foreach $svcdb ( qw(
   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');
       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'}='';
       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;
 
         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
 
 
 =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.
 
 
 Delete is unimplemented.
 

+The list of svc_* tables is hardcoded.  When svc_acct_pop is renamed, this
+should be fixed.
+

 =head1 SEE ALSO
 
 L<FS::Record>, L<FS::part_pkg>, L<FS::pkg_svc>, L<FS::cust_svc>,
 =head1 SEE ALSO
 
 L<FS::Record>, L<FS::part_pkg>, L<FS::pkg_svc>, L<FS::cust_svc>,


@@ -193,6 +168,11 @@ ivan@sisd.com 97-dec-6
 
 pod ivan@sisd.com 98-sep-21
 
 
 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;
 =cut
 
 1;

diff --git a/site_perl/pkg_svc.pm b/site_perl/pkg_svc.pm
index 517125c..9db0a12 100644 (file)
--- a/site_perl/pkg_svc.pm
+++ b/site_perl/pkg_svc.pm
@@ -1,12 +1,10 @@
 package FS::pkg_svc;
 
 use strict;
 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
 
 
 =head1 NAME
 


@@ -16,8 +14,8 @@ FS::pkg_svc - Object methods for pkg_svc records
 
   use FS::pkg_svc;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -48,52 +46,24 @@ definition includes
 
 =over 4
 
 
 =over 4
 

-=item create HASHREF
+=item new HASHREF

 
 Create a new record.  To add the record to the database, see L<"insert">.
 
 =cut
 
 
 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.
 
 
 =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.
 
 =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,
 =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 {
 =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
 }
 
 =item check


@@ -122,31 +89,32 @@ methods.
 =cut
 
 sub check {
 =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')
   ;
     $self->ut_number('pkgpart')
     || $self->ut_number('svcpart')
     || $self->ut_number('quantity')
   ;

+  return $error if $error;

 
   return "Unknown pkgpart!"
 
   return "Unknown pkgpart!"

-    unless qsearchs('part_pkg',{'pkgpart'=> $self->getfield('pkgpart')});
+    unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );

 
   return "Unknown svcpart!"
 
   return "Unknown svcpart!"

-    unless qsearchs('part_svc',{'svcpart'=> $self->getfield('svcpart')});
+    unless qsearchs('part_svc', { 'svcpart' => $self->svcpart } );

 
   ''; #no error
 }
 
 =back
 
 
   ''; #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
 
 
 =head1 SEE ALSO
 


@@ -162,6 +130,11 @@ ivan@sisd.com 97-nov-13
 
 pod ivan@sisd.com 98-sep-22
 
 
 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;
 =cut
 
 1;

diff --git a/site_perl/svc_acct.pm b/site_perl/svc_acct.pm
index fdc9f0b..1d30859 100644 (file)
--- a/site_perl/svc_acct.pm
+++ b/site_perl/svc_acct.pm
@@ -1,16 +1,14 @@
 package FS::svc_acct;
 
 use strict;
 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);
             $shellmachine @saltset @pw_set);

-use Exporter;

 use FS::Conf;
 use FS::Conf;

-use FS::Record qw(fields qsearchs);
+use FS::Record qw( qsearchs fields );

 use FS::SSH qw(ssh);
 use FS::cust_svc;
 
 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 { 
 
 #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;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -87,24 +85,13 @@ FS::Record.  The following fields are currently supported:
 
 =over 4
 
 
 =over 4
 

-=item create HASHREF
+=item new HASHREF

 
 Creates a new account.  To add the account to the database, see L<"insert">.
 
 =cut
 
 
 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
 
 
 =item insert
 


@@ -125,8 +112,8 @@ setting $FS::svc_acct::nossh_hack true.
 =cut
 
 sub insert {
 =cut
 
 sub insert {

-  my($self)=@_;
-  my($error);
+  my $self = shift;
+  my $error;

 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';


@@ -134,41 +121,40 @@ sub insert {
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
 
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
 

-  $error=$self->check;
+  $error = $self->check;

   return $error if $error;
 
   return "Username ". $self->username. " in use"
   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'
   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$/
     ;
 
       && $self->username !~ /^(hyla)?fax$/
     ;
 

-  my($svcnum)=$self->svcnum;
-  my($cust_svc);
+  my $svcnum = $self->svcnum;
+  my $cust_svc;

   unless ( $svcnum ) {
   unless ( $svcnum ) {

-    $cust_svc=create FS::cust_svc ( {
+    $cust_svc = new FS::cust_svc ( {

       'svcnum'  => $svcnum,
       'pkgnum'  => $self->pkgnum,
       'svcpart' => $self->svcpart,
     } );
       '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);
   }
 
     return $error if $error;
     $svcnum = $self->svcnum($cust_svc->svcnum);
   }
 

-  $error = $self->add;
+  $error = $self->SUPER::insert;

   if ($error) {
   if ($error) {

-    #$cust_svc->del if $cust_svc;

     $cust_svc->delete if $cust_svc;
     return $error;
   }
 
     $cust_svc->delete if $cust_svc;
     return $error;
   }
 

-  my($username,$uid,$dir,$shell) = (
+  my ( $username, $uid, $dir, $shell ) = (

     $self->username,
     $self->uid,
     $self->dir,
     $self->username,
     $self->uid,
     $self->dir,


@@ -210,8 +196,8 @@ setting $FS::svc_acct::nossh_hack true.
 =cut
 
 sub delete {
 =cut
 
 sub delete {

-  my($self)=@_;
-  my($error);
+  my $self = shift;
+  my $error;

 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';


@@ -219,16 +205,16 @@ sub delete {
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
 
   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;
 
   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;
 
   return $error if $error;
 

-  my($username) = $self->getfield('username');
+  my $username = $self->username;

   if ( $username && $shellmachine && ! $nossh_hack ) {
     ssh("root\@$shellmachine","userdel $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 {
 =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"
 
   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
 
   #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';
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';


@@ -289,11 +265,11 @@ sub replace {
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
 
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
 

-  $error = $new->rep($old);
+  $error = $new->SUPER::replace($old);

   return $error if $error;
 
   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
   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<FS::cust_pkg>).
 =cut
 
 sub suspend {
 =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};
   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)
   }
   } else {
     ''; #no error (already suspended)
   }

-

 }
 
 =item unsuspend
 }
 
 =item unsuspend


@@ -345,13 +319,12 @@ Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 =cut
 
 sub unsuspend {
 =cut
 
 sub unsuspend {

-  my($old) = @_;
-  my(%hash) = $old->hash;
+  my $self = shift;
+  my %hash = $self->hash;

   if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
     $hash{_password} = $1;
   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)
   }
   } else {
     ''; #no error (already unsuspended)
   }


@@ -365,7 +338,6 @@ Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 
 =cut
 
 
 =cut
 

-# Usage: $error = $record -> cancel;

 sub cancel {
   ''; #stub (no error) - taken care of in delete
 }
 sub cancel {
   ''; #stub (no error) - taken care of in delete
 }


@@ -381,8 +353,8 @@ Sets any fixed values; see L<FS::part_svc>.
 =cut
 
 sub check {
 =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";
   my($recref) = $self->hashref;
 
   $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum";


@@ -514,15 +486,21 @@ sub check {
 
 =back
 
 
 =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 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).
 
 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<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
 =head1 SEE ALSO
 
 L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,


@@ -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 $
 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.)
 
 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 a6f801f..fe2b5f3 100644 (file)
--- 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;
 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
 
 
 =head1 NAME
 


@@ -16,8 +14,8 @@ FS::svc_acct_pop - Object methods for svc_acct_pop records
 
   use FS::svc_acct_pop;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -50,68 +48,29 @@ inherits from FS::Record.  The following fields are currently supported:
 
 =over 4
 
 
 =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
 
 
 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
 
 
 =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.
 
 error, otherwise returns false.
 

-=cut
-
-sub insert {
-  my($self)=@_;
-
-  $self->check or
-  $self->add;
-}
-

 =item delete
 
 =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.
 
 
 =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
 =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 {
 =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')
   ;
     $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
 
 
 }
 
 =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.
 
 
 It should be renamed to part_pop.
 


@@ -157,6 +113,11 @@ ivan@sisd.com 98-mar-8
 
 pod ivan@sisd.com 98-sep-23
 
 
 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;
 =cut
 
 1;

diff --git a/site_perl/svc_acct_sm.pm b/site_perl/svc_acct_sm.pm
index 4293e03..f1c0492 100644 (file)
--- 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;
 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;
 
 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 { 
 
 #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;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -65,25 +63,14 @@ from FS::Record.  The following fields are currently supported:
 
 =over 4
 
 
 =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
 
 
 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
 
 
 =item insert
 


@@ -320,9 +307,11 @@ sub check {
 
 =back
 
 
 =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.
 
 
 The remote commands should be configurable.
 

diff --git a/site_perl/svc_domain.pm b/site_perl/svc_domain.pm
index 69b225e..c7e1e70 100644 (file)
--- a/site_perl/svc_domain.pm
+++ b/site_perl/svc_domain.pm
@@ -1,10 +1,9 @@
 package FS::svc_domain;
 
 use strict;
 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
 );
   $tech_contact $from $to @nameservers @nameserver_ips @template
 );

-use Exporter;

 use Carp;
 use Mail::Internet;
 use Mail::Header;
 use Carp;
 use Mail::Internet;
 use Mail::Header;


@@ -14,7 +13,6 @@ use FS::cust_svc;
 use FS::Conf;
 
 @ISA = qw(FS::Record Exporter);
 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 { 
 
 #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;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -84,24 +82,13 @@ FS::Record.  The following fields are currently supported:
 
 =over 4
 
 
 =over 4
 

-=item create HASHREF
+=item new HASHREF

 
 Creates a new domain.  To add the domain to the database, see L<"insert">.
 
 =cut
 
 
 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
 
 
 =item insert
 


@@ -125,8 +112,8 @@ in the same package, it is automatically used.  Otherwise an error is returned.
 =cut
 
 sub insert {
 =cut
 
 sub insert {

-  my($self)=@_;
-  my($error);
+  my $self = shift;
+  my $error;

 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';


@@ -134,34 +121,34 @@ sub insert {
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
 
   local $SIG{TERM} = 'IGNORE';
   local $SIG{TSTP} = 'IGNORE';
 

-  $error=$self->check;
+  $error = $self->check;

   return $error if $error;
 
   return "Domain in use (here)"
   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/ );
 
   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 ) {
   unless ( $svcnum ) {

-    $cust_svc=create FS::cust_svc ( {
+    $cust_svc = new FS::cust_svc ( {

       'svcnum'  => $svcnum,
       '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;
     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;
   }
 
     return $error;
   }
 


@@ -180,16 +167,16 @@ The corresponding FS::cust_svc record will be deleted as well.
 =cut
 
 sub delete {
 =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;
 
   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;
 
   '';
   return $error if $error;
 
   '';


@@ -203,29 +190,13 @@ returns the error, otherwise returns false.
 =cut
 
 sub replace {
 =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'); 
 
 
   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<FS::part_svc>.
 =cut
 
 sub check {
 =cut
 
 sub check {

-  my($self)=@_;
-  return "Not a svc_domain record!" unless $self->table eq "svc_domain";
+  my $self = shift;
+

   my($recref) = $self->hashref;
 
   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);
 
   #get part_svc (and pkgnum)
   my($svcpart,$pkgnum);


@@ -356,10 +331,10 @@ $FS::svc_domain::whois_hack is set true.)
 =cut
 
 sub _whois {
 =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;
   return ( "No match for domain \"$domain\"." ) if $whois_hack;

-  open(WHOIS,"whois do $domain |");
+  open(WHOIS, "whois do $domain |");

   return <WHOIS>;
 }
 
   return <WHOIS>;
 }
 


@@ -370,14 +345,14 @@ Submits a registration email for this domain.
 =cut
 
 sub submit_internic {
 =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;
   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;
 
   return unless $cust_main;
 

-  my(%subs)=(
+  my %subs = (

     'action'       => $self->action,
     'purpose'      => $self->purpose,
     'domain'       => $self->domain,
     'action'       => $self->action,
     'purpose'      => $self->purpose,
     'domain'       => $self->domain,


@@ -400,18 +375,18 @@ sub submit_internic {
   );
 
   #yuck
   );
 
   #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);
 
     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;
       }
         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 ]
         '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) {
         '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}};
           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
 
 
   } #OLOOP
 

-  my($subject);
+  my $subject;

   if ( $self->action eq "M" ) {
     $subject = "MODIFY DOMAIN ". $self->domain;
   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;
   }
 
     $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",
     "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",
   ] );
 
     "Subject: $subject",
   ] );
 


@@ -476,15 +451,17 @@ sub submit_internic {
 
 =back
 
 
 =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 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.
 
 
 Should change action to a real field.
 


@@ -494,10 +471,6 @@ L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
 L<FS::SSH>, L<ssh>, L<dot-qmail>, schema.html from the base documentation,
 config.html from the base documentation.
 
 L<FS::SSH>, L<ssh>, L<dot-qmail>, 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
 =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 $
 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.)
 
 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 d4536e5..4180d8d 100644 (file)
--- 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 strict;
 use vars qw(@ISA);

-use Exporter;

 use FS::Record qw(fields qsearch qsearchs);
 use FS::cust_svc;
 
 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;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -48,7 +47,7 @@ FS::Record.  The following fields are currently supported:
 
 =over 4
 
 
 =over 4
 

-=item create HASHREF
+=item new HASHREF

 
 Creates a new example.  To add the example to the database, see L<"insert">.
 
 
 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<hash> method.
 
 =cut
 
 
 =cut
 

-sub create {
-  my($proto,$hashref)=@_;
-
-  $proto->new('svc_table',$hashref);
-
-}
+sub table { 'table_name'; }

 
 =item insert
 
 
 =item insert
 


@@ -226,7 +220,7 @@ sub check {
 
 =head1 VERSION
 
 
 =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
 
 
 =head1 BUGS
 


@@ -242,7 +236,10 @@ froom the base documentation.
 ivan@voicenet.com 97-jul-21
 
 $Log: table_template-svc.pm,v $
 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
 
 
 updates for newest versoin
 
 

diff --git a/site_perl/table_template.pm b/site_perl/table_template.pm
index 8945a39..0173bc5 100644 (file)
--- a/site_perl/table_template.pm
+++ b/site_perl/table_template.pm
@@ -1,10 +1,8 @@
 package FS::table_name;
 
 use strict;
 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);
 
 
 @ISA = qw(FS::Record);
 


@@ -16,8 +14,8 @@ FS::table_name - Object methods for table_name records
 
   use FS::table_name;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -42,7 +40,7 @@ FS::Record.  The following fields are currently supported:
 
 =over 4
 
 
 =over 4
 

-=item create HASHREF
+=item new HASHREF

 
 Creates a new example.  To add the example to the database, see L<"insert">.
 
 
 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<hash> method.
 
 =cut
 
 
 =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
 
 
 =item insert
 


@@ -65,18 +60,7 @@ otherwise returns false.
 
 =cut
 
 
 =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
 
 
 =item delete
 


@@ -84,11 +68,7 @@ Delete this record from the database.
 
 =cut
 
 
 =cut
 

-sub delete {
-  my($self)=@_;
-
-  $self->del;
-}
+# the delete method can be inherited from FS::Record

 
 =item replace OLD_RECORD
 
 
 =item replace OLD_RECORD
 


@@ -97,30 +77,21 @@ returns the error, otherwise returns false.
 
 =cut
 
 
 =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
 
 =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
 
 
 =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
 }
 
   ''; #no error
 }


@@ -129,7 +100,7 @@ sub check {
 
 =head1 VERSION
 
 
 =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
 
 
 =head1 BUGS
 


@@ -137,7 +108,7 @@ The author forgot to customize this manpage.
 
 =head1 SEE ALSO
 
 
 =head1 SEE ALSO
 

-L<FS::Record>
+L<FS::Record>, schema.html from the base documentation.

 
 =head1 HISTORY
 
 
 =head1 HISTORY
 


@@ -147,7 +118,10 @@ added hfields
 ivan@sisd.com 97-nov-13
 
 $Log: table_template.pm,v $
 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
 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 a715796..e19345e 100644 (file)
--- a/site_perl/type_pkgs.pm
+++ b/site_perl/type_pkgs.pm
@@ -1,12 +1,12 @@
 package FS::type_pkgs;
 
 use strict;
 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
 
 
 =head1 NAME
 


@@ -16,8 +16,8 @@ FS::type_pkgs - Object methods for type_pkgs records
 
   use FS::type_pkgs;
 
 
   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;
 
 
   $error = $record->insert;
 


@@ -45,67 +45,29 @@ FS::Record.  The following fields are currently supported:
 
 =over 4
 
 
 =over 4
 

-=item create HASHREF
+=item new HASHREF

 
 Create a new record.  To add the record to the database, see L<"insert">.
 
 =cut
 
 
 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.
 
 
 =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.
 
 =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.
 
 =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,
 =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 {
 =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"
   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"
   return "Unknown pkgpart"

-    unless qsearchs('part_pkg',{'pkgpart'=>$recref->{pkgpart}});
+    unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );

 
   ''; #no error
 }
 
 =back
 
 
   ''; #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<FS::Record>, L<FS::agent_type>, L<FS::part_pkgs>, schema.html from the base
+documentation.
+

 =head1 HISTORY
 
 Defines the relation between agent types and pkgparts
 =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
 
 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;
 =cut
 
 1;