site_perl/cust_svc.pm

   1 package FS::cust_svc;
   2
   3 use strict;
   4 use vars qw(@ISA);
   5 use Carp;
   6 use Exporter;
   7 use FS::Record qw(fields qsearchs);
   8 use FS::cust_pkg;
   9 use FS::part_pkg;
  10 use FS::part_svc;
  11 use FS::svc_acct;
  12 use FS::svc_acct_sm;
  13 use FS::svc_domain;
  14
  15 @ISA = qw(FS::Record Exporter);
  16
  17 =head1 NAME
  18
  19 FS::cust_svc - Object method for cust_svc objects
  20
  21 =head1 SYNOPSIS
  22
  23   use FS::cust_svc;
  24
  25   $record = create FS::cust_svc \%hash
  26   $record = create FS::cust_svc { 'column' => 'value' };
  27
  28   $error = $record->insert;
  29
  30   $error = $new_record->replace($old_record);
  31
  32   $error = $record->delete;
  33
  34   $error = $record->check;
  35
  36   ($label, $value) = $record->label;
  37
  38 =head1 DESCRIPTION
  39
  40 An FS::cust_svc represents a service.  FS::cust_svc inherits from FS::Record.
  41 The following fields are currently supported:
  42
  43 =over 4
  44
  45 =item svcnum - primary key (assigned automatically for new services)
  46
  47 =item pkgnum - Package (see L<FS::cust_pkg>)
  48
  49 =item svcpart - Service definition (see L<FS::part_svc>)
  50
  51 =back
  52
  53 =head1 METHODS
  54
  55 =over 4
  56
  57 =item create HASHREF
  58
  59 Creates a new service.  To add the refund to the database, see L<"insert">.
  60 Services are normally created by creating FS::svc_ objects (see
  61 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_acct_sm>, among others).
  62
  63 =cut
  64
  65 sub create {
  66   my($proto,$hashref)=@_;
  67
  68   #now in FS::Record::new
  69   #my($field);
  70   #foreach $field (fields('cust_svc')) {
  71   #  $hashref->{$field}='' unless defined $hashref->{$field};
  72   #}
  73
  74   $proto->new('cust_svc',$hashref);
  75 }
  76
  77 =item insert
  78
  79 Adds this service to the database.  If there is an error, returns the error,
  80 otherwise returns false.
  81
  82 =cut
  83
  84 sub insert {
  85   my($self)=@_;
  86
  87   $self->check or
  88   $self->add;
  89 }
  90
  91 =item delete
  92
  93 Deletes this service from the database.  If there is an error, returns the
  94 error, otherwise returns false.
  95
  96 Called by the cancel method of the package (see L<FS::cust_pkg>).
  97
  98 =cut
  99
 100 sub delete {
 101   my($self)=@_;
 102   # anything else here?
 103   $self->del;
 104 }
 105
 106 =item replace OLD_RECORD
 107
 108 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 109 returns the error, otherwise returns false.
 110
 111 =cut
 112
 113 sub replace {
 114   my($new,$old)=@_;
 115   return "(Old) Not a cust_svc record!" unless $old->table eq "cust_svc";
 116   return "Can't change svcnum!"
 117     unless $old->getfield('svcnum') eq $new->getfield('svcnum');
 118   $new->check or
 119   $new->rep($old);
 120 }
 121
 122 =item check
 123
 124 Checks all fields to make sure this is a valid service.  If there is an error,
 125 returns the error, otehrwise returns false.  Called by the insert and
 126 replace methods.
 127
 128 =cut
 129
 130 sub check {
 131   my($self)=@_;
 132   return "Not a cust_svc record!" unless $self->table eq "cust_svc";
 133   my($recref) = $self->hashref;
 134
 135   $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum";
 136   $recref->{svcnum}=$1;
 137
 138   $recref->{pkgnum} =~ /^(\d*)$/ or return "Illegal pkgnum";
 139   $recref->{pkgnum}=$1;
 140   return "Unknown pkgnum" unless
 141     ! $recref->{pkgnum} ||
 142     qsearchs('cust_pkg',{'pkgnum'=>$recref->{pkgnum}});
 143
 144   $recref->{svcpart} =~ /^(\d+)$/ or return "Illegal svcpart";
 145   $recref->{svcpart}=$1;
 146   return "Unknown svcpart" unless
 147     qsearchs('part_svc',{'svcpart'=>$recref->{svcpart}});
 148
 149   ''; #no error
 150 }
 151
 152 =item label
 153
 154 Returns a list consisting of:
 155 - The name of this service (from part_svc)
 156 - A meaningful identifier (username, domain, or mail alias)
 157 - The table name (i.e. svc_domain) for this service
 158
 159 =cut
 160
 161 sub label {
 162   my($self)=@_;
 163   my($part_svc) = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 164   my($svcdb) = $part_svc->svcdb;
 165   my($svc_x) = qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
 166   my($svc) = $part_svc->svc;
 167   my($tag);
 168   if ( $svcdb eq 'svc_acct' ) {
 169     $tag = $svc_x->getfield('username');
 170   } elsif ( $svcdb eq 'svc_acct_sm' ) {
 171     my $domuser = $svc_x->domuser eq '*' ? '(anything)' : $svc_x->domuser;
 172     my $svc_domain = qsearchs ( 'svc_domain', { 'svcnum' => $svc_x->domsvc } );
 173     my $domain = $svc_domain->domain;
 174     $tag = "$domuser\@$domain";
 175   } elsif ( $svcdb eq 'svc_domain' ) {
 176     return $svc, $svc_x->getfield('domain');
 177   } else {
 178     carp "warning: asked for label of unsupported svcdb; using svcnum";
 179     $tag = $svc_x->getfield('svcnum');
 180   }
 181   $svc, $tag, $svcdb;
 182 }
 183
 184 =back
 185
 186 =head1 BUGS
 187
 188 Behaviour of changing the svcpart of cust_svc records is undefined and should
 189 possibly be prohibited, and pkg_svc records are not checked.
 190
 191 pkg_svc records are not checked in general (here).
 192
 193 =head1 SEE ALSO
 194
 195 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
 196 schema.html from the base documentation
 197
 198 =head1 HISTORY
 199
 200 ivan@voicenet.com 97-jul-10,14
 201
 202 no TableUtil, no FS::Lock ivan@sisd.com 98-mar-7
 203
 204 pod ivan@sisd.com 98-sep-21
 205
 206 $Log: cust_svc.pm,v $
 207 Revision 1.4  1998-11-12 07:58:15  ivan
 208 added svcdb to label
 209
 210 Revision 1.3  1998/11/12 03:45:38  ivan
 211 use FS::table_name for all tables qsearch()'ed
 212
 213 Revision 1.2  1998/11/12 03:32:46  ivan
 214 added label method
 215
 216
 217 =cut
 218
 219 1;
 220