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