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 pretty-printed label and value for this service, i.e. `username' and
 155 `foobar' or `domain' and `foo.bar'.
 156
 157 =cut
 158
 159 sub label {
 160   my($self)=@_;
 161   my($part_svc) = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 162   my($svcdb) = $part_svc->svcdb;
 163   my($svc) = qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
 164   if ( $svcdb eq 'svc_acct' ) {
 165     return 'username', $svc->getfield('username');
 166   } elsif ( $svcdb eq 'svc_acct_sm' ) {
 167     my $domuser = $svc->domuser eq '*' ? '(anything)' : $svc->domuser;
 168     my $svc_domain = qsearchs ( 'svc_domain', { 'svcnum' => $svc->domsvc } );
 169     my $domain = $svc_domain->domain;
 170     return 'email', "$domuser\@$domain";
 171   } elsif ( $svcdb eq 'svc_domain' ) {
 172     return 'domain', $svc->getfield('domain');
 173   } else {
 174     carp "warning: asked for label of unsupported svcdb; using svcnum";
 175     return 'svcnum', $svc->getfield('svcnum');
 176   }
 177
 178 }
 179
 180 =back
 181
 182 =head1 BUGS
 183
 184 Behaviour of changing the svcpart of cust_svc records is undefined and should
 185 possibly be prohibited, and pkg_svc records are not checked.
 186
 187 pkg_svc records are not checked in general (here).
 188
 189 =head1 SEE ALSO
 190
 191 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
 192 schema.html from the base documentation
 193
 194 =head1 HISTORY
 195
 196 ivan@voicenet.com 97-jul-10,14
 197
 198 no TableUtil, no FS::Lock ivan@sisd.com 98-mar-7
 199
 200 pod ivan@sisd.com 98-sep-21
 201
 202 $Log: cust_svc.pm,v $
 203 Revision 1.3  1998-11-12 03:45:38  ivan
 204 use FS::table_name for all tables qsearch()'ed
 205
 206 Revision 1.2  1998/11/12 03:32:46  ivan
 207 added label method
 208
 209
 210 =cut
 211
 212 1;
 213