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     # or new FS::pkg_svc ( { 'pkgpart'  => $cust_pkg->pkgpart,
 163     #                        'svcpart'  => $self->svcpart,
 164     #                        'quantity' => 0                   } );
 165
 166     my @cust_svc = qsearch('cust_svc', {
 167       'pkgnum'  => $self->pkgnum,
 168       'svcpart' => $self->svcpart,
 169     });
 170     return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
 171            " services for pkgnum ". $self->pkgnum
 172       if scalar(@cust_svc) >= $pkg_svc->quantity;
 173   }
 174
 175   ''; #no error
 176 }
 177
 178 =item part_svc
 179
 180 Returns the definition for this service, as a FS::part_svc object (see
 181 L<FS::part_svc>).
 182
 183 =cut
 184
 185 sub part_svc {
 186   my $self = shift;
 187   $self->{'_svcpart'}
 188     ? $self->{'_svcpart'}
 189     : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 190 }
 191
 192 =item cust_pkg
 193
 194 Returns the definition for this service, as a FS::part_svc object (see
 195 L<FS::part_svc>).
 196
 197 =cut
 198
 199 sub cust_pkg {
 200   my $self = shift;
 201   qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 202 }
 203
 204 =item label
 205
 206 Returns a list consisting of:
 207 - The name of this service (from part_svc)
 208 - A meaningful identifier (username, domain, or mail alias)
 209 - The table name (i.e. svc_domain) for this service
 210
 211 =cut
 212
 213 sub label {
 214   my $self = shift;
 215   my $svcdb = $self->part_svc->svcdb;
 216   my $svc_x = $self->svc_x
 217     or die "can't find $svcdb.svcnum ". $self->svcnum;
 218   my $tag;
 219   if ( $svcdb eq 'svc_acct' ) {
 220     $tag = $svc_x->email;
 221   } elsif ( $svcdb eq 'svc_acct_sm' ) {
 222     my $domuser = $svc_x->domuser eq '*' ? '(anything)' : $svc_x->domuser;
 223     my $svc_domain = qsearchs ( 'svc_domain', { 'svcnum' => $svc_x->domsvc } );
 224     my $domain = $svc_domain->domain;
 225     $tag = "$domuser\@$domain";
 226   } elsif ( $svcdb eq 'svc_forward' ) {
 227     my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->srcsvc } );
 228     $tag = $svc_acct->email. '->';
 229     if ( $svc_x->dstsvc ) {
 230       $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->dstsvc } );
 231       $tag .= $svc_acct->email;
 232     } else {
 233       $tag .= $svc_x->dst;
 234     }
 235   } elsif ( $svcdb eq 'svc_domain' ) {
 236     $tag = $svc_x->getfield('domain');
 237   } elsif ( $svcdb eq 'svc_www' ) {
 238     my $domain = qsearchs( 'domain_record', { 'recnum' => $svc_x->recnum } );
 239     $tag = $domain->reczone;
 240   } else {
 241     cluck "warning: asked for label of unsupported svcdb; using svcnum";
 242     $tag = $svc_x->getfield('svcnum');
 243   }
 244   $self->part_svc->svc, $tag, $svcdb;
 245 }
 246
 247 =item svc_x
 248
 249 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
 250 FS::svc_domain object, etc.)
 251
 252 =cut
 253
 254 sub svc_x {
 255   my $self = shift;
 256   my $svcdb = $self->part_svc->svcdb;
 257   if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
 258     $self->{'_svc_acct'};
 259   } else {
 260     qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
 261   }
 262 }
 263
 264 =item seconds_since TIMESTAMP
 265
 266 See L<FS::svc_acct/seconds_since>.  Equivalent to
 267 $cust_svc->svc_x->seconds_since, but more efficient.  Meaningless for records
 268 where B<svcdb> is not "svc_acct".
 269
 270 =cut
 271
 272 #note: implementation here, POD in FS::svc_acct
 273 sub seconds_since {
 274   my($self, $since) = @_;
 275   my $dbh = dbh;
 276   my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
 277                               WHERE svcnum = ?
 278                                 AND login >= ?
 279                                 AND logout IS NOT NULL'
 280   ) or die $dbh->errstr;
 281   $sth->execute($self->svcnum, $since) or die $sth->errstr;
 282   $sth->fetchrow_arrayref->[0];
 283 }
 284
 285 =back
 286
 287 =head1 VERSION
 288
 289 $Id: cust_svc.pm,v 1.14 2002-04-20 02:06:38 ivan Exp $
 290
 291 =head1 BUGS
 292
 293 Behaviour of changing the svcpart of cust_svc records is undefined and should
 294 possibly be prohibited, and pkg_svc records are not checked.
 295
 296 pkg_svc records are not checked in general (here).
 297
 298 Deleting this record doesn't check or delete the svc_* record associated
 299 with this record.
 300
 301 =head1 SEE ALSO
 302
 303 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
 304 schema.html from the base documentation
 305
 306 =cut
 307
 308 1;
 309