FS/FS/part_svc.pm

   1 package FS::part_svc;
   2 use base qw(FS::Record);
   3
   4 use strict;
   5 use vars qw( $DEBUG );
   6 use Tie::IxHash;
   7 use FS::Record qw( qsearch qsearchs fields dbh );
   8 use FS::Schema qw( dbdef );
   9 use FS::part_svc_column;
  10 use FS::part_export;
  11 use FS::export_svc;
  12 use FS::cust_svc;
  13 use FS::part_svc_class;
  14
  15 $DEBUG = 0;
  16
  17 =head1 NAME
  18
  19 FS::part_svc - Object methods for part_svc objects
  20
  21 =head1 SYNOPSIS
  22
  23   use FS::part_svc;
  24
  25   $record = new FS::part_svc \%hash
  26   $record = new FS::part_svc { 'column' => 'value' };
  27
  28   $error = $record->insert;
  29   $error = $record->insert( [ 'pseudofield' ] );
  30   $error = $record->insert( [ 'pseudofield' ], \%exportnums );
  31
  32   $error = $new_record->replace($old_record);
  33   $error = $new_record->replace($old_record, '1.3-COMPAT', [ 'pseudofield' ] );
  34   $error = $new_record->replace($old_record, '1.3-COMPAT', [ 'pseudofield' ], \%exportnums );
  35
  36   $error = $record->delete;
  37
  38   $error = $record->check;
  39
  40 =head1 DESCRIPTION
  41
  42 An FS::part_svc represents a service definition.  FS::part_svc inherits from
  43 FS::Record.  The following fields are currently supported:
  44
  45 =over 4
  46
  47 =item svcpart - primary key (assigned automatically for new service definitions)
  48
  49 =item svc - text name of this service definition
  50
  51 =item svcdb - table used for this service.  See L<FS::svc_acct>,
  52 L<FS::svc_domain>, and L<FS::svc_forward>, among others.
  53
  54 =item classnum - Optional service class (see L<FS::svc_class>)
  55
  56 =item disabled - Disabled flag, empty or `Y'
  57
  58 =item preserve - Preserve after cancellation, empty or 'Y'
  59
  60 =item selfservice_access - Access allowed to the service via self-service:
  61 empty for full access, "readonly" for read-only, "hidden" to hide it entirely
  62
  63 =item restrict_edit_password - Require the "Provision customer service" access
  64 right to change the password field, rather than just "Edit password".  Only
  65 relevant to svc_acct for now.
  66
  67 =item has_router - Allow the service to have an L<FS::router> connected
  68 through it.  Probably only relevant to svc_broadband, svc_acct, and svc_dsl
  69 for now.
  70
  71 =back
  72
  73 =head1 METHODS
  74
  75 =over 4
  76
  77 =item new HASHREF
  78
  79 Creates a new service definition.  To add the service definition to the
  80 database, see L<"insert">.
  81
  82 =cut
  83
  84 sub table { 'part_svc'; }
  85
  86 =item insert [ EXTRA_FIELDS_ARRAYREF [ , EXPORTNUMS_HASHREF [ , JOB ] ] ]
  87
  88 Adds this service definition to the database.  If there is an error, returns
  89 the error, otherwise returns false.
  90
  91 The following pseudo-fields may be defined, and will be maintained in
  92 the part_svc_column table appropriately (see L<FS::part_svc_column>).
  93
  94 =over 4
  95
  96 =item I<svcdb>__I<field> - Default or fixed value for I<field> in I<svcdb>.
  97
  98 =item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null or empty (no default), `D' for default, `F' for fixed (unchangeable), , `S' for selectable choice, `M' for manual selection from inventory, or `A' for automatic selection from inventory.  For virtual fields, can also be 'X' for excluded.
  99
 100 =back
 101
 102 If you want to add part_svc_column records for fields that do not exist as
 103 fields in the I<svcdb> table, make sure to list then in
 104 EXTRA_FIELDS_ARRAYREF also.
 105
 106 If EXPORTNUMS_HASHREF is specified (keys are exportnums and values are
 107 boolean), the appopriate export_svc records will be inserted.
 108
 109 TODOC: JOB
 110
 111 =cut
 112
 113 sub insert {
 114   my $self = shift;
 115   my @fields = ();
 116   my @exportnums = ();
 117   @fields = @{shift(@_)} if @_;
 118   if ( @_ ) {
 119     my $exportnums = shift;
 120     @exportnums = grep $exportnums->{$_}, keys %$exportnums;
 121   }
 122   my $job = '';
 123   $job = shift if @_;
 124
 125   local $SIG{HUP} = 'IGNORE';
 126   local $SIG{INT} = 'IGNORE';
 127   local $SIG{QUIT} = 'IGNORE';
 128   local $SIG{TERM} = 'IGNORE';
 129   local $SIG{TSTP} = 'IGNORE';
 130   local $SIG{PIPE} = 'IGNORE';
 131
 132   my $oldAutoCommit = $FS::UID::AutoCommit;
 133   local $FS::UID::AutoCommit = 0;
 134   my $dbh = dbh;
 135
 136   my $error = $self->SUPER::insert;
 137   if ( $error ) {
 138     $dbh->rollback if $oldAutoCommit;
 139     return $error;
 140   }
 141
 142   # add part_svc_column records
 143
 144   my $svcdb = $self->svcdb;
 145 #  my @rows = map { /^${svcdb}__(.*)$/; $1 }
 146 #    grep ! /_flag$/,
 147 #      grep /^${svcdb}__/,
 148 #        fields('part_svc');
 149   foreach my $field (
 150     grep { $_ ne 'svcnum'
 151            && ( defined( $self->getfield($svcdb.'__'.$_.'_flag') )
 152                 || $self->getfield($svcdb.'__'.$_.'_label') !~ /^\s*$/ )
 153          } (fields($svcdb), @fields)
 154   ) {
 155     my $part_svc_column = $self->part_svc_column($field);
 156     my $previous = qsearchs('part_svc_column', {
 157       'svcpart'    => $self->svcpart,
 158       'columnname' => $field,
 159     } );
 160
 161     my $flag  = $self->getfield($svcdb.'__'.$field.'_flag');
 162     my $label = $self->getfield($svcdb.'__'.$field.'_label');
 163     if ( uc($flag) =~ /^([A-Z])$/ || $label !~ /^\s*$/ ) {
 164
 165       if ( uc($flag) =~ /^([A-Z])$/ ) {
 166         my $parser = FS::part_svc->svc_table_fields($svcdb)->{$field}->{parse}
 167                      || sub { shift };
 168         $part_svc_column->setfield('columnflag', $1);
 169         $part_svc_column->setfield('columnvalue',
 170           &$parser($self->getfield($svcdb.'__'.$field))
 171         );
 172       }
 173
 174       $part_svc_column->setfield('columnlabel', $label)
 175         if $label !~ /^\s*$/;
 176
 177       if ( $previous ) {
 178         $error = $part_svc_column->replace($previous);
 179       } else {
 180         $error = $part_svc_column->insert;
 181       }
 182
 183     } else {
 184       $error = $previous ? $previous->delete : '';
 185     }
 186     if ( $error ) {
 187       $dbh->rollback if $oldAutoCommit;
 188       return $error;
 189     }
 190
 191   }
 192
 193   # add export_svc records
 194   my $slice = 100/scalar(@exportnums) if @exportnums;
 195   my $done = 0;
 196   foreach my $exportnum ( @exportnums ) {
 197     my $export_svc = new FS::export_svc ( {
 198       'exportnum' => $exportnum,
 199       'svcpart'   => $self->svcpart,
 200     } );
 201     $error = $export_svc->insert($job, $slice*$done++, $slice);
 202     if ( $error ) {
 203       $dbh->rollback if $oldAutoCommit;
 204       return $error;
 205     }
 206   }
 207
 208   # XXX shouldn't this update fixed values?
 209
 210   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 211
 212   '';
 213 }
 214
 215 =item delete
 216
 217 Currently unimplemented.  Set the "disabled" field instead.
 218
 219 =cut
 220
 221 sub delete {
 222   return "Can't (yet?) delete service definitions.";
 223 # check & make sure the svcpart isn't in cust_svc or pkg_svc (in any packages)?
 224 }
 225
 226 =item replace OLD_RECORD [ '1.3-COMPAT' [ , EXTRA_FIELDS_ARRAYREF [ , EXPORTNUMS_HASHREF [ , JOB ] ] ] ]
 227
 228 Replaces OLD_RECORD with this one in the database.  If there is an error,
 229 returns the error, otherwise returns false.
 230
 231 TODOC: 1.3-COMPAT
 232
 233 TODOC: EXTRA_FIELDS_ARRAYREF (same as insert method)
 234
 235 TODOC: JOB
 236
 237 =cut
 238
 239 sub replace {
 240   my ( $new, $old ) = ( shift, shift );
 241   my $compat = '';
 242   my @fields = ();
 243   my $exportnums;
 244   my $job = '';
 245   if ( @_ && $_[0] eq '1.3-COMPAT' ) {
 246     shift;
 247     $compat = '1.3';
 248     @fields = @{shift(@_)} if @_;
 249     $exportnums = @_ ? shift : '';
 250     $job = shift if @_;
 251   } else {
 252     return 'non-1.3-COMPAT interface not yet written';
 253     #not yet implemented
 254   }
 255
 256   return "Can't change svcdb for an existing service definition!"
 257     unless $old->svcdb eq $new->svcdb;
 258
 259   local $SIG{HUP} = 'IGNORE';
 260   local $SIG{INT} = 'IGNORE';
 261   local $SIG{QUIT} = 'IGNORE';
 262   local $SIG{TERM} = 'IGNORE';
 263   local $SIG{TSTP} = 'IGNORE';
 264   local $SIG{PIPE} = 'IGNORE';
 265
 266   my $oldAutoCommit = $FS::UID::AutoCommit;
 267   local $FS::UID::AutoCommit = 0;
 268   my $dbh = dbh;
 269
 270   my $error = $new->SUPER::replace( $old );
 271   if ( $error ) {
 272     $dbh->rollback if $oldAutoCommit;
 273     return $error;
 274   }
 275
 276   if ( $compat eq '1.3' ) {
 277
 278    # maintain part_svc_column records
 279
 280     my $svcdb = $new->svcdb;
 281     foreach my $field (
 282       grep { $_ ne 'svcnum'
 283              && ( defined( $new->getfield($svcdb.'__'.$_.'_flag') )
 284                   || $new->getfield($svcdb.'__'.$_.'_label') !~ /^\s*$/ )
 285            } (fields($svcdb),@fields)
 286     ) {
 287
 288       my $part_svc_column = $new->part_svc_column($field);
 289       my $previous = qsearchs('part_svc_column', {
 290         'svcpart'    => $new->svcpart,
 291         'columnname' => $field,
 292       } );
 293
 294       my $flag  = $new->getfield($svcdb.'__'.$field.'_flag');
 295       my $label = $new->getfield($svcdb.'__'.$field.'_label');
 296
 297       if ( uc($flag) =~ /^([A-Z])$/ || $label !~ /^\s*$/ ) {
 298
 299         if ( uc($flag) =~ /^([A-Z])$/ ) {
 300           $part_svc_column->setfield('columnflag', $1);
 301           my $parser = FS::part_svc->svc_table_fields($svcdb)->{$field}->{parse}
 302                      || sub { shift };
 303           $part_svc_column->setfield('columnvalue',
 304             &$parser($new->getfield($svcdb.'__'.$field))
 305           );
 306         } else {
 307           $part_svc_column->setfield('columnflag',  '');
 308           $part_svc_column->setfield('columnvalue', '');
 309         }
 310
 311         $part_svc_column->setfield('columnlabel', $label)
 312           if $label !~ /^\s*$/;
 313
 314         if ( $previous ) {
 315           $error = $part_svc_column->replace($previous);
 316         } else {
 317           $error = $part_svc_column->insert;
 318         }
 319       } else {
 320         $error = $previous ? $previous->delete : '';
 321       }
 322       if ( $error ) {
 323         $dbh->rollback if $oldAutoCommit;
 324         return $error;
 325       }
 326     }
 327
 328     # maintain export_svc records
 329
 330     if ( $exportnums ) {
 331
 332       #false laziness w/ edit/process/agent_type.cgi
 333       my @new_export_svc = ();
 334       foreach my $part_export ( qsearch('part_export', {}) ) {
 335         my $exportnum = $part_export->exportnum;
 336         my $hashref = {
 337           'exportnum' => $exportnum,
 338           'svcpart'   => $new->svcpart,
 339         };
 340         my $export_svc = qsearchs('export_svc', $hashref);
 341
 342         if ( $export_svc && ! $exportnums->{$exportnum} ) {
 343           $error = $export_svc->delete;
 344           if ( $error ) {
 345             $dbh->rollback if $oldAutoCommit;
 346             return $error;
 347           }
 348         } elsif ( ! $export_svc && $exportnums->{$exportnum} ) {
 349           push @new_export_svc, new FS::export_svc ( $hashref );
 350         }
 351
 352       }
 353
 354       my $slice = 100/scalar(@new_export_svc) if @new_export_svc;
 355       my $done = 0;
 356       foreach my $export_svc (@new_export_svc) {
 357         $error = $export_svc->insert($job, $slice*$done++, $slice);
 358         if ( $error ) {
 359           $dbh->rollback if $oldAutoCommit;
 360           return $error;
 361         }
 362         if ( $job ) {
 363           $error = $job->update_statustext( int( $slice * $done ) );
 364           if ( $error ) {
 365             $dbh->rollback if $oldAutoCommit;
 366             return $error;
 367           }
 368         }
 369       }
 370
 371     }
 372
 373   } else {
 374     $dbh->rollback if $oldAutoCommit;
 375     return 'non-1.3-COMPAT interface not yet written';
 376     #not yet implemented
 377   }
 378
 379   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 380
 381   '';
 382 }
 383
 384 =item check
 385
 386 Checks all fields to make sure this is a valid service definition.  If there is
 387 an error, returns the error, otherwise returns false.  Called by the insert
 388 and replace methods.
 389
 390 =cut
 391
 392 sub check {
 393   my $self = shift;
 394
 395   my $error;
 396   $error=
 397     $self->ut_numbern('svcpart')
 398     || $self->ut_text('svc')
 399     || $self->ut_alpha('svcdb')
 400     || $self->ut_flag('disabled')
 401     || $self->ut_flag('preserve')
 402     || $self->ut_enum('selfservice_access', [ '', 'hidden', 'readonly' ] )
 403     || $self->ut_foreign_keyn('classnum', 'part_svc_class', 'classnum' )
 404     || $self->ut_flag('restrict_edit_password')
 405     || $self->ut_flag('has_router')
 406 ;
 407   return $error if $error;
 408
 409   my @fields = eval { fields( $self->svcdb ) }; #might die
 410   return "Unknown svcdb: ". $self->svcdb. " (Error: $@)"
 411     unless @fields;
 412
 413   $self->SUPER::check;
 414 }
 415
 416 =item part_svc_column COLUMNNAME
 417
 418 Returns the part_svc_column object (see L<FS::part_svc_column>) for the given
 419 COLUMNNAME, or a new part_svc_column object if none exists.
 420
 421 =cut
 422
 423 sub part_svc_column {
 424   my( $self, $columnname) = @_;
 425   $self->svcpart &&
 426     qsearchs('part_svc_column',  {
 427                                    'svcpart'    => $self->svcpart,
 428                                    'columnname' => $columnname,
 429                                  }
 430   ) or new FS::part_svc_column {
 431                                  'svcpart'    => $self->svcpart,
 432                                  'columnname' => $columnname,
 433                                };
 434 }
 435
 436 =item all_part_svc_column
 437
 438 =cut
 439
 440 sub all_part_svc_column {
 441   my $self = shift;
 442   qsearch('part_svc_column', { 'svcpart' => $self->svcpart } );
 443 }
 444
 445 =item part_export [ EXPORTTYPE ]
 446
 447 Returns a list of all exports (see L<FS::part_export>) for this service, or,
 448 if an export type is specified, only returns exports of the given type.
 449
 450 =cut
 451
 452 sub part_export {
 453   my $self = shift;
 454   my %search;
 455   $search{'exporttype'} = shift if @_;
 456   map { $_ } #behavior of sort undefined in scalar context
 457     sort { $a->weight <=> $b->weight }
 458       map { qsearchs('part_export', { 'exportnum'=>$_->exportnum, %search } ) }
 459         qsearch('export_svc', { 'svcpart'=>$self->svcpart } );
 460 }
 461
 462 =item part_export_usage
 463
 464 Returns a list of any exports (see L<FS::part_export>) for this service that
 465 are capable of reporting usage information.
 466
 467 =cut
 468
 469 sub part_export_usage {
 470   my $self = shift;
 471   grep $_->can('usage_sessions'), $self->part_export;
 472 }
 473
 474 =item part_export_did
 475
 476 Returns a list of any exports (see L<FS::part_export>) for this service that
 477 are capable of returing available DID (phone number) information.
 478
 479 =cut
 480
 481 sub part_export_did {
 482   my $self = shift;
 483   grep $_->can_get_dids, $self->part_export;
 484 }
 485
 486 =item part_export_dsl_pull
 487
 488 Returns a list of any exports (see L<FS::part_export>) for this service that
 489 are capable of pulling/pushing DSL orders.
 490
 491 =cut
 492
 493 sub part_export_dsl_pull {
 494     my $self = shift;
 495     grep $_->can('dsl_pull'), $self->part_export;
 496 }
 497
 498 =item cust_svc [ PKGPART ]
 499
 500 Returns a list of associated customer services (FS::cust_svc records).
 501
 502 If a PKGPART is specified, returns the customer services which are contained
 503 within packages of that type (see L<FS::part_pkg>).  If PKGPARTis specified as
 504 B<0>, returns unlinked customer services.
 505
 506 =cut
 507
 508 sub cust_svc {
 509   my $self = shift;
 510
 511   my $hashref = { 'svcpart' => $self->svcpart };
 512
 513   my( $addl_from, $extra_sql ) = ( '', '' );
 514   if ( @_ ) {
 515     my $pkgpart = shift;
 516     if ( $pkgpart =~ /^(\d+)$/ ) {
 517       $addl_from = 'LEFT JOIN cust_pkg USING ( pkgnum )';
 518       $extra_sql = "AND pkgpart = $1";
 519     } elsif ( $pkgpart eq '0' ) {
 520       $hashref->{'pkgnum'} = '';
 521     }
 522   }
 523
 524   qsearch({
 525     'table'     => 'cust_svc',
 526     'addl_from' => $addl_from,
 527     'hashref'   => $hashref,
 528     'extra_sql' => $extra_sql,
 529   });
 530 }
 531
 532 =item num_cust_svc [ PKGPART ]
 533
 534 Returns the number of associated customer services (FS::cust_svc records).
 535
 536 If a PKGPART is specified, returns the number of customer services which are
 537 contained within packages of that type (see L<FS::part_pkg>).  If PKGPART
 538 is specified as B<0>, returns the number of unlinked customer services.
 539
 540 =cut
 541
 542 sub num_cust_svc {
 543   my $self = shift;
 544
 545   my @param = ( $self->svcpart );
 546
 547   my( $join, $and ) = ( '', '' );
 548   if ( @_ ) {
 549     my $pkgpart = shift;
 550     if ( $pkgpart ) {
 551       $join = 'LEFT JOIN cust_pkg USING ( pkgnum )';
 552       $and = 'AND pkgpart = ?';
 553       push @param, $pkgpart;
 554     } elsif ( $pkgpart eq '0' ) {
 555       $and = 'AND pkgnum IS NULL';
 556     }
 557   }
 558
 559   my $sth = dbh->prepare(
 560     "SELECT COUNT(*) FROM cust_svc $join WHERE svcpart = ? $and"
 561   ) or die dbh->errstr;
 562   $sth->execute(@param)
 563     or die $sth->errstr;
 564   $sth->fetchrow_arrayref->[0];
 565 }
 566
 567 =item svc_x
 568
 569 Returns a list of associated FS::svc_* records.
 570
 571 =cut
 572
 573 sub svc_x {
 574   my $self = shift;
 575   map { $_->svc_x } $self->cust_svc;
 576 }
 577
 578 =back
 579
 580 =head1 CLASS METHODS
 581
 582 =over 4
 583
 584 =cut
 585
 586 my $svc_defs;
 587 sub _svc_defs {
 588
 589   return $svc_defs if $svc_defs; #cache
 590
 591   my $conf = new FS::Conf;
 592
 593   #false laziness w/part_pkg.pm::plan_info
 594
 595   my %info;
 596   foreach my $INC ( @INC ) {
 597     warn "globbing $INC/FS/svc_*.pm\n" if $DEBUG;
 598     foreach my $file ( glob("$INC/FS/svc_*.pm") ) {
 599
 600       warn "attempting to load service table info from $file\n" if $DEBUG;
 601       $file =~ /\/(\w+)\.pm$/ or do {
 602         warn "unrecognized file in $INC/FS/: $file\n";
 603         next;
 604       };
 605       my $mod = $1;
 606
 607       if ( $mod =~ /^svc_[A-Z]/ or $mod =~ /^(svc_acct_pop|svc_export_machine)$/ ) {
 608         warn "skipping FS::$mod" if $DEBUG;
 609         next;
 610       }
 611
 612       eval "use FS::$mod;";
 613       if ( $@ ) {
 614         die "error using FS::$mod (skipping): $@\n" if $@;
 615         next;
 616       }
 617       unless ( UNIVERSAL::can("FS::$mod", 'table_info') ) {
 618         warn "FS::$mod has no table_info method; skipping";
 619         next;
 620       }
 621
 622       my $info = "FS::$mod"->table_info;
 623       unless ( keys %$info ) {
 624         warn "FS::$mod->table_info doesn't return info, skipping\n";
 625         next;
 626       }
 627       warn "got info from FS::$mod: $info\n" if $DEBUG;
 628       if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
 629         warn "skipping disabled service FS::$mod" if $DEBUG;
 630         next;
 631       }
 632       $info{$mod} = $info;
 633     }
 634   }
 635
 636   tie my %svc_defs, 'Tie::IxHash',
 637     map  { $_ => $info{$_}->{'fields'} }
 638     sort { $info{$a}->{'display_weight'} <=> $info{$b}->{'display_weight'} }
 639     keys %info,
 640   ;
 641
 642   $svc_defs = \%svc_defs; #cache
 643
 644 }
 645
 646 =item svc_tables
 647
 648 Returns a list of all svc_ tables.
 649
 650 =cut
 651
 652 sub svc_tables {
 653   my $class = shift;
 654   my $svc_defs = $class->_svc_defs;
 655   grep { defined( dbdef->table($_) ) } keys %$svc_defs;
 656 }
 657
 658 =item svc_table_fields TABLE
 659
 660 Given a table name, returns a hashref of field names.  The field names
 661 returned are those with additional (service-definition related) information,
 662 not necessarily all database fields of the table.  Pseudo-fields may also
 663 be returned (i.e. svc_acct.usergroup).
 664
 665 Each value of the hashref is another hashref, which can have one or more of
 666 the following keys:
 667
 668 =over 4
 669
 670 =item label - Description of the field
 671
 672 =item def_label - Optional description of the field in the context of service definitions
 673
 674 =item type - Currently "text", "select", "checkbox", "textarea", "disabled",
 675 some components specified by "select-.*.html", and a bunch more...
 676
 677 =item disable_default - This field should not allow a default value in service definitions
 678
 679 =item disable_fixed - This field should not allow a fixed value in service definitions
 680
 681 =item disable_inventory - This field should not allow inventory values in service definitions
 682
 683 =item select_list - If type is "text", this can be a listref of possible values.
 684
 685 =item select_table - An alternative to select_list, this defines a database table with the possible choices.
 686
 687 =item select_key - Used with select_table, this is the field name of keys
 688
 689 =item select_label - Used with select_table, this is the field name of labels
 690
 691 =back
 692
 693 =cut
 694
 695 #maybe this should move and be a class method in svc_Common.pm
 696 sub svc_table_fields {
 697   my($class, $table) = @_;
 698   my $svc_defs = $class->_svc_defs;
 699   my $def = $svc_defs->{$table};
 700
 701   foreach ( grep !ref($def->{$_}), keys %$def ) {
 702
 703     #normalize the shortcut in %info hash
 704     $def->{$_} = { 'label' => $def->{$_} };
 705
 706     $def->{$_}{'type'} ||= 'text';
 707
 708   }
 709
 710   $def;
 711 }
 712
 713 =back
 714
 715 =head1 SUBROUTINES
 716
 717 =over 4
 718
 719 =item process
 720
 721 Job-queue processor for web interface adds/edits
 722
 723 =cut
 724
 725 use Data::Dumper;
 726 sub process {
 727   my $job = shift;
 728   my $param = shift;
 729   warn Dumper($param) if $DEBUG;
 730
 731   my $old = qsearchs('part_svc', { 'svcpart' => $param->{'svcpart'} })
 732     if $param->{'svcpart'};
 733
 734   #unmunge cgp_accessmodes (falze laziness-ish w/edit/process/svc_acct.cgi)
 735   $param->{'svc_acct__cgp_accessmodes'} ||=
 736     join(' ', sort
 737       grep { $_ !~ /^(flag|label)$/ }
 738            map { /^svc_acct__cgp_accessmodes_([\w\/]+)$/ or die "no way"; $1; }
 739                grep $param->{$_},
 740                     grep /^svc_acct__cgp_accessmodes_([\w\/]+)$/,
 741                          keys %$param
 742         );
 743
 744
 745   my $new = new FS::part_svc ( {
 746     map {
 747       $_ => $param->{$_};
 748   #  } qw(svcpart svc svcdb)
 749     } ( fields('part_svc'),
 750         map { my $svcdb = $_;
 751               my @fields = fields($svcdb);
 752               push @fields, 'usergroup' if $svcdb eq 'svc_acct'
 753                                         or $svcdb eq 'svc_broadband'; #kludge
 754
 755               map {
 756                     my $f = $svcdb.'__'.$_;
 757                     my $flag = $param->{ $f.'_flag' } || ''; #silence warnings
 758                     if ( $flag =~ /^[MAH]$/ ) {
 759                       $param->{ $f } = delete( $param->{ $f.'_classnum' } );
 760                     }
 761                     if ( ( $flag =~ /^[MAHS]$/ or $_ eq 'usergroup' )
 762                          and ref($param->{ $f }) ) {
 763                       $param->{ $f } = join(',', @{ $param->{ $f } });
 764                     }
 765                     ( $f, $f.'_flag', $f.'_label' );
 766                   }
 767                   @fields;
 768
 769             } FS::part_svc->svc_tables()
 770       )
 771   } );
 772
 773   my %exportnums =
 774     map { $_->exportnum => ( $param->{'exportnum'.$_->exportnum} || '') }
 775         qsearch('part_export', {} );
 776
 777   my $error;
 778   if ( $param->{'svcpart'} ) {
 779     $error = $new->replace( $old,
 780                             '1.3-COMPAT',    #totally bunk, as jeff noted
 781                             [ 'usergroup' ],
 782                             \%exportnums,
 783                             $job
 784                           );
 785   } else {
 786     $error = $new->insert( [ 'usergroup' ],
 787                            \%exportnums,
 788                            $job,
 789                          );
 790     $param->{'svcpart'} = $new->getfield('svcpart');
 791   }
 792
 793   die "$error\n" if $error;
 794 }
 795
 796 =item process_bulk_cust_svc
 797
 798 Job-queue processor for web interface bulk customer service changes
 799
 800 =cut
 801
 802 use Data::Dumper;
 803 sub process_bulk_cust_svc {
 804   my $job = shift;
 805   my $param = shift;
 806   warn Dumper($param) if $DEBUG;
 807
 808   local($FS::svc_Common::noexport_hack) = 1
 809     if $param->{'noexport'};
 810
 811   my $old_part_svc =
 812     qsearchs('part_svc', { 'svcpart' => $param->{'old_svcpart'} } );
 813
 814   die "Must select a new service definition\n" unless $param->{'new_svcpart'};
 815
 816   #the rest should be abstracted out to to its own subroutine?
 817
 818   local $SIG{HUP} = 'IGNORE';
 819   local $SIG{INT} = 'IGNORE';
 820   local $SIG{QUIT} = 'IGNORE';
 821   local $SIG{TERM} = 'IGNORE';
 822   local $SIG{TSTP} = 'IGNORE';
 823   local $SIG{PIPE} = 'IGNORE';
 824
 825   my $oldAutoCommit = $FS::UID::AutoCommit;
 826   local $FS::UID::AutoCommit = 0;
 827   my $dbh = dbh;
 828
 829   local( $FS::cust_svc::ignore_quantity ) = 1;
 830
 831   my $total = $old_part_svc->num_cust_svc( $param->{'pkgpart'} );
 832
 833   my $n = 0;
 834   foreach my $old_cust_svc ( $old_part_svc->cust_svc( $param->{'pkgpart'} ) ) {
 835
 836     my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
 837
 838     $new_cust_svc->svcpart( $param->{'new_svcpart'} );
 839     my $error = $new_cust_svc->replace($old_cust_svc);
 840     if ( $error ) {
 841       $dbh->rollback if $oldAutoCommit;
 842       die "$error\n" if $error;
 843     }
 844
 845     $error = $job->update_statustext( int( 100 * ++$n / $total ) );
 846     if ( $error ) {
 847       $dbh->rollback if $oldAutoCommit;
 848       die $error if $error;
 849     }
 850
 851   }
 852
 853   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 854
 855   '';
 856
 857 }
 858
 859 sub _upgrade_data {  #class method
 860   my ($class, %opts) = @_;
 861
 862   my @part_svc_column = qsearch('part_svc_column', { 'columnname' => 'usergroup' });
 863   foreach my $col ( @part_svc_column ) {
 864     next if $col->columnvalue =~ /^[\d,]+$/ || !$col->columnvalue;
 865     my @groupnames = split(',',$col->columnvalue);
 866     my @groupnums;
 867     my $error = '';
 868     foreach my $groupname ( @groupnames ) {
 869         my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
 870         unless ( $g ) {
 871             $g = new FS::radius_group {
 872                             'groupname' => $groupname,
 873                             'description' => $groupname,
 874                             };
 875             $error = $g->insert;
 876             die "Error inserting new radius_group for service definition group \"$groupname\": $error"
 877               if $error;
 878         }
 879         push @groupnums, $g->groupnum;
 880     }
 881     $col->columnvalue(join(',',@groupnums));
 882     $error = $col->replace;
 883     die $error if $error;
 884   }
 885
 886   my @badlabels = qsearch({
 887     'table' => 'part_svc_column',
 888     'hashref' => {},
 889     'extra_sql' => 'WHERE columnlabel IN ('.
 890       "'Descriptive label for this particular device.',".
 891       "'IP address.  Leave blank for automatic assignment.',".
 892       "'Maximum upload speed for this service in Kbps.  0 denotes unlimited.',".
 893       "'Maximum download speed for this service in Kbps.  0 denotes unlimited.')"
 894   });
 895   foreach my $col ( @badlabels ) {
 896     $col->columnlabel('');
 897     my $error = $col->replace;
 898     die $error if $error;
 899   }
 900
 901 }
 902
 903 =head1 BUGS
 904
 905 Delete is unimplemented.
 906
 907 The list of svc_* tables is no longer hardcoded, but svc_acct_pop is skipped
 908 as a special case until it is renamed.
 909
 910 all_part_svc_column methods should be documented
 911
 912 =head1 SEE ALSO
 913
 914 L<FS::Record>, L<FS::part_svc_column>, L<FS::part_pkg>, L<FS::pkg_svc>,
 915 L<FS::cust_svc>, L<FS::svc_acct>, L<FS::svc_forward>, L<FS::svc_domain>,
 916 schema.html from the base documentation.
 917
 918 =cut
 919
 920 1;
 921