-$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
-- 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
=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', ... };
$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');
$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
implemented on top of DBI. FS::Record is intended as a base class for
table-specific classes to inherit from, i.e. FS::cust_main.
-=head1 METHODS
+=head1 CONSTRUCTORS
=over 4
-=item new TABLE, HASHREF
+=item new [ TABLE, ] HASHREF
Creates a new record. It doesn't store it in the database, though. See
-L<"add"> for that.
+L<"insert"> for that.
Note that the object stores this hash reference, not a distinct copy of the
hash it points to. You can ask the object for a copy with the I<hash>
method.
+TABLE can only be omitted when a dervived class overrides the table method.
+
=cut
sub new {
- my($proto,$table,$hashref) = @_;
- confess "Second arguement to FS::Record->new is not a HASH ref: ",
- ref($hashref), " ", $hashref, "\n"
- unless ref($hashref) eq 'HASH'; #bad practice?
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+ bless ($self, $class);
- #check to make sure $table exists? (ask dbdef)
+ $self->{'Table'} = shift unless defined ( $self->table );
- foreach my $field ( FS::Record::fields $table ) {
- $hashref->{$field}='' unless defined $hashref->{$field};
- }
+ my $hashref = $self->{'Hash'} = shift;
- # mySQL must rtrim the inbound text strings or store them z-terminated
- # I simulate this for Postgres below
- # Turned off in favor of ChopBlanks in UID.pm (see man DBI)
- #if (datasrc =~ m/Pg/)
- #{
- # foreach my $index (keys %$hashref)
- # {
- # $$hashref{$index} = unpack("A255", $$hashref{$index})
- # if ($$hashref{$index} =~ m/ $/) ;
- # }
- #}
-
- foreach my $column ( FS::Record::fields $table ) {
- #trim the '$' from money fields for Pg (beong HERE?)
+ foreach my $field ( $self->fields ) {
+ $hashref->{$field}='' unless defined $hashref->{$field};
+ #trim the '$' from money fields for Pg (belong HERE?)
#(what about Pg i18n?)
if ( datasrc =~ m/Pg/
- && $dbdef->table($table)->column($column)->type eq 'money' ) {
- ${$hashref}{$column} =~ s/^\$//;
+ && $self->dbdef_table->column($field)->type eq 'money' ) {
+ ${$hashref}{$field} =~ s/^\$//;
}
- #foreach my $column ( grep $dbdef->table($table)->column($_)->type eq 'money', keys %{$hashref} ) {
- # ${$hashref}{$column} =~ s/^\$//;
- #}
}
- my $class = ref($proto) || $proto;
- my $self = { 'Table' => $table,
- 'Hash' => $hashref,
- };
+ $self;
+}
+sub create {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
bless ($self, $class);
-
+ if ( defined $self->table ) {
+ cluck "create constructor is depriciated, use new!";
+ $self->new(@_);
+ } else {
+ croak "FS::Record::create called (not from a subclass)!";
+ }
}
=item qsearch TABLE, HASHREF
=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;
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";
sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash);
my(@result) = qsearch(@_);
- carp "Multiple records in scalar search!" if scalar(@result) > 1;
+ carp "warning: Multiple records in scalar search!" if scalar(@result) > 1;
#should warn more vehemently if the search was on a primary key?
$result[0];
}
+=back
+
+=head1 METHODS
+
+=over 4
+
=item table
Returns the table name.
=cut
sub table {
- my($self) = @_;
+# cluck "warning: FS::Record::table depriciated; supply one in subclass!";
+ my $self = shift;
$self -> {'Table'};
}
}
}
sub getfield {
- get(@_);
+ my $self = shift;
+ $self->get(@_);
}
=item set, setfield COLUMN, VALUE
$self->{'Hash'}->{$field} = $value;
}
sub setfield {
- set(@_);
+ my $self = shift;
+ $self->set(@_);
}
=item AUTLOADED METHODS
$self->{'Hash'};
}
-=item add
+=item insert
-Adds this record to the database. If there is an error, returns the error,
+Inserts this record to the database. If there is an error, returns the error,
otherwise returns false.
=cut
-sub add {
- my($self) = @_;
- my($dbh)=dbh;
- my($table)=$self->table;
+sub insert {
+ my $self = shift;
+
+ my $error = $self->check;
+ return $error if $error;
#single-field unique keys are given a value if false
#(like MySQL's AUTO_INCREMENT)
- foreach ( $dbdef->table($table)->unique->singles ) {
+ foreach ( $self->dbdef_table->unique->singles ) {
$self->unique($_) unless $self->getfield($_);
}
#and also the primary key
- my($primary_key)=$dbdef->table($table)->primary_key;
+ my $primary_key = $self->dbdef_table->primary_key;
$self->unique($primary_key)
if $primary_key && ! $self->getfield($primary_key);
- my (@fields) =
+ my @fields =
grep defined($self->getfield($_)) && $self->getfield($_) ne "",
- fields($table)
+ $self->fields
;
- my($sth);
- my($statement)="INSERT INTO $table ( ".
+ my $statement = "INSERT INTO ". $self->table. " ( ".
join(', ',@fields ).
") VALUES (".
- join(', ',map(_quote($self->getfield($_),$table,$_), @fields)).
+ join(', ',map(_quote($self->getfield($_),$self->table,$_), @fields)).
")"
;
- $sth = $dbh->prepare($statement) or return $dbh->errstr;
+ my $sth = dbh->prepare($statement) or return dbh->errstr;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
'';
}
-=item del
+=item add
+
+Depriciated (use insert instead).
+
+=cut
+
+sub add {
+ cluck "warning: FS::Record::add depriciated!";
+ insert @_; #call method in this scope
+}
+
+=item delete
Delete this record from the database. If there is an error, returns the error,
otherwise returns false.
=cut
-sub del {
- my($self) = @_;
- my($dbh)=dbh;
- my($table)=$self->table;
+sub delete {
+ my $self = shift;
- my($sth);
- my($statement)="DELETE FROM $table WHERE ". join(' AND ',
+ my($statement)="DELETE FROM ". $self->table. " WHERE ". join(' AND ',
map {
$self->getfield($_) eq ''
? "$_ IS NULL"
- : "$_ = ". _quote($self->getfield($_),$table,$_)
- } ( $dbdef->table($table)->primary_key )
- ? ($dbdef->table($table)->primary_key)
- : fields($table)
+ : "$_ = ". _quote($self->getfield($_),$self->table,$_)
+ } ( $self->dbdef_table->primary_key )
+ ? ( $self->dbdef_table->primary_key)
+ : $self->fields
);
- $sth = $dbh->prepare($statement) or return $dbh->errstr;
+ my $sth = dbh->prepare($statement) or return dbh->errstr;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
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!
'';
}
-=item rep OLD_RECORD
+=item del
+
+Depriciated (use delete instead).
+
+=cut
+
+sub del {
+ cluck "warning: FS::Record::del depriciated!";
+ &delete(@_); #call method in this scope
+}
+
+=item replace OLD_RECORD
Replace the OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
=cut
-sub rep {
- my($new,$old)=@_;
- my($dbh)=dbh;
- my($table)=$old->table;
- my(@fields)=fields($table);
- my(@diff)=grep $new->getfield($_) ne $old->getfield($_), @fields;
+sub replace {
+ my ( $new, $old ) = ( shift, shift );
- if ( scalar(@diff) == 0 ) {
+ my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields;
+ unless ( @diff ) {
carp "warning: records identical";
return '';
}
- return "Records not in same table!" unless $new->table eq $table;
+ return "Records not in same table!" unless $new->table eq $old->table;
- my($sth);
- my($statement)="UPDATE $table SET ". join(', ',
+ my $primary_key = $old->dbdef_table->primary_key;
+ return "Can't change $primary_key"
+ if $primary_key
+ && ( $old->getfield($primary_key) ne $new->getfield($primary_key) );
+
+ my $error = $new->check;
+ return $error if $error;
+
+ my $statement = "UPDATE ". $old->table. " SET ". join(', ',
map {
- "$_ = ". _quote($new->getfield($_),$table,$_)
+ "$_ = ". _quote($new->getfield($_),$old->table,$_)
} @diff
). ' WHERE '.
join(' AND ',
map {
$old->getfield($_) eq ''
? "$_ IS NULL"
- : "$_ = ". _quote($old->getfield($_),$table,$_)
-# } @fields
-# } ( primary_key($table) ? (primary_key($table)) : @fields )
- } ( $dbdef->table($table)->primary_key
- ? ($dbdef->table($table)->primary_key)
- : @fields
- )
+ : "$_ = ". _quote($old->getfield($_),$old->table,$_)
+ } ( $primary_key ? ( $primary_key ) : $old->fields )
)
;
- #warn $statement;
- $sth = $dbh->prepare($statement) or return $dbh->errstr;
+ my $sth = dbh->prepare($statement) or return dbh->errstr;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{TERM} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
- my($rc);
- $rc=$sth->execute or return $sth->errstr;
+ my $rc = $sth->execute or return $sth->errstr;
#not portable #return "Record not found (or records identical)." if $rc eq "0E0";
'';
}
+=item rep
+
+Depriciated (use replace instead).
+
+=cut
+
+sub rep {
+ cluck "warning: FS::Record::rep depriciated!";
+ replace @_; #call method in this scope
+}
+
+=item check
+
+Not yet implemented, croaks. Derived classes should provide a check method.
+
+=cut
+
+sub check {
+ croak "FS::Record::check not implemented; supply one in subclass!";
+}
+
=item unique COLUMN
Replaces COLUMN in record with a unique number. Called by the B<add> method
'';
}
+=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
=cut
sub hfields {
- carp "hfields is depriciated";
+ carp "warning: hfields is depriciated";
my($table)=@_;
my(%hash);
foreach (fields($table)) {
\%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 {
=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
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>
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
package FS::agent;
use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
-use FS::Record qw(fields qsearch qsearchs);
+use vars qw( @ISA );
+use FS::Record qw( qsearch qsearchs);
use FS::cust_main;
use FS::agent_type;
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
+@ISA = qw( FS::Record );
=head1 NAME
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;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new agent. To add the agent to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('agent')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('agent',$hashref);
-}
+sub table { 'agent'; }
=item insert
Adds this agent to the database. If there is an error, returns the error,
otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
Deletes this agent from the database. Only agents with no customers can be
=cut
sub delete {
- my($self)=@_;
+ my $self = shift;
+
return "Can't delete an agent with customers!"
- if qsearch('cust_main',{'agentnum' => $self->agentnum});
- $self->del;
+ if qsearch( 'cust_main', { 'agentnum' => $self->agentnum } );
+
+ $self->SUPER::delete;
}
=item replace OLD_RECORD
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,
=cut
sub check {
- my($self)=@_;
- return "Not a agent record!" unless $self->table eq "agent";
+ my $self = shift;
- my($error)=
+ my $error =
$self->ut_numbern('agentnum')
- or $self->ut_text('agent')
- or $self->ut_number('typenum')
- or $self->ut_numbern('freq')
- or $self->ut_textn('prog')
+ || $self->ut_text('agent')
+ || $self->ut_number('typenum')
+ || $self->ut_numbern('freq')
+ || $self->ut_textn('prog')
;
return $error if $error;
return "Unknown typenum!"
- unless qsearchs('agent_type',{'typenum'=> $self->getfield('typenum') });
+ unless qsearchs( 'agent_type', { 'typenum' => $self->typenum } );
'';
=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
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
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;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new agent type. To add the agent type to the database, see
L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('agent_type')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('agent_type',$hashref);
-
-}
+sub table { 'agent_type'; }
=item insert
Adds this agent type to the database. If there is an error, returns the error,
otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
Deletes this agent type from the database. Only agent types with no agents
=cut
sub delete {
- my($self)=@_;
+ my $self = shift;
+
return "Can't delete an agent_type with agents!"
- if qsearch('agent',{'typenum' => $self->typenum});
- $self->del;
+ if qsearch( 'agent', { 'typenum' => $self->typenum } );
+
+ $self->SUPER::delete;
}
=item replace OLD_RECORD
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
=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');
=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
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;
package FS::cust_bill;
use strict;
-use vars qw(@ISA $conf $add1 $add2 $add3 $add4);
-use Exporter;
+use vars qw( @ISA $conf $add1 $add2 $add3 $add4 );
use Date::Format;
-use FS::Record qw(fields qsearch qsearchs);
+use FS::Record qw( qsearch qsearchs );
+use FS::cust_main;
+use FS::cust_bill_pkg;
+use FS::cust_credit;
+use FS::cust_pay;
+use FS::cust_pkg;
-@ISA = qw(FS::Record Exporter);
+@ISA = qw( FS::Record );
#ask FS::UID to run this stuff for us later
$FS::UID::callback{'FS::cust_bill'} = sub {
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;
=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
=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
=cut
sub insert {
- my($self)=@_;
+ my $self = shift;
- $self->setfield('owed',$self->charged) if $self->owed eq '';
+ $self->owed( $self->charged ) if $self->owed eq '';
return "owed != charged!"
unless $self->owed == $self->charged;
- $self->check or
- $self->add;
+ $self->SUPER::insert;
}
=item delete
sub delete {
return "Can't remove invoice!"
- #my($self)=@_;
- #$self->del;
}
=item replace OLD_RECORD
=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
=cut
sub check {
- my($self)=@_;
- return "Not a cust_bill record!" unless $self->table eq "cust_bill";
- my($recref) = $self->hashref;
-
- $recref->{invnum} =~ /^(\d*)$/ or return "Illegal invnum";
- $recref->{invnum} = $1;
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('invnum')
+ || $self->ut_number('custnum')
+ || $self->ut_numbern('_date')
+ || $self->ut_money('charged')
+ || $self->ut_money('owed')
+ || $self->ut_numbern('printed')
+ ;
+ return $error if $error;
- $recref->{custnum} =~ /^(\d+)$/ or return "Illegal custnum";
- $recref->{custnum} = $1;
return "Unknown customer"
- unless qsearchs('cust_main',{'custnum'=>$recref->{custnum}});
+ unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
- $recref->{_date} =~ /^(\d*)$/ or return "Illegal date";
- $recref->{_date} = $recref->{_date} ? $1 : time;
+ $self->_date(time) unless $self->_date;
- #$recref->{charged} =~ /^(\d+(\.\d\d)?)$/ or return "Illegal charged";
- $recref->{charged} =~ /^(\-?\d+(\.\d\d)?)$/ or return "Illegal charged";
- $recref->{charged} = $1;
-
- $recref->{owed} =~ /^(\-?\d+(\.\d\d)?)$/ or return "Illegal owed";
- $recref->{owed} = $1;
-
- $recref->{printed} =~ /^(\d*)$/ or return "Illegal printed";
- $recref->{printed} = $1 || '0';
+ $self->printed(0) if $self->printed eq '';
''; #no error
}
=cut
sub previous {
- my($self)=@_;
- my($total)=0;
- my(@cust_bill) = sort { $a->_date <=> $b->_date }
+ my $self = shift;
+ my $total = 0;
+ my @cust_bill = sort { $a->_date <=> $b->_date }
grep { $_->owed != 0 && $_->_date < $self->_date }
- qsearch('cust_bill',{ 'custnum' => $self->custnum } )
+ qsearch( 'cust_bill', { 'custnum' => $self->custnum } )
;
- foreach (@cust_bill) { $total += $_->owed; }
+ foreach ( @cust_bill ) { $total += $_->owed; }
$total, @cust_bill;
}
=cut
sub cust_bill_pkg {
- my($self)=@_;
+ my $self = shift;
qsearch( 'cust_bill_pkg', { 'invnum' => $self->invnum } );
}
=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 } )
;
=cut
sub cust_pay {
- my($self)=@_;
+ my $self = shift;
sort { $a->_date <=> $b->date }
qsearch( 'cust_pay', { 'invnum' => $self->invnum } )
;
sub print_text {
- my($self,$today)=@_;
+ my( $self, $today ) = ( shift, shift );
$today ||= time;
- my($invnum)=$self->invnum;
- my($cust_main) = qsearchs('cust_main',
- { 'custnum', $self->custnum } );
- $cust_main->setfield('payname',
- $cust_main->first. ' '. $cust_main->getfield('last')
- ) unless $cust_main->payname;
+ my $invnum = $self->invnum;
+ my $cust_main = qsearchs('cust_main', { 'custnum', $self->custnum } );
+ $cust_main->payname( $cust_main->first. ' '. $cust_main->getfield('last') )
+ unless $cust_main->payname;
- my($pr_total,@pr_cust_bill) = $self->previous; #previous balance
- my($cr_total,@cr_cust_credit) = $self->cust_credit; #credits
- my($balance_due) = $self->owed + $pr_total - $cr_total;
+ my( $pr_total, @pr_cust_bill ) = $self->previous; #previous balance
+ my( $cr_total, @cr_cust_credit ) = $self->cust_credit; #credits
+ my $balance_due = $self->owed + $pr_total - $cr_total;
#overdue?
- my($overdue) = (
+ my $overdue = (
$balance_due > 0
&& $today > $self->_date
&& $self->printed > 1
);
- #printing bits here
+ #printing bits here (yuck!)
local($SIG{CHLD}) = sub { wait() };
$|=1;
=back
+=head1 VERSION
+
+$Id: cust_bill.pm,v 1.4 1998-12-29 11:59:36 ivan Exp $
+
=head1 BUGS
The delete method.
-It doesn't properly override FS::Record yet.
-
print_text formatting (and some logic :/) is in source as a format declaration,
which needs to be slurped in from a file. the fork is rather kludgy as well.
It could be cleaned with swrite from man perlform, and the picture could be
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.)
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
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;
=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
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_bill_pkg')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_bill_pkg',$hashref);
-
-}
+sub table { 'cust_bill_pkg'; }
=item insert
Adds this line item to the database. If there is an error, returns the error,
otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
Currently unimplemented. I don't remove line items because there would then be
sub delete {
return "Can't delete cust_bill_pkg records!";
- #my($self)=@_;
- #$self->del;
}
=item replace OLD_RECORD
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
=cut
sub check {
- my($self)=@_;
- return "Not a cust_bill_pkg record!" unless $self->table eq "cust_bill_pkg";
+ my $self = shift;
- my($error)=
+ my $error =
$self->ut_number('pkgnum')
- or $self->ut_number('invnum')
- or $self->ut_money('setup')
- or $self->ut_money('recur')
- or $self->ut_numbern('sdate')
- or $self->ut_numbern('edate')
+ || $self->ut_number('invnum')
+ || $self->ut_money('setup')
+ || $self->ut_money('recur')
+ || $self->ut_numbern('sdate')
+ || $self->ut_numbern('edate')
;
return $error if $error;
if ( $self->pkgnum != 0 ) { #allow unchecked pkgnum 0 for tax! (add to part_pkg?)
- return "Unknown pkgnum ".$self->pkgnum
- unless qsearchs('cust_pkg',{'pkgnum'=> $self->pkgnum });
+ return "Unknown pkgnum ". $self->pkgnum
+ unless qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
}
return "Unknown invnum"
- unless qsearchs('cust_bill',{'invnum'=> $self->invnum });
+ unless qsearchs( 'cust_bill' ,{ 'invnum' => $self->invnum } );
''; #no error
}
=back
-=head1 BUGS
+=head1 VERSION
+
+$Id: cust_bill_pkg.pm,v 1.2 1998-12-29 11:59:37 ivan Exp $
-It doesn't properly override FS::Record yet.
+=head1 BUGS
=head1 SEE ALSO
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
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;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new credit. To add the credit to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_credit')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_credit',$hashref);
-}
+sub table { 'cust_credit'; }
=item insert
=cut
sub insert {
- my($self)=@_;
+ my $self = shift;
- $self->setfield('credited',$self->amount) if $self->credited eq '';
+ $self->credited($self->amount) if $self->credited eq '';
return "credited != amount!"
unless $self->credited == $self->amount;
- $self->check or
- $self->add;
+ $self->SUPER::insert;
}
=item delete
sub delete {
return "Can't remove credit!"
- #my($self)=@_;
- #$self->del;
}
=item replace OLD_RECORD
=cut
sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_credit record!" unless $old->table eq "cust_credit";
- return "Can't change crednum!"
- unless $old->getfield('crednum') eq $new->getfield('crednum');
- return "Can't change custnum!"
- unless $old->getfield('custnum') eq $new->getfield('custnum');
- return "Can't change date!"
- unless $old->getfield('_date') eq $new->getfield('_date');
- return "Can't change amount!"
- unless $old->getfield('amount') eq $new->getfield('amount');
+ my ( $new, $old ) = ( shift, shift );
+
+ return "Can't change custnum!" unless $old->custnum eq $new->custnum;
+ return "Can't change date!" unless $old->_date eq $new->_date;
+ return "Can't change amount!" unless $old->amount eq $new->amount;
return "(New) credited can't be > (new) amount!"
- if $new->getfield('credited') > $new->getfield('amount');
+ if $new->credited > $new->amount;
- $new->check or
- $new->rep($old);
+ $new->SUPER::replace($old);
}
=item check
=cut
sub check {
- my($self)=@_;
- return "Not a cust_credit record!" unless $self->table eq "cust_credit";
- my($recref) = $self->hashref;
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('crednum')
+ || $self->ut_number('custnum')
+ || $self->ut_numbern('_date')
+ || $self->ut_money('amount')
+ || $self->ut_money('credited')
+ || $self->ut_textn('reason');
+ ;
+ return $error if $error;
- $recref->{crednum} =~ /^(\d*)$/ or return "Illegal crednum";
- $recref->{crednum} = $1;
-
- $recref->{custnum} =~ /^(\d+)$/ or return "Illegal custnum";
- $recref->{custnum} = $1;
return "Unknown customer"
- unless qsearchs('cust_main',{'custnum'=>$recref->{custnum}});
-
- $recref->{_date} =~ /^(\d*)$/ or return "Illegal date";
- $recref->{_date} = $recref->{_date} ? $1 : time;
-
- $recref->{amount} =~ /^(\d+(\.\d\d)?)$/ or return "Illegal amount";
- $recref->{amount} = $1;
+ unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
- $recref->{credited} =~ /^(\-?\d+(\.\d\d)?)$/ or return "Illegal credited";
- $recref->{credited} = $1;
+ $self->_date(time) unless $self->_date;
- #$recref->{otaker} =~ /^(\w+)$/ or return "Illegal otaker";
- #$recref->{otaker} = $1;
$self->otaker(getotaker);
- $self->ut_textn('reason');
-
+ ''; #no error
}
=back
+=head1 VERSION
+
+$Id: cust_credit.pm,v 1.2 1998-12-29 11:59:38 ivan Exp $
+
=head1 BUGS
The delete method.
-It doesn't properly override FS::Record yet.
-
=head1 SEE ALSO
L<FS::Record>, L<FS::cust_refund>, L<FS::cust_bill>, schema.html from the base
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;
package FS::cust_main;
use strict;
-use vars qw(@ISA @EXPORT_OK $conf $lpr $processor $xaction $E_NoErr);
+use vars qw(@ISA $conf $lpr $processor $xaction $E_NoErr);
use Safe;
-use Exporter;
use Carp;
use Time::Local;
use Date::Format;
use Date::Manip;
use Business::CreditCard;
-use FS::UID qw(getotaker);
-use FS::Record qw(fields hfields qsearchs qsearch);
+use FS::UID qw( getotaker );
+use FS::Record qw( qsearchs qsearch );
use FS::cust_pkg;
use FS::cust_bill;
use FS::cust_bill_pkg;
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 {
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;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new customer. To add the customer to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my $field;
- #foreach $field (fields('cust_main')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_main',$hashref);
-}
+sub table { 'cust_main'; }
=item insert
Adds this customer to the database. If there is an error, returns the error,
otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- #no callbacks in check, only data checks
- #local $SIG{HUP} = 'IGNORE';
- #local $SIG{INT} = 'IGNORE';
- #local $SIG{QUIT} = 'IGNORE';
- #local $SIG{TERM} = 'IGNORE';
- #local $SIG{TSTP} = 'IGNORE';
-
- $self->check or
- $self->add;
-}
-
=item delete
Currently unimplemented. Maybe cancel all of this customer's
=cut
-# Usage: $error = $record -> delete;
sub delete {
return "Can't (yet?) delete customers.";
-# my($self)=@_;
-#
-# $self->del;
}
=item replace OLD_RECORD
Replaces the OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_main 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
=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')
return $error if $error;
return "Unknown agent"
- unless qsearchs('agent',{'agentnum'=>$self->agentnum});
+ unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
return "Unknown referral"
- unless qsearchs('part_referral',{'refnum'=>$self->refnum});
+ unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
$self->getfield('last') =~ /^([\w \,\.\-\']+)$/ or return "Illegal last name";
$self->setfield('last',$1);
$payinfo = $1;
$self->payinfo($payinfo);
validate($payinfo) or return "Illegal credit card number";
- my $type = cardtype($payinfo);
- return "Unknown credit card type"
- unless ( $type =~ /^VISA/ ||
- $type =~ /^MasterCard/ ||
- $type =~ /^American Express/ ||
- $type =~ /^Discover/ );
+ return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
} elsif ( $self->payby eq 'BILL' ) {
- $self->payinfo =~ /^([\w \-]*)$/ or return "Illegal P.O. number";
- $self->payinfo($1);
+ $error = $self->ut_textn('payinfo');
+ return "Illegal P.O. number" if $error;
} elsif ( $self->payby eq 'COMP' ) {
- $self->payinfo =~ /^(\w{2,8})$/ or return "Illegal comp account issuer";
- $self->payinfo($1);
+ $error = $self->ut_textn('payinfo');
+ return "Illegal comp account issuer" if $error;
}
=cut
sub all_pkgs {
- my($self)=@_;
+ my $self = shift;
qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
}
=cut
sub ncancelled_pkgs {
- my($self)=@_;
+ my $self = shift;
qsearch( 'cust_pkg', {
'custnum' => $self->custnum,
'cancel' => '',
=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';
# find the packages which are due for billing, find out how much they are
# & generate invoice database.
- my($total_setup,$total_recur)=(0,0);
-
- my(@cust_bill_pkg);
+ my( $total_setup, $total_recur ) = ( 0, 0 );
+ my @cust_bill_pkg;
- my($cust_pkg);
- foreach $cust_pkg (
+ foreach my $cust_pkg (
qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
) {
- bless($cust_pkg,"FS::cust_pkg");
-
- next if ( $cust_pkg->getfield('cancel') );
+ next if $cust_pkg->getfield('cancel');
#? to avoid use of uninitialized value errors... ?
$cust_pkg->setfield('bill', '')
unless defined($cust_pkg->bill);
- my($part_pkg)=
- qsearchs('part_pkg',{'pkgpart'=> $cust_pkg->pkgpart } );
+ my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
#so we don't modify cust_pkg record unnecessarily
- my($cust_pkg_mod_flag)=0;
- my(%hash)=$cust_pkg->hash;
- my($old_cust_pkg)=create FS::cust_pkg(\%hash);
+ my $cust_pkg_mod_flag = 0;
+ my %hash = $cust_pkg->hash;
+ my $old_cust_pkg = new FS::cust_pkg \%hash;
# bill setup
- my($setup)=0;
+ my $setup = 0;
unless ( $cust_pkg->setup ) {
- my($setup_prog)=$part_pkg->getfield('setup');
- my($cpt) = new Safe;
+ my $setup_prog = $part_pkg->getfield('setup');
+ my $cpt = new Safe;
#$cpt->permit(); #what is necessary?
- $cpt->share(qw($cust_pkg)); #can $cpt now use $cust_pkg methods?
+ $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
$setup = $cpt->reval($setup_prog);
unless ( defined($setup) ) {
warn "Error reval-ing part_pkg->setup pkgpart ",
}
#bill recurring fee
- my($recur)=0;
- my($sdate);
+ my $recur = 0;
+ my $sdate;
if ( $part_pkg->getfield('freq') > 0 &&
! $cust_pkg->getfield('susp') &&
( $cust_pkg->getfield('bill') || 0 ) < $time
) {
- my($recur_prog)=$part_pkg->getfield('recur');
- my($cpt) = new Safe;
+ my $recur_prog = $part_pkg->getfield('recur');
+ my $cpt = new Safe;
#$cpt->permit(); #what is necessary?
- $cpt->share(qw($cust_pkg)); #can $cpt now use $cust_pkg methods?
+ $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
$recur = $cpt->reval($recur_prog);
unless ( defined($recur) ) {
warn "Error reval-ing part_pkg->recur pkgpart ",
#change this bit to use Date::Manip?
#$sdate=$cust_pkg->bill || time;
#$sdate=$cust_pkg->bill || $time;
- $sdate=$cust_pkg->bill || $cust_pkg->setup || $time;
- my($sec,$min,$hour,$mday,$mon,$year)=
+ $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
+ my ($sec,$min,$hour,$mday,$mon,$year) =
(localtime($sdate) )[0,1,2,3,4,5];
$mon += $part_pkg->getfield('freq');
until ( $mon < 12 ) { $mon -= 12; $year++; }
- $cust_pkg->setfield('bill',timelocal($sec,$min,$hour,$mday,$mon,$year));
- $cust_pkg_mod_flag=1;
+ $cust_pkg->setfield('bill',
+ timelocal($sec,$min,$hour,$mday,$mon,$year));
+ $cust_pkg_mod_flag = 1;
}
}
warn "recur is undefinded" unless defined($recur);
warn "cust_pkg bill is undefinded" unless defined($cust_pkg->bill);
- if ($cust_pkg_mod_flag) {
+ if ( $cust_pkg_mod_flag ) {
$error=$cust_pkg->replace($old_cust_pkg);
- if ( $error ) {
+ if ( $error ) { #just in case
warn "Error modifying pkgnum ", $cust_pkg->pkgnum, ": $error";
} else {
- #just in case
- $setup=sprintf("%.2f",$setup);
- $recur=sprintf("%.2f",$recur);
- my($cust_bill_pkg)=create FS::cust_bill_pkg ({
+ $setup = sprintf( "%.2f", $setup );
+ $recur = sprintf( "%.2f", $recur );
+ my $cust_bill_pkg = new FS::cust_bill_pkg ({
'pkgnum' => $cust_pkg->pkgnum,
'setup' => $setup,
'recur' => $recur,
}
- my($charged)=sprintf("%.2f",$total_setup + $total_recur);
+ my $charged = sprintf( "%.2f", $total_setup + $total_recur );
return '' if scalar(@cust_bill_pkg) == 0;
- unless ( $self->getfield('tax') eq 'Y' ||
- $self->getfield('tax') eq 'y' ||
- $self->getfield('payby') eq 'COMP'
+ unless ( $self->getfield('tax') =~ /Y/i
+ || $self->getfield('payby') eq 'COMP'
) {
- my($cust_main_county) = qsearchs('cust_main_county',{
- 'county' => $self->getfield('county'),
- 'state' => $self->getfield('state'),
+ my $cust_main_county = qsearchs('cust_main_county',{
+ 'state' => $self->state,
+ 'county' => $self->county,
+ 'country' => $self->country,
} );
- my($tax) = sprintf("%.2f",
+ my $tax = sprintf( "%.2f",
$charged * ( $cust_main_county->getfield('tax') / 100 )
);
- $charged = sprintf("%.2f",$charged+$tax);
+ $charged = sprintf( "%.2f", $charged+$tax );
- my($cust_bill_pkg)=create FS::cust_bill_pkg ({
+ my $cust_bill_pkg = new FS::cust_bill_pkg ({
'pkgnum' => 0,
'setup' => $tax,
'recur' => 0,
push @cust_bill_pkg, $cust_bill_pkg;
}
- my($cust_bill) = create FS::cust_bill ( {
+ my $cust_bill = new FS::cust_bill ( {
'custnum' => $self->getfield('custnum'),
'_date' => $time,
'charged' => $charged,
} );
- $error=$cust_bill->insert;
+ $error = $cust_bill->insert;
#shouldn't happen, but how else to handle this? (wrap me in eval, to catch
# fatal errors)
die "Error creating cust_bill record: $error!\n",
"Check updated but unbilled packages for customer", $self->custnum, "\n"
if $error;
- my($invnum)=$cust_bill->invnum;
- my($cust_bill_pkg);
+ my $invnum = $cust_bill->invnum;
+ my $cust_bill_pkg;
foreach $cust_bill_pkg ( @cust_bill_pkg ) {
- $cust_bill_pkg->setfield('invnum',$invnum);
- $error=$cust_bill_pkg->insert;
+ $cust_bill_pkg->setfield( 'invnum', $invnum );
+ $error = $cust_bill_pkg->insert;
#shouldn't happen, but how else tohandle this?
die "Error creating cust_bill_pkg record: $error!\n",
"Check incomplete invoice ", $invnum, "\n"
=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?
local $SIG{TERM} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
- foreach my $cust_bill ( qsearch('cust_bill', {
- 'custnum' => $self->getfield('custnum'),
- } ) ) {
-
- bless($cust_bill,"FS::cust_bill");
+ foreach my $cust_bill (
+ qsearch('cust_bill', { 'custnum' => $self->custnum, } )
+ ) {
#this has to be before next's
- my($amount) = sprintf("%.2f", $total_owed < $cust_bill->owed
+ my $amount = sprintf( "%.2f", $total_owed < $cust_bill->owed
? $total_owed
: $cust_bill->owed
);
- $total_owed = sprintf("%.2f",$total_owed-$amount);
+ $total_owed = sprintf( "%.2f", $total_owed - $amount );
next unless $cust_bill->owed > 0;
- next if qsearchs('cust_pay_batch',{'invnum'=> $cust_bill->invnum });
+ next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
#warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)";
next unless $amount > 0;
- if ( $self->getfield('payby') eq 'BILL' ) {
+ if ( $self->payby eq 'BILL' ) {
#30 days 2592000
- my($since)=$invoice_time - ( $cust_bill->_date || 0 );
+ my $since = $invoice_time - ( $cust_bill->_date || 0 );
#warn "$invoice_time ", $cust_bill->_date, " $since";
if ( $since >= 0 #don't print future invoices
&& ( $cust_bill->printed * 2592000 ) <= $since
) {
- open(LPR,"|$lpr") or die "Can't open $lpr: $!";
+ open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
print LPR $cust_bill->print_text; #( date )
close LPR
or die $! ? "Error closing $lpr: $!"
: "Exit status $? from $lpr";
- my(%hash)=$cust_bill->hash;
+ my %hash = $cust_bill->hash;
$hash{'printed'}++;
- my($new_cust_bill)=create FS::cust_bill(\%hash);
- my($error)=$new_cust_bill->replace($cust_bill);
- if ( $error ) {
- warn "Error updating $cust_bill->printed: $error";
- }
+ my $new_cust_bill = new FS::cust_bill(\%hash);
+ my $error = $new_cust_bill->replace($cust_bill);
+ warn "Error updating $cust_bill->printed: $error" if $error;
}
- } elsif ( $self->getfield('payby') eq 'COMP' ) {
- my($cust_pay) = create FS::cust_pay ( {
- 'invnum' => $cust_bill->getfield('invnum'),
+ } elsif ( $self->payby eq 'COMP' ) {
+ my $cust_pay = new FS::cust_pay ( {
+ 'invnum' => $cust_bill->invnum,
'paid' => $amount,
'_date' => '',
'payby' => 'COMP',
- 'payinfo' => $self->getfield('payinfo'),
+ 'payinfo' => $self->payinfo,
'paybatch' => ''
} );
- my($error)=$cust_pay->insert;
- return 'Error COMPing invnum #' . $cust_bill->getfield('invnum') .
+ my $error = $cust_pay->insert;
+ return 'Error COMPing invnum #' . $cust_bill->invnum .
':' . $error if $error;
- } elsif ( $self->getfield('payby') eq 'CARD' ) {
+ } elsif ( $self->payby eq 'CARD' ) {
if ( $options{'batch_card'} ne 'yes' ) {
return "Real time card processing not enabled!" unless $processor;
- if ( $processor =~ /cybercash/ ) {
+ if ( $processor =~ /^cybercash/ ) {
#fix exp. date for cybercash
- $self->getfield('paydate') =~ /^(\d+)\/\d*(\d{2})$/;
- my($exp)="$1/$2";
+ $self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
+ my $exp = "$1/$2";
- my($paybatch)= $cust_bill->getfield('invnum') .
- '-' . time2str("%y%m%d%H%M%S",time);
+ my $paybatch = $cust_bill->invnum.
+ '-' . time2str("%y%m%d%H%M%S", time);
- my($payname)= $self->getfield('payname') ||
- $self->getfield('first') . ' ' .$self->getfield('last');
+ my $payname = $self->payname ||
+ $self->getfield('first'). ' '. $self->getfield('last');
- my($address)= $self->getfield('address1');
- $address .= ", " . $self->getfield('address2')
- if $self->getfield('address2');
+ my $address = $self->address1;
+ $address .= ", ". $self->address2 if $self->address2;
- my($country) = $self->getfield('country') eq 'US' ?
- 'USA' : $self->getfield('country');
+ my $country = 'USA' if $self->country eq 'US';
- my(@full_xaction)=($xaction,
+ my @full_xaction = ( $xaction,
'Order-ID' => $paybatch,
'Amount' => "usd $amount",
'Card-Number' => $self->getfield('payinfo'),
'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 ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
#if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
- my($cust_pay) = create FS::cust_pay ( {
- 'invnum' => $cust_bill->getfield('invnum'),
+ my $cust_pay = new FS::cust_pay ( {
+ 'invnum' => $cust_bill->invnum,
'paid' => $amount,
'_date' => '',
'payby' => 'CARD',
- 'payinfo' => $self->getfield('payinfo'),
+ 'payinfo' => $self->payinfo,
'paybatch' => "$processor:$paybatch",
} );
- my($error)=$cust_pay->insert;
+ my $error = $cust_pay->insert;
return 'Error applying payment, invnum #' .
- $cust_bill->getfield('invnum') . ':' . $error if $error;
+ $cust_bill->invnum. ':'. $error if $error;
} elsif ( $result{'Mstatus'} ne 'failure-bad-money'
|| $options{'report_badcard'} ) {
return 'Cybercash error, invnum #' .
- $cust_bill->getfield('invnum') . ':' . $result{'MErrMsg'};
+ $cust_bill->invnum. ':'. $result{'MErrMsg'};
} else {
return '';
}
} 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'),
'payname' => $self->getfield('payname'),
'amount' => $amount,
} );
-# my($error)=$cust_pay_batch->insert;
- my($error)=$cust_pay_batch->add;
+ my $error = $cust_pay_batch->insert;
return "Error adding to cust_pay_batch: $error" if $error;
}
} else {
- return "Unknown payment type ".$self->getfield('payby');
+ return "Unknown payment type ". $self->payby;
}
}
=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
=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
=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, ... ]
=cut
sub invoicing_list {
- my($self, @addresses) = @_;
+ my( $self, @addresses ) = @_;
if ( @addresses ) {
my @cust_main_invoice =
- qsearch('cust_main_invoice', { 'custnum' => $self->custnum } );
+ qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
foreach my $cust_main_invoice ( @cust_main_invoice ) {
unless ( grep { $cust_main_invoice->address eq $_ } @addresses ) {
$cust_main_invoice->delete;
}
}
@cust_main_invoice =
- qsearch('cust_main_invoice', { 'custnum' => $self->custnum } );
+ qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
foreach my $address ( @addresses ) {
unless ( grep { $address eq $_->address } @cust_main_invoice ) {
- my $cust_main_invoice = create FS::cust_main_invoice (
+ my $cust_main_invoice = new FS::cust_main_invoice (
'custnum' => $self->custnum,
'dest' => $address,
);
}
}
map { $_->address }
- qsearch('cust_main_invoice', { 'custnum' => $self->custnum } );
+ qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
}
=item check_invoicing_list ITEM, ITEM
=cut
sub check_invoicing_list {
- my($self, @addresses) = @_;
+ my( $self, @addresses ) = @_;
foreach my $address ( @addresses ) {
- my $cust_main_invoice = create FS::cust_main_invoice (
+ my $cust_main_invoice = new FS::cust_main_invoice (
'custnum' => $self->custnum,
'dest' => $address,
);
=back
-=head1 BUGS
+=head1 VERSION
-The delete method.
+$Id: cust_main.pm,v 1.8 1998-12-29 11:59:39 ivan Exp $
-It doesn't properly override FS::Record yet.
+=head1 BUGS
-hfields should be removed.
+The delete method.
Bill and collect options should probably be passed as references instead of a
list.
CyberCash v2 forces us to define some variables in package main.
+There should probably be a configuration file with a list of allowed credit
+card types.
+
+CyberCash is the only processor.
+
+No multiple currency support (probably a larger project than just this module).
+
=head1 SEE ALSO
L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
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
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
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;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new tax rate. To add the tax rate to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_main_county')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_main_county',$hashref);
-}
+sub table { 'cust_main_county'; }
=item insert
Adds this tax rate to the database. If there is an error, returns the error,
otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
Deletes this tax rate from the database. If there is an error, returns the
error, otherwise returns false.
-=cut
-
-sub delete {
- my($self)=@_;
-
- $self->del;
-}
-
=item replace OLD_RECORD
Replaces the OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_main_county record!"
- unless $old->table eq "cust_main_county";
- return "Can't change taxnum!"
- unless $old->getfield('taxnum') eq $new->getfield('taxnum');
- $new->check or
- $new->rep($old);
-}
-
=item check
Checks all fields to make sure this is a valid tax rate. If there is an error,
=cut
sub check {
- my($self)=@_;
- return "Not a cust_main_county record!"
- unless $self->table eq "cust_main_county";
- my($recref) = $self->hashref;
+ my $self = shift;
$self->ut_numbern('taxnum')
- or $self->ut_textn('state')
- or $self->ut_textn('county')
- or $self->ut_float('tax')
+ || $self->ut_textn('state')
+ || $self->ut_textn('county')
+ || $self->ut_float('tax')
;
}
=head1 VERSION
-$Id: cust_main_county.pm,v 1.2 1998-11-18 09:01:43 ivan Exp $
+$Id: cust_main_county.pm,v 1.3 1998-12-29 11:59:41 ivan Exp $
=head1 BUGS
-It doesn't properly override FS::Record yet.
-
=head1 SEE ALSO
L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill>, schema.html from the base
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!
use strict;
use vars qw(@ISA $conf $mydomain);
use Exporter;
-use FS::Record; # qw(qsearch qsearchs);
+use FS::Record qw( qsearchs );
use FS::Conf;
+use FS::cust_main;
+use FS::svc_acct;
-@ISA = qw(FS::Record);
+@ISA = qw( FS::Record );
#ask FS::UID to run this stuff for us later
$FS::UID::callback{'FS::cust_main_invoice'} = sub {
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;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new invoice destination. To add the invoice destination to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- $proto->new('cust_main_invoice',$hashref);
-
-}
+sub table { 'cust_main_invoice'; }
=item insert
Adds this record to the database. If there is an error, returns the error,
otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- #local $SIG{HUP} = 'IGNORE';
- #local $SIG{INT} = 'IGNORE';
- #local $SIG{QUIT} = 'IGNORE';
- #local $SIG{TERM} = 'IGNORE';
- #local $SIG{TSTP} = 'IGNORE';
-
- $self->check or
- $self->add;
-}
-
=item delete
Delete this record from the database.
-=cut
-
-sub delete {
- my($self)=@_;
-
- $self->del;
-}
-
=item replace OLD_RECORD
Replaces the OLD_RECORD with this one in the database. If there is an error,
=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;
}
=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')
#contemplate our navel
} elsif ( $self->dest =~ /^(\d+)$/ ) {
return "Unknown local account (specified by svcnum)"
- unless qsearchs('svc_acct', { 'svcnum' => $self->dest } );
+ unless qsearchs( 'svc_acct', { 'svcnum' => $self->dest } );
} elsif ( $self->dest =~ /^([\w\.\-]+)\@(([\w\.\-]\.)+\w+)$/ ) {
my($user, $domain) = ($1, $2);
if ( $domain eq $mydomain ) {
- my $svc_acct = qsearchs('svc_acct', { 'username' => $user } );
+ my $svc_acct = qsearchs( 'svc_acct', { 'username' => $user } );
return "Unknown local account (specified literally)" unless $svc_acct;
$svc_acct->svcnum =~ /^(\d+)$/ or die "Non-numeric svcnum?!";
$self->dest($1);
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;
=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
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
package FS::cust_pay;
use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
+use vars qw( @ISA );
use Business::CreditCard;
-use FS::Record qw(fields qsearchs);
+use FS::Record qw( qsearchs );
use FS::cust_bill;
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
+@ISA = qw( FS::Record );
=head1 NAME
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;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new payment. To add the payment to the databse, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_pay')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_pay',$hashref);
-
-}
+sub table { 'cust_pay'; }
=item insert
=cut
sub insert {
- my($self)=@_;
+ my $self = shift;
- my($error);
+ my $error;
- $error=$self->check;
+ $error = $self->check;
return $error if $error;
- my($old_cust_bill) = qsearchs('cust_bill', {
- 'invnum' => $self->getfield('invnum')
- } );
+ my $old_cust_bill = qsearchs( 'cust_bill', { 'invnum' => $self->invnum } );
return "Unknown invnum" unless $old_cust_bill;
- my(%hash)=$old_cust_bill->hash;
- $hash{owed} = sprintf("%.2f",$hash{owed} - $self->getfield('paid') );
- my($new_cust_bill) = create FS::cust_bill ( \%hash );
+ my %hash = $old_cust_bill->hash;
+ $hash{'owed'} = sprintf("%.2f", $hash{owed} - $self->paid );
+ my $new_cust_bill = new FS::cust_bill ( \%hash );
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{TERM} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
- $error=$new_cust_bill -> replace($old_cust_bill);
+ $error = $new_cust_bill->replace($old_cust_bill);
return "Error modifying cust_bill: $error" if $error;
- $self->add;
+ $self->SUPER::insert;
}
=item delete
sub delete {
return "Can't (yet?) delete cust_pay records!";
-#template code below
-# my($self)=@_;
-#
-# $self->del;
}
=item replace OLD_RECORD
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
=cut
sub check {
- my($self)=@_;
- return "Not a cust_pay record!" unless $self->table eq "cust_pay";
- my($recref) = $self->hashref;
-
- $recref->{paynum} =~ /^(\d*)$/ or return "Illegal paynum";
- $recref->{paynum} = $1;
+ my $self = shift;
- $recref->{invnum} =~ /^(\d+)$/ or return "Illegal invnum";
- $recref->{invnum} = $1;
+ my $error;
- $recref->{paid} =~ /^(\d+(\.\d\d)?)$/ or return "Illegal paid";
- $recref->{paid} = $1;
-
- $recref->{_date} =~ /^(\d*)$/ or return "Illegal date";
- $recref->{_date} = $recref->{_date} ? $1 : time;
+ $error =
+ $self->ut_numbern('paynum')
+ || $self->ut_number('invnum')
+ || $self->ut_money('paid')
+ || $self->ut_numbern('_date')
+ ;
+ return $error if $error;
- $recref->{payby} =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby";
- $recref->{payby} = $1;
+ $self->_date(time) unless $self->_date;
- if ( $recref->{payby} eq 'CARD' ) {
+ $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby";
+ $self->payby($1);
- $recref->{payinfo} =~ s/\D//g;
- if ( $recref->{payinfo} ) {
- $recref->{payinfo} =~ /^(\d{13,16})$/
+ if ( $self->payby eq 'CARD' ) {
+ my $payinfo = $self->payinfo;
+ $self->payinfo($payinfo =~ s/\D//g);
+ if ( $self->payinfo ) {
+ $self->payinfo =~ /^(\d{13,16})$/
or return "Illegal (mistyped?) credit card number (payinfo)";
- $recref->{payinfo} = $1;
- #validate($recref->{payinfo})
- # or return "Illegal credit card number";
- my($type)=cardtype($recref->{payinfo});
- return "Unknown credit card type"
- unless ( $type =~ /^VISA/ ||
- $type =~ /^MasterCard/ ||
- $type =~ /^American Express/ ||
- $type =~ /^Discover/ );
+ $self->payinfo($1);
+ validate($self->payinfo) or return "Illegal credit card number";
+ return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
} else {
- $recref->{payinfo}='N/A';
+ $self->payinfo('N/A');
}
- } elsif ( $recref->{payby} eq 'BILL' ) {
-
- $recref->{payinfo} =~ /^([\w \-]*)$/
- or return "Illegal P.O. number (payinfo)";
- $recref->{payinfo} = $1;
-
- } elsif ( $recref->{payby} eq 'COMP' ) {
-
- $recref->{payinfo} =~ /^([\w]{2,8})$/
- or return "Illegal comp account issuer (payinfo)";
- $recref->{payinfo} = $1;
-
+ } else {
+ $error = $self->ut_textn('payinfo');
+ return $error if $error;
}
- $recref->{paybatch} =~ /^([\w\-\:]*)$/
- or return "Illegal paybatch";
- $recref->{paybatch} = $1;
+ $error = $self->ut_textn('paybatch');
+ return $error if $error;
''; #no error
=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.
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;
package FS::cust_pay_batch;
use strict;
-use vars qw (@ISA);
-use Exporter;
-#use FS::UID qw(getotaker);
-use FS::Record qw(hfields qsearch qsearchs);
+use vars qw( @ISA );
+use FS::Record;
use Business::CreditCard;
-@ISA = qw(FS::Record);
+@ISA = qw( FS::Record );
=head1 NAME
-FS::cust_pay_batdh - Object methods for batch cards
+FS::cust_pay_batch - Object methods for batch cards
=head1 SYNOPSIS
use FS::cust_pay_batch;
- $record = create FS::cust_pay_batch \%hash;
- $record = create FS::cust_pay_batch { 'column' => 'value' };
+ $record = new FS::cust_pay_batch \%hash;
+ $record = new FS::cust_pay_batch { 'column' => 'value' };
$error = $record->insert;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new record. To add the record to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- $proto->new('cust_pay_batch',$hashref);
-
-}
+sub table { 'cust_pay_batch'; }
=item insert
Adds this record to the database. If there is an error, returns the error,
otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- #local $SIG{HUP} = 'IGNORE';
- #local $SIG{INT} = 'IGNORE';
- #local $SIG{QUIT} = 'IGNORE';
- #local $SIG{TERM} = 'IGNORE';
- #local $SIG{TSTP} = 'IGNORE';
-
- $self->check or
- $self->add;
-}
-
=item delete
-#inactive
-#
-#Delete this record from the database.
-
-=cut
-
-sub delete {
- my($self)=@_;
-
- #$self->del;
-
- return "Can't (yet?) delete batched transactions!";
-}
+Delete this record from the database. If there is an error, returns the error,
+otherwise returns false.
=item replace OLD_RECORD
=cut
sub replace {
- my($new,$old)=@_;
- #return "(Old) Not a table_name record!" unless $old->table eq "table_name";
- #
- #return "Can't change keyfield!"
- # unless $old->getfield('keyfield') eq $new->getfield('keyfield');
- #
- #$new->check or
- #$new->rep($old);
-
return "Can't (yet?) replace batched transactions!";
}
=item check
-Checks all fields to make sure this is a valid example. If there is
+Checks all fields to make sure this is a valid transaction. If there is
an error, returns the error, otherwise returns false. Called by the insert
and repalce methods.
=cut
sub check {
- my($self)=@_;
- return "Not a cust_pay_batch record!" unless $self->table eq "cust_pay_batch";
+ my $self = shift;
my $error =
$self->ut_numbern('trancode')
- or $self->ut_number('cardnum')
- or $self->ut_money('amount')
- or $self->ut_number('invnum')
- or $self->ut_number('custnum')
- or $self->ut_text('address1')
- or $self->ut_textn('address2')
- or $self->ut_text('city')
- or $self->ut_text('state')
+ || $self->ut_number('cardnum')
+ || $self->ut_money('amount')
+ || $self->ut_number('invnum')
+ || $self->ut_number('custnum')
+ || $self->ut_text('address1')
+ || $self->ut_textn('address2')
+ || $self->ut_text('city')
+ || $self->ut_text('state')
;
return $error if $error;
$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";
=head1 VERSION
-$Id: cust_pay_batch.pm,v 1.2 1998-11-18 09:01:44 ivan Exp $
+$Id: cust_pay_batch.pm,v 1.3 1998-12-29 11:59:44 ivan Exp $
=head1 BUGS
+There should probably be a configuration file with a list of allowed credit
+card types.
+
=head1 SEE ALSO
L<FS::cust_main>, L<FS::Record>
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
use strict;
use vars qw(@ISA);
-use Exporter;
-use FS::UID qw(getotaker);
-use FS::Record qw(fields qsearch qsearchs);
+use FS::UID qw( getotaker );
+use FS::Record qw( qsearch qsearchs );
use FS::cust_svc;
use FS::part_pkg;
use FS::cust_main;
-@ISA = qw(FS::Record Exporter);
+# need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
+# setup }
+# because they load configuraion by setting FS::UID::callback (see TODO)
+use FS::svc_acct;
+use FS::svc_acct_sm;
+use FS::svc_domain;
+
+@ISA = qw( FS::Record );
=head1 NAME
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;
=over 4
-=item create HASHREF
+=item new HASHREF
Create a new billing item. To add the item to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_pkg')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_pkg',$hashref);
-}
+sub table { 'cust_pkg'; }
=item insert
Adds this billing item to the database ("Orders" the item). If there is an
error, returns the error, otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
Currently unimplemented. You don't want to delete billing items, because there
would then be no record the customer ever purchased the item. Instead, see
the cancel method.
+=cut
+
sub delete {
return "Can't delete cust_pkg records!";
}
=cut
sub replace {
- my($new,$old)=@_;
- return "(Old) Not a cust_pkg record!" if $old->table ne "cust_pkg";
- return "Can't change pkgnum!"
- if $old->getfield('pkgnum') ne $new->getfield('pkgnum');
- #return "Can't (yet?) change pkgpart!"
- # if $old->getfield('pkgpart') ne $new->getfield('pkgpart');
- return "Can't change otaker!"
- if $old->getfield('otaker') ne $new->getfield('otaker');
+ my( $new, $old ) = ( shift, shift );
+
+ #return "Can't (yet?) change pkgpart!" if $old->pkgpart ne $new->pkgpart;
+ return "Can't change otaker!" if $old->otaker ne $new->otaker;
return "Can't change setup once it exists!"
if $old->getfield('setup') &&
$old->getfield('setup') != $new->getfield('setup');
#some logic for bill, susp, cancel?
- $new->check or
- $new->rep($old);
+ $new->SUPER::replace($old);
}
=item check
=cut
sub check {
- my($self)=@_;
- return "Not a cust_pkg record!" if $self->table ne "cust_pkg";
- my($recref) = $self->hashref;
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('pkgnum')
+ || $self->ut_number('custnum')
+ || $self->ut_number('pkgpart')
+ || $self->ut_numbern('setup')
+ || $self->ut_numbern('bill')
+ || $self->ut_numbern('susp')
+ || $self->ut_numbern('cancel')
+ ;
+ return $error if $error;
- $recref->{pkgnum} =~ /^(\d*)$/ or return "Illegal pkgnum";
- $recref->{pkgnum}=$1;
-
- $recref->{custnum} =~ /^(\d+)$/ or return "Illegal custnum";
- $recref->{custnum}=$1;
return "Unknown customer"
- unless qsearchs('cust_main',{'custnum'=>$recref->{custnum}});
+ unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
- $recref->{pkgpart} =~ /^(\d+)$/ or return "Illegal pkgpart";
- $recref->{pkgpart}=$1;
return "Unknown pkgpart"
- unless qsearchs('part_pkg',{'pkgpart'=>$recref->{pkgpart}});
-
- $recref->{otaker} ||= &getotaker;
- $recref->{otaker} =~ /^(\w{0,8})$/ or return "Illegal otaker";
- $recref->{otaker}=$1;
-
- $recref->{setup} =~ /^(\d*)$/ or return "Illegal setup date";
- $recref->{setup}=$1;
+ unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
- $recref->{bill} =~ /^(\d*)$/ or return "Illegal bill date";
- $recref->{bill}=$1;
-
- $recref->{susp} =~ /^(\d*)$/ or return "Illegal susp date";
- $recref->{susp}=$1;
-
- $recref->{cancel} =~ /^(\d*)$/ or return "Illegal cancel date";
- $recref->{cancel}=$1;
+ $self->otaker(getotaker) unless $self->otaker;
+ $self->otaker =~ /^(\w{0,16})$/ or return "Illegal otaker";
+ $self->otaker($1);
''; #no error
}
=cut
sub cancel {
- my($self)=@_;
- my($error);
+ my $self = shift;
+ my $error;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = '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!";
- my($svcdb) = $1;
+ my $svcdb = $1;
require "FS/$svcdb.pm";
- my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->svcnum } );
+ my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
if ($svc) {
- bless($svc,"FS::$svcdb");
$error = $svc->cancel;
return "Error cancelling service: $error" if $error;
$error = $svc->delete;
return "Error deleting service: $error" if $error;
}
- bless($cust_svc,"FS::cust_svc");
$error = $cust_svc->delete;
return "Error deleting cust_svc: $error" if $error;
}
unless ( $self->getfield('cancel') ) {
- my(%hash) = $self->hash;
- $hash{'cancel'}=$^T;
- my($new) = create FS::cust_pkg ( \%hash );
- $error=$new->replace($self);
+ my %hash = $self->hash;
+ $hash{'cancel'} = $^T;
+ my $new = new FS::cust_pkg ( \%hash );
+ $error = $new->replace($self);
return $error if $error;
}
=cut
sub suspend {
- my($self)=@_;
- my($error);
+ my $self = shift;
+ my $error ;
+
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
local $SIG{TERM} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
- my($cust_svc);
- foreach $cust_svc (
- qsearch('cust_svc',{'pkgnum'=> $self->getfield('pkgnum') } )
+ foreach my $cust_svc (
+ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
) {
- my($part_svc)=
- qsearchs('part_svc',{'svcpart'=> $cust_svc->getfield('svcpart') } );
+ my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
- $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
+ $part_svc->svcdb =~ /^([\w\-]+)$/
or return "Illegal svcdb value in part_svc!";
- my($svcdb) = $1;
+ my $svcdb = $1;
require "FS/$svcdb.pm";
- my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } );
-
+ my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
if ($svc) {
- bless($svc,"FS::$svcdb");
$error = $svc->suspend;
return $error if $error;
}
}
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;
}
=cut
sub unsuspend {
- my($self)=@_;
+ my $self = shift;
my($error);
local $SIG{HUP} = 'IGNORE';
local $SIG{TERM} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
- my($cust_svc);
- foreach $cust_svc (
- qsearch('cust_svc',{'pkgnum'=> $self->getfield('pkgnum') } )
+ foreach my $cust_svc (
+ qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
) {
- my($part_svc)=
- qsearchs('part_svc',{'svcpart'=> $cust_svc->getfield('svcpart') } );
+ my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
- $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
+ $part_svc->svcdb =~ /^([\w\-]+)$/
or return "Illegal svcdb value in part_svc!";
- my($svcdb) = $1;
+ my $svcdb = $1;
require "FS/$svcdb.pm";
- my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } );
+ my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
if ($svc) {
- bless($svc,"FS::$svcdb");
$error = $svc->unsuspend;
return $error if $error;
}
}
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;
}
=cut
sub part_pkg {
- my($self)=@_;
- qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart });
+ my $self = shift;
+ qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
}
=back
=head1 VERSION
-$Id: cust_pkg.pm,v 1.3 1998-11-15 13:01:35 ivan Exp $
+$Id: cust_pkg.pm,v 1.4 1998-12-29 11:59:45 ivan Exp $
=head1 BUGS
-It doesn't properly override FS::Record yet.
-
sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
In sub order, the @pkgparts array (passed by reference) is clobbered.
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>
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
package FS::cust_refund;
use strict;
-use vars qw(@ISA @EXPORT_OK);
-use Exporter;
+use vars qw( @ISA );
use Business::CreditCard;
-use FS::Record qw(fields qsearchs);
+use FS::Record qw( qsearchs );
use FS::UID qw(getotaker);
use FS::cust_credit;
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
+@ISA = qw( FS::Record );
=head1 NAME
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;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new refund. To add the refund to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_refund')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_refund',$hashref);
-
-}
+sub table { 'cust_refund'; }
=item insert
=cut
sub insert {
- my($self)=@_;
+ my $self = shift;
- my($error);
+ my $error;
$error=$self->check;
return $error if $error;
- my($old_cust_credit) = qsearchs('cust_credit', {
- 'crednum' => $self->getfield('crednum')
- } );
+ my $old_cust_credit =
+ qsearchs( 'cust_credit', { 'crednum' => $self->crednum } );
return "Unknown crednum" unless $old_cust_credit;
- my(%hash)=$old_cust_credit->hash;
- $hash{credited} = sprintf("%.2f",$hash{credited} - $self->getfield('refund') );
- my($new_cust_credit) = create FS::cust_credit ( \%hash );
+ my %hash = $old_cust_credit->hash;
+ $hash{credited} = sprintf("%.2f", $hash{credited} - $self->refund );
+ my($new_cust_credit) = new FS::cust_credit ( \%hash );
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{TERM} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
- $error=$new_cust_credit -> replace($old_cust_credit);
+ $error = $new_cust_credit->replace($old_cust_credit);
return "Error modifying cust_credit: $error" if $error;
- $self->add;
+ $self->SUPER::insert;
}
=item delete
sub delete {
return "Can't (yet?) delete cust_refund records!";
-#template code below
-# my($self)=@_;
-#
-# $self->del;
}
=item replace OLD_RECORD
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
=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')
;
return $error if $error;
- my($recref) = $self->hashref;
-
- $recref->{_date} ||= time;
+ $self->_date(time) unless $self->_date;
- $recref->{payby} =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby";
- $recref->{payby} = $1;
+ $self->payby =~ /^(CARD|BILL|COMP)$/ or return "Illegal payby";
+ $self->payby($1);
- if ( $recref->{payby} eq 'CARD' ) {
-
- $recref->{payinfo} =~ s/\D//g;
- if ( $recref->{payinfo} ) {
- $recref->{payinfo} =~ /^(\d{13,16})$/
+ if ( $self->payby eq 'CARD' ) {
+ my $payinfo = $self->payinfo;
+ $self->payinfo($payinfo =~ s/\D//g);
+ if ( $self->payinfo ) {
+ $self->payinfo =~ /^(\d{13,16})$/
or return "Illegal (mistyped?) credit card number (payinfo)";
- $recref->{payinfo} = $1;
- #validate($recref->{payinfo})
- # or return "Illegal (checksum) credit card number (payinfo)";
- my($type)=cardtype($recref->{payinfo});
- return "Unknown credit card type"
- unless ( $type =~ /^VISA/ ||
- $type =~ /^MasterCard/ ||
- $type =~ /^American Express/ ||
- $type =~ /^Discover/ );
+ $self->payinfo($1);
+ validate($self->payinfo) or return "Illegal credit card number";
+ return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
} else {
- $recref->{payinfo}='N/A';
+ $self->payinfo('N/A');
}
- } elsif ( $recref->{payby} eq 'BILL' ) {
-
- $recref->{payinfo} =~ /^([\w \-]*)$/
- or return "Illegal P.O. number (payinfo)";
- $recref->{payinfo} = $1;
-
- } elsif ( $recref->{payby} eq 'COMP' ) {
-
- $recref->{payinfo} =~ /^([\w]{2,8})$/
- or return "Illegal comp account issuer (payinfo)";
- $recref->{payinfo} = $1;
-
+ } else {
+ $error = $self->ut_textn('payinfo');
+ return $error if $error;
}
$self->otaker(getotaker);
=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.
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;
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::svc_acct_sm;
use FS::svc_domain;
-@ISA = qw(FS::Record Exporter);
+@ISA = qw( FS::Record );
=head1 NAME
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;
=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
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('cust_svc')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('cust_svc',$hashref);
-}
+sub table { 'cust_svc'; }
=item insert
Adds this service to the database. If there is an error, returns the error,
otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
Deletes this service from the database. If there is an error, returns the
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.
-=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,
=cut
sub check {
- my($self)=@_;
- return "Not a cust_svc record!" unless $self->table eq "cust_svc";
- my($recref) = $self->hashref;
+ my $self = shift;
- $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum";
- $recref->{svcnum}=$1;
+ my $error =
+ $self->ut_numbern('svcnum')
+ || $self->ut_numbern('pkgnum')
+ || $self->ut_number('svcpart')
+ ;
+ return $error if $error;
- $recref->{pkgnum} =~ /^(\d*)$/ or return "Illegal pkgnum";
- $recref->{pkgnum}=$1;
- return "Unknown pkgnum" unless
- ! $recref->{pkgnum} ||
- qsearchs('cust_pkg',{'pkgnum'=>$recref->{pkgnum}});
+ return "Unknown pkgnum"
+ unless ! $self->pkgnum
+ || qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
- $recref->{svcpart} =~ /^(\d+)$/ or return "Illegal svcpart";
- $recref->{svcpart}=$1;
return "Unknown svcpart" unless
- qsearchs('part_svc',{'svcpart'=>$recref->{svcpart}});
+ qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
''; #no error
}
=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' ) {
my $domain = $svc_domain->domain;
$tag = "$domuser\@$domain";
} elsif ( $svcdb eq 'svc_domain' ) {
- return $svc, $svc_x->getfield('domain');
+ $tag = $svc_x->getfield('domain');
} else {
- carp "warning: asked for label of unsupported svcdb; using svcnum";
+ cluck "warning: asked for label of unsupported svcdb; using svcnum";
$tag = $svc_x->getfield('svcnum');
}
$svc, $tag, $svcdb;
=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
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>,
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
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
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;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new billing item definition. To add the billing item definition to
the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('part_pkg')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('part_pkg',$hashref);
-}
+sub table { 'part_pkg'; }
=item clone
-Creates a new billing item definition by duplicating an existing definition.
-A new pkgpart is assigned and "(CUSTOM) " is prepended to the comment field.
-To add the billing item definition to the database, see L<"insert">.
+An alternate constructor. Creates a new billing item definition by duplicating
+an existing definition. A new pkgpart is assigned and `(CUSTOM) ' is prepended
+to the comment field. To add the billing item definition to the database, see
+L<"insert">.
=cut
sub clone {
my $self = shift;
+ my $class = ref($self);
my %hash = $self->hash;
$hash{'pkgpart'} = '';
$hash{'comment'} = "(CUSTOM) ". $hash{'comment'}
unless $hash{'comment'} =~ /^\(CUSTOM\) /;
- create FS::part_pkg ( \%hash ); # ?
+ #new FS::part_pkg ( \%hash ); # ?
+ new $class ( \%hash ); # ?
}
=item insert
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.
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
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
=cut
sub check {
- my($self)=@_;
- return "Not a part_pkg record!" unless $self->table eq "part_pkg";
+ my $self = shift;
$self->ut_numbern('pkgpart')
- or $self->ut_text('pkg')
- or $self->ut_text('comment')
- or $self->ut_anything('setup')
- or $self->ut_number('freq')
- or $self->ut_anything('recur')
+ || $self->ut_text('pkg')
+ || $self->ut_text('comment')
+ || $self->ut_anything('setup')
+ || $self->ut_number('freq')
+ || $self->ut_anything('recur')
;
-
}
=back
=head1 VERSION
-$Id: part_pkg.pm,v 1.3 1998-11-15 13:00:15 ivan Exp $
+$Id: part_pkg.pm,v 1.4 1998-12-29 11:59:48 ivan Exp $
=head1 BUGS
-It doesn't properly override FS::Record yet.
-
The delete method is unimplemented.
setup and recur semantics are not yet defined (and are implemented in
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
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
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;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new referral. To add the referral to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('part_referral')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('part_referral',$hashref);
-}
+sub table { 'part_referral'; }
=item insert
Adds this referral to the database. If there is an error, returns the error,
otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
Currently unimplemented.
=cut
sub delete {
- my($self)=@_;
+ my $self = shift;
return "Can't (yet?) delete part_referral records";
- #$self->del;
+ #need to make sure no customers have this referral!
}
=item replace OLD_RECORD
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,
=cut
sub check {
- my($self)=@_;
- return "Not a part_referral record!" unless $self->table eq "part_referral";
+ my $self = shift;
- my($error)=
- $self->ut_numbern('refnum')
- or $self->ut_text('referral')
+ $self->ut_numbern('refnum')
+ || $self->ut_text('referral')
;
- return $error if $error;
-
- '';
-
}
=back
-=head1 BUGS
+=head1 VERSION
-It doesn't properly override FS::Record yet.
+$Id: part_referral.pm,v 1.2 1998-12-29 11:59:49 ivan Exp $
+
+=head1 BUGS
The delete method is unimplemented.
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;
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
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;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new service definition. To add the service definition to the
database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('part_svc')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('part_svc',$hashref);
-}
+sub table { 'part_svc'; }
=item insert
Adds this service definition to the database. If there is an error, returns
the error, otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
Currently unimplemented.
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
=cut
sub replace {
- my($new,$old)=@_;
- return "(Old) Not a part_svc record!" unless $old->table eq "part_svc";
- return "Can't change svcpart!"
- unless $old->getfield('svcpart') eq $new->getfield('svcpart');
+ my ( $new, $old ) = shift, shift;
+
return "Can't change svcdb!"
- unless $old->getfield('svcdb') eq $new->getfield('svcdb');
- $new->check or
- $new->rep($old);
+ unless $old->svcdb eq $new->svcdb;
+
+ $new->SUPER::replace( $old );
}
=item check
=cut
sub check {
- my($self)=@_;
- return "Not a part_svc record!" unless $self->table eq "part_svc";
- my($recref) = $self->hashref;
+ my $self = shift;
+ my $recref = $self->hashref;
- my($error);
- return $error if $error=
+ my $error;
+ $error=
$self->ut_numbern('svcpart')
|| $self->ut_text('svc')
|| $self->ut_alpha('svcdb')
;
+ return $error if $error;
- my(@fields) = eval { fields($recref->{svcdb}) }; #might die
+ my @fields = eval { fields( $recref->{svcdb} ) }; #might die
return "Unknown svcdb!" unless @fields;
- my($svcdb);
+ my $svcdb;
foreach $svcdb ( qw(
- svc_acct svc_acct_sm svc_charge svc_domain svc_wo
+ svc_acct svc_acct_sm svc_domain
) ) {
- my(@rows)=map { /^${svcdb}__(.*)$/; $1 }
+ my @rows = map { /^${svcdb}__(.*)$/; $1 }
grep ! /_flag$/,
grep /^${svcdb}__/,
fields('part_svc');
- my($row);
- foreach $row (@rows) {
+ foreach my $row (@rows) {
unless ( $svcdb eq $recref->{svcdb} ) {
$recref->{$svcdb.'__'.$row}='';
$recref->{$svcdb.'__'.$row.'_flag'}='';
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;
}
}
=back
-=head1 BUGS
+=head1 VERSION
+
+$Id: part_svc.pm,v 1.2 1998-12-29 11:59:50 ivan Exp $
-It doesn't properly override FS::Record yet.
+=head1 BUGS
Delete is unimplemented.
+The list of svc_* tables is hardcoded. When svc_acct_pop is renamed, this
+should be fixed.
+
=head1 SEE ALSO
L<FS::Record>, L<FS::part_pkg>, L<FS::pkg_svc>, L<FS::cust_svc>,
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;
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
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;
=over 4
-=item create HASHREF
+=item new HASHREF
Create a new record. To add the record to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('pkg_svc')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('pkg_svc',$hashref);
-
-}
+sub table { 'pkg_svc'; }
=item insert
Adds this record to the database. If there is an error, returns the error,
otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
Deletes this record from the database. If there is an error, returns the
error, otherwise returns false.
-=cut
-
-sub delete {
- my($self)=@_;
-
- $self->del;
-}
-
=item replace OLD_RECORD
Replaces OLD_RECORD with this one in the database. If there is an error,
=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
=cut
sub check {
- my($self)=@_;
- return "Not a pkg_svc record!" unless $self->table eq "pkg_svc";
- my($recref) = $self->hashref;
+ my $self = shift;
- my($error);
- return $error if $error =
+ my $error;
+ $error =
$self->ut_number('pkgpart')
|| $self->ut_number('svcpart')
|| $self->ut_number('quantity')
;
+ return $error if $error;
return "Unknown pkgpart!"
- unless qsearchs('part_pkg',{'pkgpart'=> $self->getfield('pkgpart')});
+ unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
return "Unknown svcpart!"
- unless qsearchs('part_svc',{'svcpart'=> $self->getfield('svcpart')});
+ unless qsearchs('part_svc', { 'svcpart' => $self->svcpart } );
''; #no error
}
=back
-=head1 BUGS
+=head1 VERSION
+
+$Id: pkg_svc.pm,v 1.2 1998-12-29 11:59:51 ivan Exp $
-It doesn't properly override FS::Record yet.
+=head1 BUGS
=head1 SEE ALSO
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;
package FS::svc_acct;
use strict;
-use vars qw(@ISA @EXPORT_OK $nossh_hack $conf $dir_prefix @shells
+use vars qw(@ISA $nossh_hack $conf $dir_prefix @shells
$shellmachine @saltset @pw_set);
-use Exporter;
use FS::Conf;
-use FS::Record qw(fields qsearchs);
+use FS::Record qw( qsearchs fields );
use FS::SSH qw(ssh);
use FS::cust_svc;
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
+@ISA = qw( FS::Record );
#ask FS::UID to run this stuff for us later
$FS::UID::callback{'FS::svc_acct'} = sub {
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;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new account. To add the account to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('svc_acct')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('svc_acct',$hashref);
-
-}
+sub table { 'svc_acct'; }
=item insert
=cut
sub insert {
- my($self)=@_;
- my($error);
+ my $self = shift;
+ my $error;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = '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"
- if qsearchs('svc_acct',{'username'=> $self->username } );
+ if qsearchs( 'svc_acct', { 'username' => $self->username } );
- my($part_svc) = qsearchs('part_svc',{ 'svcpart' => $self->svcpart });
+ my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
return "Unkonwn svcpart" unless $part_svc;
return "uid in use"
if $part_svc->svc_acct__uid_flag ne 'F'
- && qsearchs('svc_acct',{'uid'=> $self->uid } )
+ && qsearchs( 'svc_acct', { 'uid' => $self->uid } )
&& $self->username !~ /^(hyla)?fax$/
;
- my($svcnum)=$self->svcnum;
- my($cust_svc);
+ my $svcnum = $self->svcnum;
+ my $cust_svc;
unless ( $svcnum ) {
- $cust_svc=create FS::cust_svc ( {
+ $cust_svc = new FS::cust_svc ( {
'svcnum' => $svcnum,
'pkgnum' => $self->pkgnum,
'svcpart' => $self->svcpart,
} );
- my($error) = $cust_svc->insert;
+ my $error = $cust_svc->insert;
return $error if $error;
$svcnum = $self->svcnum($cust_svc->svcnum);
}
- $error = $self->add;
+ $error = $self->SUPER::insert;
if ($error) {
- #$cust_svc->del if $cust_svc;
$cust_svc->delete if $cust_svc;
return $error;
}
- my($username,$uid,$dir,$shell) = (
+ my ( $username, $uid, $dir, $shell ) = (
$self->username,
$self->uid,
$self->dir,
=cut
sub delete {
- my($self)=@_;
- my($error);
+ my $self = shift;
+ my $error;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = '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;
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- $error = $cust_svc->del;
+ my $cust_svc = qsearchs( 'cust_svc' , { 'svcnum' => $svcnum } );
+ $error = $cust_svc->delete;
return $error if $error;
- my($username) = $self->getfield('username');
+ my $username = $self->username;
if ( $username && $shellmachine && ! $nossh_hack ) {
ssh("root\@$shellmachine","userdel $username");
}
=cut
sub replace {
- my($new,$old)=@_;
- my($error);
-
- return "(Old) Not a svc_acct record!" unless $old->table eq "svc_acct";
- return "Can't change svcnum!"
- unless $old->getfield('svcnum') eq $new->getfield('svcnum');
+ my ( $new, $old ) = @_;
+ my $error;
return "Username in use"
- if $old->getfield('username') ne $new->getfield('username') &&
- qsearchs('svc_acct',{'username'=> $new->getfield('username') } );
+ if $old->username ne $new->username &&
+ qsearchs( 'svc_acct', { 'username' => $new->username } );
- return "Can't change uid!"
- if $old->getfield('uid') ne $new->getfield('uid');
+ return "Can't change uid!" if $old->uid ne $new->uid;
#change homdir when we change username
- if ( $old->getfield('username') ne $new->getfield('username') ) {
- $new->setfield('dir','');
- }
-
- $error=$new->check;
- return $error if $error;
+ $new->setfield('dir', '') if $old->username ne $new->username;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{TERM} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
- $error = $new->rep($old);
+ $error = $new->SUPER::replace($old);
return $error if $error;
- my($old_dir,$new_dir)=( $old->getfield('dir'),$new->getfield('dir') );
- my($uid,$gid)=( $new->getfield('uid'), $new->getfield('gid') );
+ my ( $old_dir, $new_dir ) = ( $old->getfield('dir'), $new->getfield('dir') );
+ my ( $uid, $gid) = ( $new->getfield('uid'), $new->getfield('gid') );
if ( $old_dir
&& $new_dir
&& $old_dir ne $new_dir
=cut
sub suspend {
- my($old) = @_;
- my(%hash) = $old->hash;
+ my $self = shift;
+ my %hash = $self->hash;
unless ( $hash{_password} =~ /^\*SUSPENDED\* / ) {
$hash{_password} = '*SUSPENDED* '.$hash{_password};
- my($new) = create FS::svc_acct ( \%hash );
-# $new->replace($old);
- $new->rep($old); #to avoid password checking :)
+ my $new = new FS::svc_acct ( \%hash );
+ $new->replace($self);
} else {
''; #no error (already suspended)
}
-
}
=item unsuspend
=cut
sub unsuspend {
- my($old) = @_;
- my(%hash) = $old->hash;
+ my $self = shift;
+ my %hash = $self->hash;
if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
$hash{_password} = $1;
- my($new) = create FS::svc_acct ( \%hash );
-# $new->replace($old);
- $new->rep($old); #to avoid password checking :)
+ my $new = new FS::svc_acct ( \%hash );
+ $new->replace($self);
} else {
''; #no error (already unsuspended)
}
=cut
-# Usage: $error = $record -> cancel;
sub cancel {
''; #stub (no error) - taken care of in delete
}
=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";
=back
-=head1 BUGS
+=head1 VERSION
+
+$Id: svc_acct.pm,v 1.3 1998-12-29 11:59:52 ivan Exp $
-It doesn't properly override FS::Record yet.
+=head1 BUGS
The remote commands should be configurable.
-The create method should set defaults from part_svc (like the check method
+The new method should set defaults from part_svc (like the check method
sets fixed values).
+The bits which ssh should fork before doing so.
+
+The $recref stuff in sub check should be cleaned up.
+
=head1 SEE ALSO
L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
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.)
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
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;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new point of presence (if only it were that easy!). To add the
point of presence to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('svc_acct_pop')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('svc_acct_pop',$hashref);
-}
+sub table { 'svc_acct_pop'; }
=item insert
-Adds this point of presence to the databaes. If there is an error, returns the
+Adds this point of presence to the database. If there is an error, returns the
error, otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
-Currently unimplemented.
-
-=cut
-
-sub delete {
- my($self)=@_;
- return "Can't (yet) delete POPs!";
- #$self->del;
-}
+Removes this point of presence from the database.
=item replace OLD_RECORD
Replaces OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not an svc_acct_pop record!"
- unless $old->table eq "svc_acct_pop";
- return "Can't change popnum!"
- unless $old->getfield('popnum') eq $new->getfield('popnum');
- $new->check or
- $new->rep($old);
-}
-
=item check
Checks all fields to make sure this is a valid point of presence. If there is
=cut
sub check {
- my($self)=@_;
- return "Not a svc_acct_pop record!" unless $self->table eq "svc_acct_pop";
+ my $self = shift;
- my($error)=
$self->ut_numbern('popnum')
or $self->ut_text('city')
or $self->ut_text('state')
or $self->ut_number('ac')
or $self->ut_number('exch')
;
- return $error if $error;
-
- '';
}
=back
-=head1 BUGS
+=head1 VERSION
+
+$Id: svc_acct_pop.pm,v 1.2 1998-12-29 11:59:53 ivan Exp $
-It doesn't properly override FS::Record yet.
+=head1 BUGS
It should be renamed to part_pop.
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;
package FS::svc_acct_sm;
use strict;
-use vars qw(@ISA @EXPORT_OK $nossh_hack $conf $shellmachine @qmailmachines);
-use Exporter;
-use FS::Record qw(fields qsearch qsearchs);
+use vars qw( @ISA $nossh_hack $conf $shellmachine @qmailmachines );
+use FS::Record qw( fields qsearch qsearchs );
use FS::cust_svc;
use FS::SSH qw(ssh);
use FS::Conf;
-@ISA = qw(FS::Record Exporter);
-@EXPORT_OK = qw(fields);
+@ISA = qw( FS::Record );
#ask FS::UID to run this stuff for us later
$FS::UID::callback{'FS::svc_acct_sm'} = sub {
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;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new virtual mail alias. To add the virtual mail alias to the
database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('svc_acct_sm')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('svc_acct_sm',$hashref);
-
-}
+sub table { 'svc_acct_sm'; }
=item insert
=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.
package FS::svc_domain;
use strict;
-use vars qw(@ISA @EXPORT_OK $whois_hack $conf $mydomain $smtpmachine
+use vars qw( @ISA $whois_hack $conf $mydomain $smtpmachine
$tech_contact $from $to @nameservers @nameserver_ips @template
);
-use Exporter;
use Carp;
use Mail::Internet;
use Mail::Header;
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 {
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;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new domain. To add the domain to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('svc_domain')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('svc_domain',$hashref);
-
-}
+sub table { 'svc_domain'; }
=item insert
=cut
sub insert {
- my($self)=@_;
- my($error);
+ my $self = shift;
+ my $error;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{TERM} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
- $error=$self->check;
+ $error = $self->check;
return $error if $error;
return "Domain in use (here)"
- if qsearchs('svc_domain',{'domain'=> $self->domain } );
+ if qsearchs( 'svc_domain', { 'domain' => $self->domain } );
- my($whois)=(($self->_whois)[0]);
+ my $whois = ($self->_whois)[0];
return "Domain in use (see whois)"
if ( $self->action eq "N" && $whois !~ /^No match for/ );
return "Domain not found (see whois)"
if ( $self->action eq "M" && $whois =~ /^No match for/ );
- my($svcnum)=$self->getfield('svcnum');
- my($cust_svc);
+ my $svcnum = $self->svcnum;
+ my $cust_svc;
unless ( $svcnum ) {
- $cust_svc=create FS::cust_svc ( {
+ $cust_svc = new FS::cust_svc ( {
'svcnum' => $svcnum,
- 'pkgnum' => $self->getfield('pkgnum'),
- 'svcpart' => $self->getfield('svcpart'),
+ 'pkgnum' => $self->pkgnum,
+ 'svcpart' => $self->svcpart,
} );
- my($error) = $cust_svc->insert;
+ my $error = $cust_svc->insert;
return $error if $error;
- $svcnum = $self->setfield('svcnum',$cust_svc->getfield('svcnum'));
+ $svcnum = $self->setfield( 'svcnum', $cust_svc->svcnum );
}
- $error = $self->add;
- if ($error) {
- $cust_svc->del if $cust_svc;
+ $error = $self->SUPER::insert;
+ if ( $error ) {
+ $cust_svc->delete if $cust_svc;
return $error;
}
=cut
sub delete {
- my($self)=@_;
- my($error);
+ my $self = shift;
+ my $error;
- my($svcnum)=$self->getfield('svcnum');
+ my $svcnum = $self->svcnum;
- $error = $self->del;
+ $error = $self->delete;
return $error if $error;
- my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
- $error = $cust_svc->del;
+ my $cust_svc = qsearchs( 'cust_svc', { 'svcnum' => $svcnum } );
+ $error = $cust_svc->delete;
return $error if $error;
'';
=cut
sub replace {
- my($new,$old)=@_;
- my($error);
-
- return "(Old) Not a svc_domain record!" unless $old->table eq "svc_domain";
- return "Can't change svcnum!"
- unless $old->getfield('svcnum') eq $new->getfield('svcnum');
+ my ( $new, $old ) = ( shift, shift );
+ my $error;
return "Can't change domain - reorder."
if $old->getfield('domain') ne $new->getfield('domain');
- $error=$new->check;
- return $error if $error;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
-
- $error = $new->rep($old);
- return $error if $error;
-
- '';
+ $new->SUPER::replace($old);
}
=cut
sub check {
- my($self)=@_;
- return "Not a svc_domain record!" unless $self->table eq "svc_domain";
+ my $self = shift;
+
my($recref) = $self->hashref;
- $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum";
- $recref->{svcnum} = $1;
+ my $error;
+
+ $error =
+ $self->ut_numbern('svcnum')
+ ;
+ return $error if $error;
#get part_svc (and pkgnum)
my($svcpart,$pkgnum);
=cut
sub _whois {
- my($self)=@_;
- my($domain)=$self->domain;
+ my $self = shift;
+ my $domain = $self->domain;
return ( "No match for domain \"$domain\"." ) if $whois_hack;
- open(WHOIS,"whois do $domain |");
+ open(WHOIS, "whois do $domain |");
return <WHOIS>;
}
=cut
sub submit_internic {
- my($self)=@_;
+ my $self = shift;
- my($cust_pkg)=qsearchs('cust_pkg',{'pkgnum'=>$self->pkgnum});
+ my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
return unless $cust_pkg;
- my($cust_main)=qsearchs('cust_main',{'custnum'=>$cust_pkg->custnum});
+ my cust_main) = qsearchs( 'cust_main', { 'custnum' => $cust_pkg->custnum } );
return unless $cust_main;
- my(%subs)=(
+ my %subs = (
'action' => $self->action,
'purpose' => $self->purpose,
'domain' => $self->domain,
);
#yuck
- my(@xtemplate)=@template;
- my(@body);
- my($line);
- OLOOP: while ( defined($line = shift @xtemplate) ) {
+ my @xtemplate = @template;
+ my @body;
+ my $line;
+ OLOOP: while ( defined( $line = shift @xtemplate ) ) {
if ( $line =~ /^###LOOP###$/ ) {
my(@buffer);
- LOADBUF: while ( defined($line = shift @xtemplate) ) {
+ LOADBUF: while ( defined( $line = shift @xtemplate ) ) {
last LOADBUF if ( $line =~ /^###ENDLOOP###$/ );
push @buffer, $line;
}
- my(%lubs)=(
+ my %lubs = (
'address' => $cust_main->address2
? [ $cust_main->address1, $cust_main->address2 ]
: [ $cust_main->address1 ]
'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}};
} #OLOOP
- my($subject);
+ my $subject;
if ( $self->action eq "M" ) {
$subject = "MODIFY DOMAIN ". $self->domain;
- } elsif ($self->action eq "N" ) {
+ } elsif ( $self->action eq "N" ) {
$subject = "NEW DOMAIN ". $self->domain;
} else {
croak "submit_internic called with action ". $self->action;
}
- $ENV{SMTPHOSTS}=$smtpmachine;
- $ENV{MAILADDRESS}=$from;
- my($header)=Mail::Header->new( [
+ $ENV{SMTPHOSTS} = $smtpmachine;
+ $ENV{MAILADDRESS} = $from;
+ my $header = Mail::Header->new( [
"From: $from",
"To: $to",
"Sender: $from",
"Reply-To: $from",
- "Date: ". time2str("%a, %d %b %Y %X %z",time),
+ "Date: ". time2str("%a, %d %b %Y %X %z", time),
"Subject: $subject",
] );
=back
-=head1 BUGS
+=head1 VERSION
-It doesn't properly override FS::Record yet.
+$Id: svc_domain.pm,v 1.4 1998-12-29 11:59:55 ivan Exp $
+
+=head1 BUGS
All BIND/DNS fields should be included (and exported).
-All registries should be supported.
+Delete doesn't send a registration template.
-Not all configuration access is through FS::Conf!
+All registries should be supported.
Should change action to a real field.
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
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.)
use strict;
use vars qw(@ISA);
-use Exporter;
use FS::Record qw(fields qsearch qsearchs);
use FS::cust_svc;
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;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new example. To add the example to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- $proto->new('svc_table',$hashref);
-
-}
+sub table { 'table_name'; }
=item insert
=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
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
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);
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;
=over 4
-=item create HASHREF
+=item new HASHREF
Creates a new example. To add the example to the database, see L<"insert">.
=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
=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
=cut
-sub delete {
- my($self)=@_;
-
- $self->del;
-}
+# the delete method can be inherited from FS::Record
=item replace OLD_RECORD
=cut
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a table_name record!" unless $old->table eq "table_name";
-
- return "Can't change keyfield!"
- unless $old->getfield('keyfield') eq $new->getfield('keyfield');
-
- $new->check or
- $new->rep($old);
-}
-
+# the replace method can be inherited from FS::Record
=item check
Checks all fields to make sure this is a valid example. If there is
an error, returns the error, otherwise returns false. Called by the insert
-and repalce methods.
+and replace methods.
=cut
-sub check {
- my($self)=@_;
- return "Not a table_name record!" unless $self->table eq "table_name";
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+sub check {
+ my $self = shift;
''; #no error
}
=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 SEE ALSO
-L<FS::Record>
+L<FS::Record>, schema.html from the base documentation.
=head1 HISTORY
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
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
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;
=over 4
-=item create HASHREF
+=item new HASHREF
Create a new record. To add the record to the database, see L<"insert">.
=cut
-sub create {
- my($proto,$hashref)=@_;
-
- #now in FS::Record::new
- #my($field);
- #foreach $field (fields('type_pkgs')) {
- # $hashref->{$field}='' unless defined $hashref->{$field};
- #}
-
- $proto->new('type_pkgs',$hashref);
-
-}
+sub table { 'type_pkgs'; }
=item insert
Adds this record to the database. If there is an error, returns the error,
otherwise returns false.
-=cut
-
-sub insert {
- my($self)=@_;
-
- $self->check or
- $self->add;
-}
-
=item delete
Deletes this record from the database. If there is an error, returns the
error, otherwise returns false.
-=cut
-
-sub delete {
- my($self)=@_;
-
- $self->del;
-}
-
=item replace OLD_RECORD
Replaces OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
-=cut
-
-sub replace {
- my($new,$old)=@_;
- return "(Old) Not a type_pkgs record!" unless $old->table eq "type_pkgs";
-
- $new->check or
- $new->rep($old);
-}
-
=item check
Checks all fields to make sure this is a valid record. If there is an error,
=cut
sub check {
- my($self)=@_;
- return "Not a type_pkgs record!" unless $self->table eq "type_pkgs";
- my($recref) = $self->hashref;
+ my $self = shift;
+
+ my $error =
+ $self->ut_number('typenum')
+ || $self->ut_number('pkgpart')
+ ;
+ return $error if $error;
- $recref->{typenum} =~ /^(\d+)$/ or return "Illegal typenum";
- $recref->{typenum} = $1;
return "Unknown typenum"
- unless qsearchs('agent_type',{'typenum'=>$recref->{typenum}});
+ unless qsearchs( 'agent_type', { 'typenum' => $self->typenum } );
- $recref->{pkgpart} =~ /^(\d+)$/ or return "Illegal pkgpart";
- $recref->{pkgpart} = $1;
return "Unknown pkgpart"
- unless qsearchs('part_pkg',{'pkgpart'=>$recref->{pkgpart}});
+ unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
''; #no error
}
=back
+=head1 VERSION
+
+$Id: type_pkgs.pm,v 1.2 1998-12-29 11:59:58 ivan Exp $
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<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
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;
projects / freeside.git / commitdiff