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 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 =item check
  98
  99 Checks all fields to make sure this is a valid service.  If there is an error,
 100 returns the error, otehrwise returns false.  Called by the insert and
 101 replace methods.
 102
 103 =cut
 104
 105 sub check {
 106   my $self = shift;
 107
 108   my $error =
 109     $self->ut_numbern('svcnum')
 110     || $self->ut_numbern('pkgnum')
 111     || $self->ut_number('svcpart')
 112   ;
 113   return $error if $error;
 114
 115   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 116   return "Unknown svcpart" unless $part_svc;
 117
 118   if ( $self->pkgnum ) {
 119     my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 120     return "Unknown pkgnum" unless $cust_pkg;
 121     my $pkg_svc = qsearchs( 'pkg_svc', {
 122       'pkgpart' => $cust_pkg->pkgpart,
 123       'svcpart' => $self->svcpart,
 124     });
 125     my @cust_svc = qsearch('cust_svc', {
 126       'pkgnum'  => $self->pkgnum,
 127       'svcpart' => $self->svcpart,
 128     });
 129     return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
 130            " services for pkgnum ". $self->pkgnum
 131       if $pkg_svc->quantity >= scalar(@cust_svc);
 132   }
 133
 134   ''; #no error
 135 }
 136
 137 =item part_svc
 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 part_svc {
 145   my $self = shift;
 146   $self->{'_svcpart'}
 147     ? $self->{'_svcpart'}
 148     : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 149 }
 150
 151 =item cust_pkg
 152
 153 Returns the definition for this service, as a FS::part_svc object (see
 154 L<FS::part_svc>).
 155
 156 =cut
 157
 158 sub cust_pkg {
 159   my $self = shift;
 160   qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 161 }
 162
 163 =item label
 164
 165 Returns a list consisting of:
 166 - The name of this service (from part_svc)
 167 - A meaningful identifier (username, domain, or mail alias)
 168 - The table name (i.e. svc_domain) for this service
 169
 170 =cut
 171
 172 sub label {
 173   my $self = shift;
 174   my $svcdb = $self->part_svc->svcdb;
 175   my $svc_x = $self->svc_x
 176     or die "can't find $svcdb.svcnum ". $self->svcnum;
 177   my $tag;
 178   if ( $svcdb eq 'svc_acct' ) {
 179     $tag = $svc_x->email;
 180   } elsif ( $svcdb eq 'svc_acct_sm' ) {
 181     my $domuser = $svc_x->domuser eq '*' ? '(anything)' : $svc_x->domuser;
 182     my $svc_domain = qsearchs ( 'svc_domain', { 'svcnum' => $svc_x->domsvc } );
 183     my $domain = $svc_domain->domain;
 184     $tag = "$domuser\@$domain";
 185   } elsif ( $svcdb eq 'svc_forward' ) {
 186     my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->srcsvc } );
 187     $tag = $svc_acct->email. '->';
 188     if ( $svc_x->dstsvc ) {
 189       $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->dstsvc } );
 190       $tag .= $svc_acct->email;
 191     } else {
 192       $tag .= $svc_x->dst;
 193     }
 194   } elsif ( $svcdb eq 'svc_domain' ) {
 195     $tag = $svc_x->getfield('domain');
 196   } elsif ( $svcdb eq 'svc_www' ) {
 197     my $domain = qsearchs( 'domain_record', { 'recnum' => $svc_x->recnum } );
 198     $tag = $domain->reczone;
 199   } else {
 200     cluck "warning: asked for label of unsupported svcdb; using svcnum";
 201     $tag = $svc_x->getfield('svcnum');
 202   }
 203   $self->part_svc->svc, $tag, $svcdb;
 204 }
 205
 206 =item svc_x
 207
 208 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
 209 FS::svc_domain object, etc.)
 210
 211 =cut
 212
 213 sub svc_x {
 214   my $self = shift;
 215   my $svcdb = $self->part_svc->svcdb;
 216   if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
 217     $self->{'_svc_acct'};
 218   } else {
 219     qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
 220   }
 221 }
 222
 223 =item seconds_since TIMESTAMP
 224
 225 See L<FS::svc_acct/seconds_since>.  Equivalent to
 226 $cust_svc->svc_x->seconds_since, but more efficient.  Meaningless for records
 227 where B<svcdb> is not "svc_acct".
 228
 229 =cut
 230
 231 #note: implementation here, POD in FS::svc_acct
 232 sub seconds_since {
 233   my($self, $since) = @_;
 234   my $dbh = dbh;
 235   my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
 236                               WHERE svcnum = ?
 237                                 AND login >= ?
 238                                 AND logout IS NOT NULL'
 239   ) or die $dbh->errstr;
 240   $sth->execute($self->svcnum, $since) or die $sth->errstr;
 241   $sth->fetchrow_arrayref->[0];
 242 }
 243
 244 =back
 245
 246 =head1 VERSION
 247
 248 $Id: cust_svc.pm,v 1.10 2002-02-09 17:45:26 ivan Exp $
 249
 250 =head1 BUGS
 251
 252 Behaviour of changing the svcpart of cust_svc records is undefined and should
 253 possibly be prohibited, and pkg_svc records are not checked.
 254
 255 pkg_svc records are not checked in general (here).
 256
 257 Deleting this record doesn't check or delete the svc_* record associated
 258 with this record.
 259
 260 =head1 SEE ALSO
 261
 262 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
 263 schema.html from the base documentation
 264
 265 =cut
 266
 267 1;
 268