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 label
 138
 139 Returns a list consisting of:
 140 - The name of this service (from part_svc)
 141 - A meaningful identifier (username, domain, or mail alias)
 142 - The table name (i.e. svc_domain) for this service
 143
 144 =cut
 145
 146 sub label {
 147   my $self = shift;
 148   my $svcdb = $self->part_svc->svcdb;
 149   my $svc_x;
 150   if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
 151     $svc_x = $self->{'_svc_acct'};
 152   } else {
 153     $svc_x = qsearchs( $svcdb, { 'svcnum' => $self->svcnum } )
 154       or die "can't find $svcdb.svcnum ". $self->svcnum;
 155   }
 156   my $tag;
 157   if ( $svcdb eq 'svc_acct' ) {
 158     $tag = $svc_x->email;
 159   } elsif ( $svcdb eq 'svc_acct_sm' ) {
 160     my $domuser = $svc_x->domuser eq '*' ? '(anything)' : $svc_x->domuser;
 161     my $svc_domain = qsearchs ( 'svc_domain', { 'svcnum' => $svc_x->domsvc } );
 162     my $domain = $svc_domain->domain;
 163     $tag = "$domuser\@$domain";
 164   } elsif ( $svcdb eq 'svc_forward' ) {
 165     my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->srcsvc } );
 166     $tag = $svc_acct->email. '->';
 167     if ( $svc_x->dstsvc ) {
 168       $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->dstsvc } );
 169       $tag .= $svc_acct->email;
 170     } else {
 171       $tag .= $svc_x->dst;
 172     }
 173   } elsif ( $svcdb eq 'svc_domain' ) {
 174     $tag = $svc_x->getfield('domain');
 175   } else {
 176     cluck "warning: asked for label of unsupported svcdb; using svcnum";
 177     $tag = $svc_x->getfield('svcnum');
 178   }
 179   $self->part_svc->svc, $tag, $svcdb;
 180 }
 181
 182 =back
 183
 184 =head1 VERSION
 185
 186 $Id: cust_svc.pm,v 1.6 2001-11-03 17:49:52 ivan Exp $
 187
 188 =head1 BUGS
 189
 190 Behaviour of changing the svcpart of cust_svc records is undefined and should
 191 possibly be prohibited, and pkg_svc records are not checked.
 192
 193 pkg_svc records are not checked in general (here).
 194
 195 Deleting this record doesn't check or delete the svc_* record associated
 196 with this record.
 197
 198 =head1 SEE ALSO
 199
 200 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
 201 schema.html from the base documentation
 202
 203 =cut
 204
 205 1;
 206