FS/FS/part_svc.pm

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