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_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.  Note that this only removes the cust_svc
  88 record - you should probably use the B<cancel> method instead.
  89
  90 =item cancel
  91
  92 Cancels the relevant service by calling the B<cancel> method of the associated
  93 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
  94 deleting the FS::svc_XXX record and then deleting this record.
  95
  96 If there is an error, returns the error, otherwise returns false.
  97
  98 =cut
  99
 100 sub cancel {
 101   my $self = shift;
 102
 103   local $SIG{HUP} = 'IGNORE';
 104   local $SIG{INT} = 'IGNORE';
 105   local $SIG{QUIT} = 'IGNORE';
 106   local $SIG{TERM} = 'IGNORE';
 107   local $SIG{TSTP} = 'IGNORE';
 108   local $SIG{PIPE} = 'IGNORE';
 109
 110   my $oldAutoCommit = $FS::UID::AutoCommit;
 111   local $FS::UID::AutoCommit = 0;
 112   my $dbh = dbh;
 113
 114   my $part_svc = $self->part_svc;
 115
 116   $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
 117     $dbh->rollback if $oldAutoCommit;
 118     return "Illegal svcdb value in part_svc!";
 119   };
 120   my $svcdb = $1;
 121   require "FS/$svcdb.pm";
 122
 123   my $svc = $self->svc_x;
 124   if ($svc) {
 125     my $error = $svc->cancel;
 126     if ( $error ) {
 127       $dbh->rollback if $oldAutoCommit;
 128       return "Error canceling service: $error";
 129     }
 130     $error = $svc->delete;
 131     if ( $error ) {
 132       $dbh->rollback if $oldAutoCommit;
 133       return "Error deleting service: $error";
 134     }
 135   }
 136
 137   my $error = $self->delete;
 138   if ( $error ) {
 139     $dbh->rollback if $oldAutoCommit;
 140     return "Error deleting cust_svc: $error";
 141   }
 142
 143   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 144
 145   ''; #no errors
 146
 147 }
 148
 149 =item replace OLD_RECORD
 150
 151 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 152 returns the error, otherwise returns false.
 153
 154 =cut
 155
 156 sub replace {
 157   my ( $new, $old ) = ( shift, shift );
 158
 159   local $SIG{HUP} = 'IGNORE';
 160   local $SIG{INT} = 'IGNORE';
 161   local $SIG{QUIT} = 'IGNORE';
 162   local $SIG{TERM} = 'IGNORE';
 163   local $SIG{TSTP} = 'IGNORE';
 164   local $SIG{PIPE} = 'IGNORE';
 165
 166   my $oldAutoCommit = $FS::UID::AutoCommit;
 167   local $FS::UID::AutoCommit = 0;
 168   my $dbh = dbh;
 169
 170   my $error = $new->SUPER::replace($old);
 171   if ( $error ) {
 172     $dbh->rollback if $oldAutoCommit;
 173     return $error if $error;
 174   }
 175
 176   if ( $new->svcpart != $old->svcpart ) {
 177     my $svc_x = $new->svc_x;
 178     my $new_svc_x = ref($svc_x)->new({$svc_x->hash});
 179     my $error = $new_svc_x->replace($svc_x);
 180     if ( $error ) {
 181       $dbh->rollback if $oldAutoCommit;
 182       return $error if $error;
 183     }
 184   }
 185
 186   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 187   ''; #no error
 188
 189 }
 190
 191 =item check
 192
 193 Checks all fields to make sure this is a valid service.  If there is an error,
 194 returns the error, otehrwise returns false.  Called by the insert and
 195 replace methods.
 196
 197 =cut
 198
 199 sub check {
 200   my $self = shift;
 201
 202   my $error =
 203     $self->ut_numbern('svcnum')
 204     || $self->ut_numbern('pkgnum')
 205     || $self->ut_number('svcpart')
 206   ;
 207   return $error if $error;
 208
 209   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 210   return "Unknown svcpart" unless $part_svc;
 211
 212   if ( $self->pkgnum ) {
 213     my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 214     return "Unknown pkgnum" unless $cust_pkg;
 215     my $pkg_svc = qsearchs( 'pkg_svc', {
 216       'pkgpart' => $cust_pkg->pkgpart,
 217       'svcpart' => $self->svcpart,
 218     });
 219     # or new FS::pkg_svc ( { 'pkgpart'  => $cust_pkg->pkgpart,
 220     #                        'svcpart'  => $self->svcpart,
 221     #                        'quantity' => 0                   } );
 222
 223     my @cust_svc = qsearch('cust_svc', {
 224       'pkgnum'  => $self->pkgnum,
 225       'svcpart' => $self->svcpart,
 226     });
 227     return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
 228            " services for pkgnum ". $self->pkgnum
 229       if scalar(@cust_svc) >= $pkg_svc->quantity;
 230   }
 231
 232   ''; #no error
 233 }
 234
 235 =item part_svc
 236
 237 Returns the definition for this service, as a FS::part_svc object (see
 238 L<FS::part_svc>).
 239
 240 =cut
 241
 242 sub part_svc {
 243   my $self = shift;
 244   $self->{'_svcpart'}
 245     ? $self->{'_svcpart'}
 246     : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 247 }
 248
 249 =item cust_pkg
 250
 251 Returns the definition for this service, as a FS::part_svc object (see
 252 L<FS::part_svc>).
 253
 254 =cut
 255
 256 sub cust_pkg {
 257   my $self = shift;
 258   qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 259 }
 260
 261 =item label
 262
 263 Returns a list consisting of:
 264 - The name of this service (from part_svc)
 265 - A meaningful identifier (username, domain, or mail alias)
 266 - The table name (i.e. svc_domain) for this service
 267
 268 =cut
 269
 270 sub label {
 271   my $self = shift;
 272   my $svcdb = $self->part_svc->svcdb;
 273   my $svc_x = $self->svc_x
 274     or die "can't find $svcdb.svcnum ". $self->svcnum;
 275   my $tag;
 276   if ( $svcdb eq 'svc_acct' ) {
 277     $tag = $svc_x->email;
 278   } elsif ( $svcdb eq 'svc_forward' ) {
 279     my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->srcsvc } );
 280     $tag = $svc_acct->email. '->';
 281     if ( $svc_x->dstsvc ) {
 282       $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->dstsvc } );
 283       $tag .= $svc_acct->email;
 284     } else {
 285       $tag .= $svc_x->dst;
 286     }
 287   } elsif ( $svcdb eq 'svc_domain' ) {
 288     $tag = $svc_x->getfield('domain');
 289   } elsif ( $svcdb eq 'svc_www' ) {
 290     my $domain = qsearchs( 'domain_record', { 'recnum' => $svc_x->recnum } );
 291     $tag = $domain->reczone;
 292   } elsif ( $svcdb eq 'svc_broadband' ) {
 293     $tag = $svc_x->ip_addr . '/' . $svc_x->ip_netmask;
 294   } else {
 295     cluck "warning: asked for label of unsupported svcdb; using svcnum";
 296     $tag = $svc_x->getfield('svcnum');
 297   }
 298   $self->part_svc->svc, $tag, $svcdb;
 299 }
 300
 301 =item svc_x
 302
 303 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
 304 FS::svc_domain object, etc.)
 305
 306 =cut
 307
 308 sub svc_x {
 309   my $self = shift;
 310   my $svcdb = $self->part_svc->svcdb;
 311   if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
 312     $self->{'_svc_acct'};
 313   } else {
 314     qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
 315   }
 316 }
 317
 318 =item seconds_since TIMESTAMP
 319
 320 See L<FS::svc_acct/seconds_since>.  Equivalent to
 321 $cust_svc->svc_x->seconds_since, but more efficient.  Meaningless for records
 322 where B<svcdb> is not "svc_acct".
 323
 324 =cut
 325
 326 #note: implementation here, POD in FS::svc_acct
 327 sub seconds_since {
 328   my($self, $since) = @_;
 329   my $dbh = dbh;
 330   my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
 331                               WHERE svcnum = ?
 332                                 AND login >= ?
 333                                 AND logout IS NOT NULL'
 334   ) or die $dbh->errstr;
 335   $sth->execute($self->svcnum, $since) or die $sth->errstr;
 336   $sth->fetchrow_arrayref->[0];
 337 }
 338
 339 =back
 340
 341 =head1 VERSION
 342
 343 $Id: cust_svc.pm,v 1.17 2002-09-18 22:39:01 ivan Exp $
 344
 345 =head1 BUGS
 346
 347 Behaviour of changing the svcpart of cust_svc records is undefined and should
 348 possibly be prohibited, and pkg_svc records are not checked.
 349
 350 pkg_svc records are not checked in general (here).
 351
 352 Deleting this record doesn't check or delete the svc_* record associated
 353 with this record.
 354
 355 =head1 SEE ALSO
 356
 357 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
 358 schema.html from the base documentation
 359
 360 =cut
 361
 362 1;
 363