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