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( qsearch qsearchs dbh );
   7 use FS::cust_pkg;
   8 use FS::part_pkg;
   9 use FS::part_svc;
  10 use FS::pkg_svc;
  11 use FS::svc_acct;
  12 use FS::svc_acct_sm;
  13 use FS::svc_domain;
  14 use FS::svc_forward;
  15 use FS::domain_record;
  16
  17 @ISA = qw( FS::Record );
  18
  19 sub _cache {
  20   my $self = shift;
  21   my ( $hashref, $cache ) = @_;
  22   if ( $hashref->{'username'} ) {
  23     $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
  24   }
  25   if ( $hashref->{'svc'} ) {
  26     $self->{'_svcpart'} = FS::part_svc->new($hashref);
  27   }
  28 }
  29
  30 =head1 NAME
  31
  32 FS::cust_svc - Object method for cust_svc objects
  33
  34 =head1 SYNOPSIS
  35
  36   use FS::cust_svc;
  37
  38   $record = new FS::cust_svc \%hash
  39   $record = new FS::cust_svc { 'column' => 'value' };
  40
  41   $error = $record->insert;
  42
  43   $error = $new_record->replace($old_record);
  44
  45   $error = $record->delete;
  46
  47   $error = $record->check;
  48
  49   ($label, $value) = $record->label;
  50
  51 =head1 DESCRIPTION
  52
  53 An FS::cust_svc represents a service.  FS::cust_svc inherits from FS::Record.
  54 The following fields are currently supported:
  55
  56 =over 4
  57
  58 =item svcnum - primary key (assigned automatically for new services)
  59
  60 =item pkgnum - Package (see L<FS::cust_pkg>)
  61
  62 =item svcpart - Service definition (see L<FS::part_svc>)
  63
  64 =back
  65
  66 =head1 METHODS
  67
  68 =over 4
  69
  70 =item new HASHREF
  71
  72 Creates a new service.  To add the refund to the database, see L<"insert">.
  73 Services are normally created by creating FS::svc_ objects (see
  74 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
  75
  76 =cut
  77
  78 sub table { 'cust_svc'; }
  79
  80 =item insert
  81
  82 Adds this service to the database.  If there is an error, returns the error,
  83 otherwise returns false.
  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 =item replace OLD_RECORD
  93
  94 Replaces the OLD_RECORD with this one in the database.  If there is an error,
  95 returns the error, otherwise returns false.
  96
  97 =cut
  98
  99 sub replace {
 100   my ( $new, $old ) = ( shift, shift );
 101
 102   local $SIG{HUP} = 'IGNORE';
 103   local $SIG{INT} = 'IGNORE';
 104   local $SIG{QUIT} = 'IGNORE';
 105   local $SIG{TERM} = 'IGNORE';
 106   local $SIG{TSTP} = 'IGNORE';
 107   local $SIG{PIPE} = 'IGNORE';
 108
 109   my $oldAutoCommit = $FS::UID::AutoCommit;
 110   local $FS::UID::AutoCommit = 0;
 111   my $dbh = dbh;
 112
 113   my $error = $new->SUPER::replace($old);
 114   if ( $error ) {
 115     $dbh->rollback if $oldAutoCommit;
 116     return $error if $error;
 117   }
 118
 119   if ( $new->svcpart != $old->svcpart ) {
 120     my $svc_x = $new->svc_x;
 121     my $new_svc_x = ref($svc_x)->new({$svc_x->hash});
 122     my $error = $new_svc_x->replace($svc_x);
 123     if ( $error ) {
 124       $dbh->rollback if $oldAutoCommit;
 125       return $error if $error;
 126     }
 127   }
 128
 129   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 130   ''; #no error
 131
 132 }
 133
 134 =item check
 135
 136 Checks all fields to make sure this is a valid service.  If there is an error,
 137 returns the error, otehrwise returns false.  Called by the insert and
 138 replace methods.
 139
 140 =cut
 141
 142 sub check {
 143   my $self = shift;
 144
 145   my $error =
 146     $self->ut_numbern('svcnum')
 147     || $self->ut_numbern('pkgnum')
 148     || $self->ut_number('svcpart')
 149   ;
 150   return $error if $error;
 151
 152   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 153   return "Unknown svcpart" unless $part_svc;
 154
 155   if ( $self->pkgnum ) {
 156     my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 157     return "Unknown pkgnum" unless $cust_pkg;
 158     my $pkg_svc = qsearchs( 'pkg_svc', {
 159       'pkgpart' => $cust_pkg->pkgpart,
 160       'svcpart' => $self->svcpart,
 161     });
 162     my @cust_svc = qsearch('cust_svc', {
 163       'pkgnum'  => $self->pkgnum,
 164       'svcpart' => $self->svcpart,
 165     });
 166     return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
 167            " services for pkgnum ". $self->pkgnum
 168       if scalar(@cust_svc) >= $pkg_svc->quantity;
 169   }
 170
 171   ''; #no error
 172 }
 173
 174 =item part_svc
 175
 176 Returns the definition for this service, as a FS::part_svc object (see
 177 L<FS::part_svc>).
 178
 179 =cut
 180
 181 sub part_svc {
 182   my $self = shift;
 183   $self->{'_svcpart'}
 184     ? $self->{'_svcpart'}
 185     : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 186 }
 187
 188 =item cust_pkg
 189
 190 Returns the definition for this service, as a FS::part_svc object (see
 191 L<FS::part_svc>).
 192
 193 =cut
 194
 195 sub cust_pkg {
 196   my $self = shift;
 197   qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 198 }
 199
 200 =item label
 201
 202 Returns a list consisting of:
 203 - The name of this service (from part_svc)
 204 - A meaningful identifier (username, domain, or mail alias)
 205 - The table name (i.e. svc_domain) for this service
 206
 207 =cut
 208
 209 sub label {
 210   my $self = shift;
 211   my $svcdb = $self->part_svc->svcdb;
 212   my $svc_x = $self->svc_x
 213     or die "can't find $svcdb.svcnum ". $self->svcnum;
 214   my $tag;
 215   if ( $svcdb eq 'svc_acct' ) {
 216     $tag = $svc_x->email;
 217   } elsif ( $svcdb eq 'svc_acct_sm' ) {
 218     my $domuser = $svc_x->domuser eq '*' ? '(anything)' : $svc_x->domuser;
 219     my $svc_domain = qsearchs ( 'svc_domain', { 'svcnum' => $svc_x->domsvc } );
 220     my $domain = $svc_domain->domain;
 221     $tag = "$domuser\@$domain";
 222   } elsif ( $svcdb eq 'svc_forward' ) {
 223     my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->srcsvc } );
 224     $tag = $svc_acct->email. '->';
 225     if ( $svc_x->dstsvc ) {
 226       $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->dstsvc } );
 227       $tag .= $svc_acct->email;
 228     } else {
 229       $tag .= $svc_x->dst;
 230     }
 231   } elsif ( $svcdb eq 'svc_domain' ) {
 232     $tag = $svc_x->getfield('domain');
 233   } elsif ( $svcdb eq 'svc_www' ) {
 234     my $domain = qsearchs( 'domain_record', { 'recnum' => $svc_x->recnum } );
 235     $tag = $domain->reczone;
 236   } else {
 237     cluck "warning: asked for label of unsupported svcdb; using svcnum";
 238     $tag = $svc_x->getfield('svcnum');
 239   }
 240   $self->part_svc->svc, $tag, $svcdb;
 241 }
 242
 243 =item svc_x
 244
 245 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
 246 FS::svc_domain object, etc.)
 247
 248 =cut
 249
 250 sub svc_x {
 251   my $self = shift;
 252   my $svcdb = $self->part_svc->svcdb;
 253   if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
 254     $self->{'_svc_acct'};
 255   } else {
 256     qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
 257   }
 258 }
 259
 260 =item seconds_since TIMESTAMP
 261
 262 See L<FS::svc_acct/seconds_since>.  Equivalent to
 263 $cust_svc->svc_x->seconds_since, but more efficient.  Meaningless for records
 264 where B<svcdb> is not "svc_acct".
 265
 266 =cut
 267
 268 #note: implementation here, POD in FS::svc_acct
 269 sub seconds_since {
 270   my($self, $since) = @_;
 271   my $dbh = dbh;
 272   my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
 273                               WHERE svcnum = ?
 274                                 AND login >= ?
 275                                 AND logout IS NOT NULL'
 276   ) or die $dbh->errstr;
 277   $sth->execute($self->svcnum, $since) or die $sth->errstr;
 278   $sth->fetchrow_arrayref->[0];
 279 }
 280
 281 =back
 282
 283 =head1 VERSION
 284
 285 $Id: cust_svc.pm,v 1.13 2002-04-12 15:14:58 ivan Exp $
 286
 287 =head1 BUGS
 288
 289 Behaviour of changing the svcpart of cust_svc records is undefined and should
 290 possibly be prohibited, and pkg_svc records are not checked.
 291
 292 pkg_svc records are not checked in general (here).
 293
 294 Deleting this record doesn't check or delete the svc_* record associated
 295 with this record.
 296
 297 =head1 SEE ALSO
 298
 299 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
 300 schema.html from the base documentation
 301
 302 =cut
 303
 304 1;
 305