X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=site_perl%2Fcust_svc.pm;h=f97f5fe9da42882dcbd10f44fd29799ebdecaad5;hp=6f5b276a0f64ffe4e87e9e3388e52ebf8c650285;hb=f892887626d5d6288e455768d24b5bcaff646123;hpb=982671e7e45dae36861152f1c320017c08dd15f9 diff --git a/site_perl/cust_svc.pm b/site_perl/cust_svc.pm index 6f5b276a0..f97f5fe9d 100644 --- a/site_perl/cust_svc.pm +++ b/site_perl/cust_svc.pm @@ -1,10 +1,9 @@ package FS::cust_svc; use strict; -use vars qw(@ISA); -use Carp; -use Exporter; -use FS::Record qw(fields qsearchs); +use vars qw( @ISA ); +use Carp qw( cluck ); +use FS::Record qw( qsearchs ); use FS::cust_pkg; use FS::part_pkg; use FS::part_svc; @@ -12,7 +11,7 @@ use FS::svc_acct; use FS::svc_acct_sm; use FS::svc_domain; -@ISA = qw(FS::Record Exporter); +@ISA = qw( FS::Record ); =head1 NAME @@ -22,8 +21,8 @@ FS::cust_svc - Object method for cust_svc objects use FS::cust_svc; - $record = create FS::cust_svc \%hash - $record = create FS::cust_svc { 'column' => 'value' }; + $record = new FS::cust_svc \%hash + $record = new FS::cust_svc { 'column' => 'value' }; $error = $record->insert; @@ -54,7 +53,7 @@ The following fields are currently supported: =over 4 -=item create HASHREF +=item new HASHREF Creates a new service. To add the refund to the database, see L<"insert">. Services are normally created by creating FS::svc_ objects (see @@ -62,32 +61,13 @@ L, L, and L, among others). =cut -sub create { - my($proto,$hashref)=@_; - - #now in FS::Record::new - #my($field); - #foreach $field (fields('cust_svc')) { - # $hashref->{$field}='' unless defined $hashref->{$field}; - #} - - $proto->new('cust_svc',$hashref); -} +sub table { 'cust_svc'; } =item insert Adds this service to the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub insert { - my($self)=@_; - - $self->check or - $self->add; -} - =item delete Deletes this service from the database. If there is an error, returns the @@ -95,30 +75,11 @@ error, otherwise returns false. Called by the cancel method of the package (see L). -=cut - -sub delete { - my($self)=@_; - # anything else here? - $self->del; -} - =item replace OLD_RECORD Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. -=cut - -sub replace { - my($new,$old)=@_; - return "(Old) Not a cust_svc record!" unless $old->table eq "cust_svc"; - return "Can't change svcnum!" - unless $old->getfield('svcnum') eq $new->getfield('svcnum'); - $new->check or - $new->rep($old); -} - =item check Checks all fields to make sure this is a valid service. If there is an error, @@ -128,57 +89,63 @@ replace methods. =cut sub check { - my($self)=@_; - return "Not a cust_svc record!" unless $self->table eq "cust_svc"; - my($recref) = $self->hashref; + my $self = shift; - $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum"; - $recref->{svcnum}=$1; + my $error = + $self->ut_numbern('svcnum') + || $self->ut_numbern('pkgnum') + || $self->ut_number('svcpart') + ; + return $error if $error; - $recref->{pkgnum} =~ /^(\d*)$/ or return "Illegal pkgnum"; - $recref->{pkgnum}=$1; - return "Unknown pkgnum" unless - ! $recref->{pkgnum} || - qsearchs('cust_pkg',{'pkgnum'=>$recref->{pkgnum}}); + return "Unknown pkgnum" + unless ! $self->pkgnum + || qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); - $recref->{svcpart} =~ /^(\d+)$/ or return "Illegal svcpart"; - $recref->{svcpart}=$1; return "Unknown svcpart" unless - qsearchs('part_svc',{'svcpart'=>$recref->{svcpart}}); + qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); ''; #no error } =item label -Returns a pretty-printed label and value for this service, i.e. `username' and -`foobar' or `domain' and `foo.bar'. +Returns a list consisting of: +- The name of this service (from part_svc) +- A meaningful identifier (username, domain, or mail alias) +- The table name (i.e. svc_domain) for this service =cut sub label { - my($self)=@_; - my($part_svc) = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); - my($svcdb) = $part_svc->svcdb; - my($svc) = qsearchs( $svcdb, { 'svcnum' => $self->svcnum } ); + 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' ) { - return 'username', $svc->getfield('username'); + $tag = $svc_x->getfield('username'); } elsif ( $svcdb eq 'svc_acct_sm' ) { - my $domuser = $svc->domuser eq '*' ? '(anything)' : $svc->domuser; - my $svc_domain = qsearchs ( 'svc_domain', { 'svcnum' => $svc->domsvc } ); + my $domuser = $svc_x->domuser eq '*' ? '(anything)' : $svc_x->domuser; + my $svc_domain = qsearchs ( 'svc_domain', { 'svcnum' => $svc_x->domsvc } ); my $domain = $svc_domain->domain; - return 'email', "$domuser\@$domain"; + $tag = "$domuser\@$domain"; } elsif ( $svcdb eq 'svc_domain' ) { - return 'domain', $svc->getfield('domain'); + $tag = $svc_x->getfield('domain'); } else { - carp "warning: asked for label of unsupported svcdb; using svcnum"; - return 'svcnum', $svc->getfield('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 @@ -186,6 +153,9 @@ possibly be prohibited, and pkg_svc records are not checked. pkg_svc records are not checked in general (here). +Deleting this record doesn't check or delete the svc_* record associated +with this record. + =head1 SEE ALSO L, L, L, L, @@ -200,7 +170,13 @@ no TableUtil, no FS::Lock ivan@sisd.com 98-mar-7 pod ivan@sisd.com 98-sep-21 $Log: cust_svc.pm,v $ -Revision 1.3 1998-11-12 03:45:38 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 use FS::table_name for all tables qsearch()'ed Revision 1.2 1998/11/12 03:32:46 ivan