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