FS/FS/cust_svc.pm

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