FS/FS/part_svc.pm

   1 package FS::part_svc;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG );
   5 use FS::Record qw( qsearch qsearchs fields dbh );
   6 use FS::Schema qw( dbdef );
   7 use FS::part_svc_column;
   8 use FS::part_export;
   9 use FS::export_svc;
  10 use FS::cust_svc;
  11
  12 @ISA = qw(FS::Record);
  13
  14 $DEBUG = 1;
  15
  16 =head1 NAME
  17
  18 FS::part_svc - Object methods for part_svc objects
  19
  20 =head1 SYNOPSIS
  21
  22   use FS::part_svc;
  23
  24   $record = new FS::part_svc \%hash
  25   $record = new FS::part_svc { 'column' => 'value' };
  26
  27   $error = $record->insert;
  28   $error = $record->insert( [ 'pseudofield' ] );
  29   $error = $record->insert( [ 'pseudofield' ], \%exportnums );
  30
  31   $error = $new_record->replace($old_record);
  32   $error = $new_record->replace($old_record, '1.3-COMPAT', [ 'pseudofield' ] );
  33   $error = $new_record->replace($old_record, '1.3-COMPAT', [ 'pseudofield' ], \%exportnums );
  34
  35   $error = $record->delete;
  36
  37   $error = $record->check;
  38
  39 =head1 DESCRIPTION
  40
  41 An FS::part_svc represents a service definition.  FS::part_svc inherits from
  42 FS::Record.  The following fields are currently supported:
  43
  44 =over 4
  45
  46 =item svcpart - primary key (assigned automatically for new service definitions)
  47
  48 =item svc - text name of this service definition
  49
  50 =item svcdb - table used for this service.  See L<FS::svc_acct>,
  51 L<FS::svc_domain>, and L<FS::svc_forward>, among others.
  52
  53 =item disabled - Disabled flag, empty or `Y'
  54
  55 =back
  56
  57 =head1 METHODS
  58
  59 =over 4
  60
  61 =item new HASHREF
  62
  63 Creates a new service definition.  To add the service definition to the
  64 database, see L<"insert">.
  65
  66 =cut
  67
  68 sub table { 'part_svc'; }
  69
  70 =item insert [ EXTRA_FIELDS_ARRAYREF [ , EXPORTNUMS_HASHREF [ , JOB ] ] ]
  71
  72 Adds this service definition to the database.  If there is an error, returns
  73 the error, otherwise returns false.
  74
  75 The following pseudo-fields may be defined, and will be maintained in
  76 the part_svc_column table appropriately (see L<FS::part_svc_column>).
  77
  78 =over 4
  79
  80 =item I<svcdb>__I<field> - Default or fixed value for I<field> in I<svcdb>.
  81
  82 =item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null, `D' for default, or `F' for fixed.  For virtual fields, can also be 'X' for excluded.
  83
  84 =back
  85
  86 If you want to add part_svc_column records for fields that do not exist as
  87 (real or virtual) fields in the I<svcdb> table, make sure to list then in
  88 EXTRA_FIELDS_ARRAYREF also.
  89
  90 If EXPORTNUMS_HASHREF is specified (keys are exportnums and values are
  91 boolean), the appopriate export_svc records will be inserted.
  92
  93 TODOC: JOB
  94
  95 =cut
  96
  97 sub insert {
  98   my $self = shift;
  99   my @fields = ();
 100   my @exportnums = ();
 101   @fields = @{shift(@_)} if @_;
 102   if ( @_ ) {
 103     my $exportnums = shift;
 104     @exportnums = grep $exportnums->{$_}, keys %$exportnums;
 105   }
 106   my $job = '';
 107   $job = shift if @_;
 108
 109   local $SIG{HUP} = 'IGNORE';
 110   local $SIG{INT} = 'IGNORE';
 111   local $SIG{QUIT} = 'IGNORE';
 112   local $SIG{TERM} = 'IGNORE';
 113   local $SIG{TSTP} = 'IGNORE';
 114   local $SIG{PIPE} = 'IGNORE';
 115
 116   my $oldAutoCommit = $FS::UID::AutoCommit;
 117   local $FS::UID::AutoCommit = 0;
 118   my $dbh = dbh;
 119
 120   my $error = $self->SUPER::insert;
 121   if ( $error ) {
 122     $dbh->rollback if $oldAutoCommit;
 123     return $error;
 124   }
 125
 126   # add part_svc_column records
 127
 128   my $svcdb = $self->svcdb;
 129 #  my @rows = map { /^${svcdb}__(.*)$/; $1 }
 130 #    grep ! /_flag$/,
 131 #      grep /^${svcdb}__/,
 132 #        fields('part_svc');
 133   foreach my $field (
 134     grep { $_ ne 'svcnum'
 135            && defined( $self->getfield($svcdb.'__'.$_.'_flag') )
 136          } (fields($svcdb), @fields)
 137   ) {
 138     my $part_svc_column = $self->part_svc_column($field);
 139     my $previous = qsearchs('part_svc_column', {
 140       'svcpart'    => $self->svcpart,
 141       'columnname' => $field,
 142     } );
 143
 144     my $flag = $self->getfield($svcdb.'__'.$field.'_flag');
 145     if ( uc($flag) =~ /^([DFX])$/ ) {
 146       $part_svc_column->setfield('columnflag', $1);
 147       $part_svc_column->setfield('columnvalue',
 148         $self->getfield($svcdb.'__'.$field)
 149       );
 150       if ( $previous ) {
 151         $error = $part_svc_column->replace($previous);
 152       } else {
 153         $error = $part_svc_column->insert;
 154       }
 155     } else {
 156       $error = $previous ? $previous->delete : '';
 157     }
 158     if ( $error ) {
 159       $dbh->rollback if $oldAutoCommit;
 160       return $error;
 161     }
 162
 163   }
 164
 165   # add export_svc records
 166   my $slice = 100/scalar(@exportnums) if @exportnums;
 167   my $done = 0;
 168   foreach my $exportnum ( @exportnums ) {
 169     my $export_svc = new FS::export_svc ( {
 170       'exportnum' => $exportnum,
 171       'svcpart'   => $self->svcpart,
 172     } );
 173     $error = $export_svc->insert($job, $slice*$done++, $slice);
 174     if ( $error ) {
 175       $dbh->rollback if $oldAutoCommit;
 176       return $error;
 177     }
 178   }
 179
 180   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 181
 182   '';
 183 }
 184
 185 =item delete
 186
 187 Currently unimplemented.  Set the "disabled" field instead.
 188
 189 =cut
 190
 191 sub delete {
 192   return "Can't (yet?) delete service definitions.";
 193 # check & make sure the svcpart isn't in cust_svc or pkg_svc (in any packages)?
 194 }
 195
 196 =item replace OLD_RECORD [ '1.3-COMPAT' [ , EXTRA_FIELDS_ARRAYREF [ , EXPORTNUMS_HASHREF [ , JOB ] ] ] ]
 197
 198 Replaces OLD_RECORD with this one in the database.  If there is an error,
 199 returns the error, otherwise returns false.
 200
 201 TODOC: 1.3-COMPAT
 202
 203 TODOC: EXTRA_FIELDS_ARRAYREF (same as insert method)
 204
 205 TODOC: JOB
 206
 207 =cut
 208
 209 sub replace {
 210   my ( $new, $old ) = ( shift, shift );
 211   my $compat = '';
 212   my @fields = ();
 213   my $exportnums;
 214   my $job = '';
 215   if ( @_ && $_[0] eq '1.3-COMPAT' ) {
 216     shift;
 217     $compat = '1.3';
 218     @fields = @{shift(@_)} if @_;
 219     $exportnums = @_ ? shift : '';
 220     $job = shift if @_;
 221   } else {
 222     return 'non-1.3-COMPAT interface not yet written';
 223     #not yet implemented
 224   }
 225
 226   return "Can't change svcdb for an existing service definition!"
 227     unless $old->svcdb eq $new->svcdb;
 228
 229   local $SIG{HUP} = 'IGNORE';
 230   local $SIG{INT} = 'IGNORE';
 231   local $SIG{QUIT} = 'IGNORE';
 232   local $SIG{TERM} = 'IGNORE';
 233   local $SIG{TSTP} = 'IGNORE';
 234   local $SIG{PIPE} = 'IGNORE';
 235
 236   my $oldAutoCommit = $FS::UID::AutoCommit;
 237   local $FS::UID::AutoCommit = 0;
 238   my $dbh = dbh;
 239
 240   my $error = $new->SUPER::replace( $old );
 241   if ( $error ) {
 242     $dbh->rollback if $oldAutoCommit;
 243     return $error;
 244   }
 245
 246   if ( $compat eq '1.3' ) {
 247
 248    # maintain part_svc_column records
 249
 250     my $svcdb = $new->svcdb;
 251     foreach my $field (
 252       grep { $_ ne 'svcnum'
 253              && defined( $new->getfield($svcdb.'__'.$_.'_flag') )
 254            } (fields($svcdb),@fields)
 255     ) {
 256       my $part_svc_column = $new->part_svc_column($field);
 257       my $previous = qsearchs('part_svc_column', {
 258         'svcpart'    => $new->svcpart,
 259         'columnname' => $field,
 260       } );
 261
 262       my $flag = $new->getfield($svcdb.'__'.$field.'_flag');
 263       if ( uc($flag) =~ /^([DFX])$/ ) {
 264         $part_svc_column->setfield('columnflag', $1);
 265         $part_svc_column->setfield('columnvalue',
 266           $new->getfield($svcdb.'__'.$field)
 267         );
 268         if ( $previous ) {
 269           $error = $part_svc_column->replace($previous);
 270         } else {
 271           $error = $part_svc_column->insert;
 272         }
 273       } else {
 274         $error = $previous ? $previous->delete : '';
 275       }
 276       if ( $error ) {
 277         $dbh->rollback if $oldAutoCommit;
 278         return $error;
 279       }
 280     }
 281
 282     # maintain export_svc records
 283
 284     if ( $exportnums ) {
 285
 286       #false laziness w/ edit/process/agent_type.cgi
 287       my @new_export_svc = ();
 288       foreach my $part_export ( qsearch('part_export', {}) ) {
 289         my $exportnum = $part_export->exportnum;
 290         my $hashref = {
 291           'exportnum' => $exportnum,
 292           'svcpart'   => $new->svcpart,
 293         };
 294         my $export_svc = qsearchs('export_svc', $hashref);
 295
 296         if ( $export_svc && ! $exportnums->{$exportnum} ) {
 297           $error = $export_svc->delete;
 298           if ( $error ) {
 299             $dbh->rollback if $oldAutoCommit;
 300             return $error;
 301           }
 302         } elsif ( ! $export_svc && $exportnums->{$exportnum} ) {
 303           push @new_export_svc, new FS::export_svc ( $hashref );
 304         }
 305
 306       }
 307
 308       my $slice = 100/scalar(@new_export_svc) if @new_export_svc;
 309       my $done = 0;
 310       foreach my $export_svc (@new_export_svc) {
 311         $error = $export_svc->insert($job, $slice*$done++, $slice);
 312         if ( $error ) {
 313           $dbh->rollback if $oldAutoCommit;
 314           return $error;
 315         }
 316         if ( $job ) {
 317           $error = $job->update_statustext( int( $slice * $done ) );
 318           if ( $error ) {
 319             $dbh->rollback if $oldAutoCommit;
 320             return $error;
 321           }
 322         }
 323       }
 324
 325     }
 326
 327   } else {
 328     $dbh->rollback if $oldAutoCommit;
 329     return 'non-1.3-COMPAT interface not yet written';
 330     #not yet implemented
 331   }
 332
 333   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 334
 335   '';
 336 }
 337
 338 =item check
 339
 340 Checks all fields to make sure this is a valid service definition.  If there is
 341 an error, returns the error, otherwise returns false.  Called by the insert
 342 and replace methods.
 343
 344 =cut
 345
 346 sub check {
 347   my $self = shift;
 348   my $recref = $self->hashref;
 349
 350   my $error;
 351   $error=
 352     $self->ut_numbern('svcpart')
 353     || $self->ut_text('svc')
 354     || $self->ut_alpha('svcdb')
 355     || $self->ut_enum('disabled', [ '', 'Y' ] )
 356   ;
 357   return $error if $error;
 358
 359   my @fields = eval { fields( $recref->{svcdb} ) }; #might die
 360   return "Unknown svcdb!" unless @fields;
 361
 362   $self->SUPER::check;
 363 }
 364
 365 =item part_svc_column COLUMNNAME
 366
 367 Returns the part_svc_column object (see L<FS::part_svc_column>) for the given
 368 COLUMNNAME, or a new part_svc_column object if none exists.
 369
 370 =cut
 371
 372 sub part_svc_column {
 373   my( $self, $columnname) = @_;
 374   $self->svcpart &&
 375     qsearchs('part_svc_column',  {
 376                                    'svcpart'    => $self->svcpart,
 377                                    'columnname' => $columnname,
 378                                  }
 379   ) or new FS::part_svc_column {
 380                                  'svcpart'    => $self->svcpart,
 381                                  'columnname' => $columnname,
 382                                };
 383 }
 384
 385 =item all_part_svc_column
 386
 387 =cut
 388
 389 sub all_part_svc_column {
 390   my $self = shift;
 391   qsearch('part_svc_column', { 'svcpart' => $self->svcpart } );
 392 }
 393
 394 =item part_export [ EXPORTTYPE ]
 395
 396 Returns a list of all exports (see L<FS::part_export>) for this service, or,
 397 if an export type is specified, only returns exports of the given type.
 398
 399 =cut
 400
 401 sub part_export {
 402   my $self = shift;
 403   my %search;
 404   $search{'exporttype'} = shift if @_;
 405   map { qsearchs('part_export', { 'exportnum' => $_->exportnum, %search } ) }
 406     qsearch('export_svc', { 'svcpart' => $self->svcpart } );
 407 }
 408
 409 =item part_export_usage
 410
 411 Returns a list of any exports (see L<FS::part_export>) for this service that
 412 are capable of reporting usage information.
 413
 414 =cut
 415
 416 sub part_export_usage {
 417   my $self = shift;
 418   grep $_->can('usage_sessions'), $self->part_export;
 419 }
 420
 421 =item cust_svc
 422
 423 Returns a list of associated FS::cust_svc records.
 424
 425 =cut
 426
 427 sub cust_svc {
 428   my $self = shift;
 429   qsearch('cust_svc', { 'svcpart' => $self->svcpart } );
 430 }
 431
 432 =item svc_x
 433
 434 Returns a list of associated FS::svc_* records.
 435
 436 =cut
 437
 438 sub svc_x {
 439   my $self = shift;
 440   map { $_->svc_x } $self->cust_svc;
 441 }
 442
 443 =back
 444
 445 =head1 SUBROUTINES
 446
 447 =over 4
 448
 449 =item process
 450
 451 Experimental job-queue processor for web interface adds/edits
 452
 453 =cut
 454
 455 use Storable qw(thaw);
 456 use Data::Dumper;
 457 use MIME::Base64;
 458 sub process {
 459   my $job = shift;
 460
 461   my $param = thaw(decode_base64(shift));
 462   warn Dumper($param) if $DEBUG;
 463
 464   my $old = qsearchs('part_svc', { 'svcpart' => $param->{'svcpart'} })
 465     if $param->{'svcpart'};
 466
 467   $param->{'svc_acct__usergroup'} =
 468     ref($param->{'svc_acct__usergroup'})
 469       ? join(',', @{$param->{'svc_acct__usergroup'}} )
 470       : '';
 471
 472   my $new = new FS::part_svc ( {
 473     map {
 474       $_ => $param->{$_};
 475   #  } qw(svcpart svc svcdb)
 476     } ( fields('part_svc'),
 477         map { my $svcdb = $_;
 478               my @fields = fields($svcdb);
 479               push @fields, 'usergroup' if $svcdb eq 'svc_acct'; #kludge
 480               map { ( $svcdb.'__'.$_, $svcdb.'__'.$_.'_flag' )  } @fields;
 481             } grep defined( dbdef->table($_) ),
 482                    qw( svc_acct svc_domain svc_forward svc_www svc_broadband )
 483       )
 484   } );
 485
 486   my %exportnums =
 487     map { $_->exportnum => ( $param->{'exportnum'.$_->exportnum} || '') }
 488         qsearch('part_export', {} );
 489
 490   my $error;
 491   if ( $param->{'svcpart'} ) {
 492     $error = $new->replace( $old,
 493                             '1.3-COMPAT',
 494                             [ 'usergroup' ],
 495                             \%exportnums,
 496                             $job
 497                           );
 498   } else {
 499     $error = $new->insert( [ 'usergroup' ],
 500                            \%exportnums,
 501                            $job,
 502                          );
 503     $param->{'svcpart'} = $new->getfield('svcpart');
 504   }
 505
 506   die $error if $error;
 507 }
 508
 509 =head1 BUGS
 510
 511 Delete is unimplemented.
 512
 513 The list of svc_* tables is hardcoded.  When svc_acct_pop is renamed, this
 514 should be fixed.
 515
 516 all_part_svc_column method should be documented
 517
 518 =head1 SEE ALSO
 519
 520 L<FS::Record>, L<FS::part_svc_column>, L<FS::part_pkg>, L<FS::pkg_svc>,
 521 L<FS::cust_svc>, L<FS::svc_acct>, L<FS::svc_forward>, L<FS::svc_domain>,
 522 schema.html from the base documentation.
 523
 524 =cut
 525
 526 1;
 527