FS/FS/part_pkg.pm

   1 package FS::part_pkg;
   2
   3 use strict;
   4 use vars qw( @ISA %plans $DEBUG $setup_hack $skip_pkg_svc_hack );
   5 use Carp qw(carp cluck confess);
   6 use Scalar::Util qw( blessed );
   7 use Time::Local qw( timelocal_nocheck );
   8 use Tie::IxHash;
   9 use FS::Conf;
  10 use FS::Record qw( qsearch qsearchs dbh dbdef );
  11 use FS::pkg_svc;
  12 use FS::part_svc;
  13 use FS::cust_pkg;
  14 use FS::agent_type;
  15 use FS::type_pkgs;
  16 use FS::part_pkg_option;
  17 use FS::pkg_class;
  18 use FS::agent;
  19 use FS::part_pkg_taxrate;
  20 use FS::part_pkg_taxoverride;
  21 use FS::part_pkg_taxproduct;
  22 use FS::part_pkg_link;
  23 use FS::part_pkg_discount;
  24 use FS::part_pkg_vendor;
  25
  26 @ISA = qw( FS::m2m_Common FS::option_Common );
  27 $DEBUG = 0;
  28 $setup_hack = 0;
  29 $skip_pkg_svc_hack = 0;
  30
  31 =head1 NAME
  32
  33 FS::part_pkg - Object methods for part_pkg objects
  34
  35 =head1 SYNOPSIS
  36
  37   use FS::part_pkg;
  38
  39   $record = new FS::part_pkg \%hash
  40   $record = new FS::part_pkg { 'column' => 'value' };
  41
  42   $custom_record = $template_record->clone;
  43
  44   $error = $record->insert;
  45
  46   $error = $new_record->replace($old_record);
  47
  48   $error = $record->delete;
  49
  50   $error = $record->check;
  51
  52   @pkg_svc = $record->pkg_svc;
  53
  54   $svcnum = $record->svcpart;
  55   $svcnum = $record->svcpart( 'svc_acct' );
  56
  57 =head1 DESCRIPTION
  58
  59 An FS::part_pkg object represents a package definition.  FS::part_pkg
  60 inherits from FS::Record.  The following fields are currently supported:
  61
  62 =over 4
  63
  64 =item pkgpart - primary key (assigned automatically for new package definitions)
  65
  66 =item pkg - Text name of this package definition (customer-viewable)
  67
  68 =item comment - Text name of this package definition (non-customer-viewable)
  69
  70 =item classnum - Optional package class (see L<FS::pkg_class>)
  71
  72 =item promo_code - Promotional code
  73
  74 =item setup - Setup fee expression (deprecated)
  75
  76 =item freq - Frequency of recurring fee
  77
  78 =item recur - Recurring fee expression (deprecated)
  79
  80 =item setuptax - Setup fee tax exempt flag, empty or `Y'
  81
  82 =item recurtax - Recurring fee tax exempt flag, empty or `Y'
  83
  84 =item taxclass - Tax class
  85
  86 =item plan - Price plan
  87
  88 =item plandata - Price plan data (deprecated - see L<FS::part_pkg_option> instead)
  89
  90 =item disabled - Disabled flag, empty or `Y'
  91
  92 =item custom - Custom flag, empty or `Y'
  93
  94 =item setup_cost - for cost tracking
  95
  96 =item recur_cost - for cost tracking
  97
  98 =item pay_weight - Weight (relative to credit_weight and other package definitions) that controls payment application to specific line items.
  99
 100 =item credit_weight - Weight (relative to other package definitions) that controls credit application to specific line items.
 101
 102 =item agentnum - Optional agentnum (see L<FS::agent>)
 103
 104 =item fcc_ds0s - Optional DS0 equivalency number for FCC form 477
 105
 106 =back
 107
 108 =head1 METHODS
 109
 110 =over 4
 111
 112 =item new HASHREF
 113
 114 Creates a new package definition.  To add the package definition to
 115 the database, see L<"insert">.
 116
 117 =cut
 118
 119 sub table { 'part_pkg'; }
 120
 121 =item clone
 122
 123 An alternate constructor.  Creates a new package definition by duplicating
 124 an existing definition.  A new pkgpart is assigned and the custom flag is
 125 set to Y.  To add the package definition to the database, see L<"insert">.
 126
 127 =cut
 128
 129 sub clone {
 130   my $self = shift;
 131   my $class = ref($self);
 132   my %hash = $self->hash;
 133   $hash{'pkgpart'} = '';
 134   $hash{'custom'} = 'Y';
 135   #new FS::part_pkg ( \%hash ); # ?
 136   new $class ( \%hash ); # ?
 137 }
 138
 139 =item insert [ , OPTION => VALUE ... ]
 140
 141 Adds this package definition to the database.  If there is an error,
 142 returns the error, otherwise returns false.
 143
 144 Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg>,
 145 I<custnum_ref> and I<options>.
 146
 147 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
 148 values, appropriate FS::pkg_svc records will be inserted.  I<hidden_svc> can
 149 be set to a hashref of svcparts and flag values ('Y' or '') to set the
 150 'hidden' field in these records.
 151
 152 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
 153 FS::pkg_svc record will be updated.
 154
 155 If I<cust_pkg> is set to a pkgnum of a FS::cust_pkg record (or the FS::cust_pkg
 156 record itself), the object will be updated to point to this package definition.
 157
 158 In conjunction with I<cust_pkg>, if I<custnum_ref> is set to a scalar reference,
 159 the scalar will be updated with the custnum value from the cust_pkg record.
 160
 161 If I<tax_overrides> is set to a hashref with usage classes as keys and comma
 162 separated tax class numbers as values, appropriate FS::part_pkg_taxoverride
 163 records will be inserted.
 164
 165 If I<options> is set to a hashref of options, appropriate FS::part_pkg_option
 166 records will be inserted.
 167
 168 =cut
 169
 170 sub insert {
 171   my $self = shift;
 172   my %options = @_;
 173   warn "FS::part_pkg::insert called on $self with options ".
 174        join(', ', map "$_=>$options{$_}", keys %options)
 175     if $DEBUG;
 176
 177   local $SIG{HUP} = 'IGNORE';
 178   local $SIG{INT} = 'IGNORE';
 179   local $SIG{QUIT} = 'IGNORE';
 180   local $SIG{TERM} = 'IGNORE';
 181   local $SIG{TSTP} = 'IGNORE';
 182   local $SIG{PIPE} = 'IGNORE';
 183
 184   my $oldAutoCommit = $FS::UID::AutoCommit;
 185   local $FS::UID::AutoCommit = 0;
 186   my $dbh = dbh;
 187
 188   warn "  inserting part_pkg record" if $DEBUG;
 189   my $error = $self->SUPER::insert( $options{options} );
 190   if ( $error ) {
 191     $dbh->rollback if $oldAutoCommit;
 192     return $error;
 193   }
 194
 195   my $conf = new FS::Conf;
 196   if ( $conf->exists('agent_defaultpkg') ) {
 197     warn "  agent_defaultpkg set; allowing all agents to purchase package"
 198       if $DEBUG;
 199     foreach my $agent_type ( qsearch('agent_type', {} ) ) {
 200       my $type_pkgs = new FS::type_pkgs({
 201         'typenum' => $agent_type->typenum,
 202         'pkgpart' => $self->pkgpart,
 203       });
 204       my $error = $type_pkgs->insert;
 205       if ( $error ) {
 206         $dbh->rollback if $oldAutoCommit;
 207         return $error;
 208       }
 209     }
 210   }
 211
 212   warn "  inserting part_pkg_taxoverride records" if $DEBUG;
 213   my %overrides = %{ $options{'tax_overrides'} || {} };
 214   foreach my $usage_class ( keys %overrides ) {
 215     my $override =
 216       ( exists($overrides{$usage_class}) && defined($overrides{$usage_class}) )
 217         ? $overrides{$usage_class}
 218         : '';
 219     my @overrides = (grep "$_", split(',', $override) );
 220     my $error = $self->process_m2m (
 221                   'link_table'   => 'part_pkg_taxoverride',
 222                   'target_table' => 'tax_class',
 223                   'hashref'      => { 'usage_class' => $usage_class },
 224                   'params'       => \@overrides,
 225                 );
 226     if ( $error ) {
 227       $dbh->rollback if $oldAutoCommit;
 228       return $error;
 229     }
 230   }
 231
 232   unless ( $skip_pkg_svc_hack ) {
 233
 234     warn "  inserting pkg_svc records" if $DEBUG;
 235     my $pkg_svc = $options{'pkg_svc'} || {};
 236     my $hidden_svc = $options{'hidden_svc'} || {};
 237     foreach my $part_svc ( qsearch('part_svc', {} ) ) {
 238       my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
 239       my $primary_svc =
 240         ( $options{'primary_svc'} && $options{'primary_svc'}==$part_svc->svcpart )
 241           ? 'Y'
 242           : '';
 243
 244       my $pkg_svc = new FS::pkg_svc( {
 245         'pkgpart'     => $self->pkgpart,
 246         'svcpart'     => $part_svc->svcpart,
 247         'quantity'    => $quantity,
 248         'primary_svc' => $primary_svc,
 249         'hidden'      => $hidden_svc->{$part_svc->svcpart},
 250       } );
 251       my $error = $pkg_svc->insert;
 252       if ( $error ) {
 253         $dbh->rollback if $oldAutoCommit;
 254         return $error;
 255       }
 256     }
 257
 258   }
 259
 260   if ( $options{'cust_pkg'} ) {
 261     warn "  updating cust_pkg record " if $DEBUG;
 262     my $old_cust_pkg =
 263       ref($options{'cust_pkg'})
 264         ? $options{'cust_pkg'}
 265         : qsearchs('cust_pkg', { pkgnum => $options{'cust_pkg'} } );
 266     ${ $options{'custnum_ref'} } = $old_cust_pkg->custnum
 267       if $options{'custnum_ref'};
 268     my %hash = $old_cust_pkg->hash;
 269     $hash{'pkgpart'} = $self->pkgpart,
 270     my $new_cust_pkg = new FS::cust_pkg \%hash;
 271     local($FS::cust_pkg::disable_agentcheck) = 1;
 272     my $error = $new_cust_pkg->replace($old_cust_pkg);
 273     if ( $error ) {
 274       $dbh->rollback if $oldAutoCommit;
 275       return "Error modifying cust_pkg record: $error";
 276     }
 277   }
 278
 279   if ( $options{'part_pkg_vendor'} ) {
 280       my($exportnum,$vendor_pkg_id);
 281       my %options_part_pkg_vendor = $options{'part_pkg_vendor'};
 282       while(($exportnum,$vendor_pkg_id) = each %options_part_pkg_vendor){
 283             my $ppv = new FS::part_pkg_vendor( {
 284                     'pkgpart' => $self->pkgpart,
 285                     'exportnum' => $exportnum,
 286                     'vendor_pkg_id' => $vendor_pkg_id,
 287                 } );
 288             my $error = $ppv->insert;
 289             if ( $error ) {
 290               $dbh->rollback if $oldAutoCommit;
 291               return "Error inserting part_pkg_vendor record: $error";
 292             }
 293       }
 294   }
 295
 296   warn "  commiting transaction" if $DEBUG;
 297   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 298
 299   '';
 300 }
 301
 302 =item delete
 303
 304 Currently unimplemented.
 305
 306 =cut
 307
 308 sub delete {
 309   return "Can't (yet?) delete package definitions.";
 310 # check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
 311 }
 312
 313 =item replace OLD_RECORD [ , OPTION => VALUE ... ]
 314
 315 Replaces OLD_RECORD with this one in the database.  If there is an error,
 316 returns the error, otherwise returns false.
 317
 318 Currently available options are: I<pkg_svc>, I<hidden_svc>, I<primary_svc>
 319 and I<options>
 320
 321 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
 322 values, the appropriate FS::pkg_svc records will be replaced.  I<hidden_svc>
 323 can be set to a hashref of svcparts and flag values ('Y' or '') to set the
 324 'hidden' field in these records.
 325
 326 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
 327 FS::pkg_svc record will be updated.
 328
 329 If I<options> is set to a hashref, the appropriate FS::part_pkg_option records
 330 will be replaced.
 331
 332 =cut
 333
 334 sub replace {
 335   my $new = shift;
 336
 337   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 338               ? shift
 339               : $new->replace_old;
 340
 341   my $options =
 342     ( ref($_[0]) eq 'HASH' )
 343       ? shift
 344       : { @_ };
 345
 346   $options->{options} = {} unless defined($options->{options});
 347
 348   warn "FS::part_pkg::replace called on $new to replace $old with options".
 349        join(', ', map "$_ => ". $options->{$_}, keys %$options)
 350     if $DEBUG;
 351
 352   local $SIG{HUP} = 'IGNORE';
 353   local $SIG{INT} = 'IGNORE';
 354   local $SIG{QUIT} = 'IGNORE';
 355   local $SIG{TERM} = 'IGNORE';
 356   local $SIG{TSTP} = 'IGNORE';
 357   local $SIG{PIPE} = 'IGNORE';
 358
 359   my $oldAutoCommit = $FS::UID::AutoCommit;
 360   local $FS::UID::AutoCommit = 0;
 361   my $dbh = dbh;
 362
 363   #plandata shit stays in replace for upgrades until after 2.0 (or edit
 364   #_upgrade_data)
 365   warn "  saving legacy plandata" if $DEBUG;
 366   my $plandata = $new->get('plandata');
 367   $new->set('plandata', '');
 368
 369   warn "  deleting old part_pkg_option records" if $DEBUG;
 370   foreach my $part_pkg_option ( $old->part_pkg_option ) {
 371     my $error = $part_pkg_option->delete;
 372     if ( $error ) {
 373       $dbh->rollback if $oldAutoCommit;
 374       return $error;
 375     }
 376   }
 377
 378   warn "  replacing part_pkg record" if $DEBUG;
 379   my $error = $new->SUPER::replace($old, $options->{options} );
 380   if ( $error ) {
 381     $dbh->rollback if $oldAutoCommit;
 382     return $error;
 383   }
 384
 385   warn "  inserting part_pkg_option records for plandata: $plandata|" if $DEBUG;
 386   foreach my $part_pkg_option (
 387     map { /^(\w+)=(.*)$/ or do { $dbh->rollback if $oldAutoCommit;
 388                                  return "illegal plandata: $plandata";
 389                                };
 390           new FS::part_pkg_option {
 391             'pkgpart'     => $new->pkgpart,
 392             'optionname'  => $1,
 393             'optionvalue' => $2,
 394           };
 395         }
 396     split("\n", $plandata)
 397   ) {
 398     my $error = $part_pkg_option->insert;
 399     if ( $error ) {
 400       $dbh->rollback if $oldAutoCommit;
 401       return $error;
 402     }
 403   }
 404
 405   warn "  replacing pkg_svc records" if $DEBUG;
 406   my $pkg_svc = $options->{'pkg_svc'} || {};
 407   my $hidden_svc = $options->{'hidden_svc'} || {};
 408   foreach my $part_svc ( qsearch('part_svc', {} ) ) {
 409     my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
 410     my $hidden = $hidden_svc->{$part_svc->svcpart} || '';
 411     my $primary_svc =
 412       ( defined($options->{'primary_svc'}) && $options->{'primary_svc'}
 413         && $options->{'primary_svc'} == $part_svc->svcpart
 414       )
 415         ? 'Y'
 416         : '';
 417
 418     my $old_pkg_svc = qsearchs('pkg_svc', {
 419         'pkgpart' => $old->pkgpart,
 420         'svcpart' => $part_svc->svcpart,
 421       }
 422     );
 423     my $old_quantity = 0;
 424     my $old_primary_svc = '';
 425     my $old_hidden = '';
 426     if ( $old_pkg_svc ) {
 427       $old_quantity = $old_pkg_svc->quantity;
 428       $old_primary_svc = $old_pkg_svc->primary_svc
 429         if $old_pkg_svc->dbdef_table->column('primary_svc'); # is this needed?
 430       $old_hidden = $old_pkg_svc->hidden;
 431     }
 432
 433     next unless $old_quantity != $quantity ||
 434                 $old_primary_svc ne $primary_svc ||
 435                 $old_hidden ne $hidden;
 436
 437     my $new_pkg_svc = new FS::pkg_svc( {
 438       'pkgsvcnum'   => ( $old_pkg_svc ? $old_pkg_svc->pkgsvcnum : '' ),
 439       'pkgpart'     => $new->pkgpart,
 440       'svcpart'     => $part_svc->svcpart,
 441       'quantity'    => $quantity,
 442       'primary_svc' => $primary_svc,
 443       'hidden'      => $hidden,
 444     } );
 445     my $error = $old_pkg_svc
 446                   ? $new_pkg_svc->replace($old_pkg_svc)
 447                   : $new_pkg_svc->insert;
 448     if ( $error ) {
 449       $dbh->rollback if $oldAutoCommit;
 450       return $error;
 451     }
 452   }
 453
 454   my @part_pkg_vendor = $old->part_pkg_vendor;
 455   my @current_exportnum = ();
 456   if ( $options->{'part_pkg_vendor'} ) {
 457       my($exportnum,$vendor_pkg_id);
 458       while ( ($exportnum,$vendor_pkg_id)
 459                                 = each %{$options->{'part_pkg_vendor'}} ) {
 460           my $noinsert = 0;
 461           foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
 462             if($exportnum == $part_pkg_vendor->exportnum
 463                 && $vendor_pkg_id ne $part_pkg_vendor->vendor_pkg_id) {
 464                 $part_pkg_vendor->vendor_pkg_id($vendor_pkg_id);
 465                 my $error = $part_pkg_vendor->replace;
 466                 if ( $error ) {
 467                   $dbh->rollback if $oldAutoCommit;
 468                   return "Error replacing part_pkg_vendor record: $error";
 469                 }
 470                 $noinsert = 1;
 471                 last;
 472             }
 473             elsif($exportnum == $part_pkg_vendor->exportnum
 474                 && $vendor_pkg_id eq $part_pkg_vendor->vendor_pkg_id) {
 475                 $noinsert = 1;
 476                 last;
 477             }
 478           }
 479           unless ( $noinsert ) {
 480             my $ppv = new FS::part_pkg_vendor( {
 481                     'pkgpart' => $new->pkgpart,
 482                     'exportnum' => $exportnum,
 483                     'vendor_pkg_id' => $vendor_pkg_id,
 484                 } );
 485             my $error = $ppv->insert;
 486             if ( $error ) {
 487               $dbh->rollback if $oldAutoCommit;
 488               return "Error inserting part_pkg_vendor record: $error";
 489             }
 490           }
 491           push @current_exportnum, $exportnum;
 492       }
 493   }
 494   foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
 495       unless ( grep($_ eq $part_pkg_vendor->exportnum, @current_exportnum) ) {
 496         my $error = $part_pkg_vendor->delete;
 497         if ( $error ) {
 498           $dbh->rollback if $oldAutoCommit;
 499           return "Error deleting part_pkg_vendor record: $error";
 500         }
 501       }
 502   }
 503
 504   warn "  commiting transaction" if $DEBUG;
 505   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 506   '';
 507 }
 508
 509 =item check
 510
 511 Checks all fields to make sure this is a valid package definition.  If
 512 there is an error, returns the error, otherwise returns false.  Called by the
 513 insert and replace methods.
 514
 515 =cut
 516
 517 sub check {
 518   my $self = shift;
 519   warn "FS::part_pkg::check called on $self" if $DEBUG;
 520
 521   for (qw(setup recur plandata)) {
 522     #$self->set($_=>0) if $self->get($_) =~ /^\s*$/; }
 523     return "Use of $_ field is deprecated; set a plan and options: ".
 524            $self->get($_)
 525       if length($self->get($_));
 526     $self->set($_, '');
 527   }
 528
 529   if ( $self->dbdef_table->column('freq')->type =~ /(int)/i ) {
 530     my $error = $self->ut_number('freq');
 531     return $error if $error;
 532   } else {
 533     $self->freq =~ /^(\d+[hdw]?)$/
 534       or return "Illegal or empty freq: ". $self->freq;
 535     $self->freq($1);
 536   }
 537
 538   my @null_agentnum_right = ( 'Edit global package definitions' );
 539   push @null_agentnum_right, 'One-time charge'
 540     if $self->freq =~ /^0/;
 541   push @null_agentnum_right, 'Customize customer package'
 542     if $self->disabled eq 'Y'; #good enough
 543
 544   my $error = $self->ut_numbern('pkgpart')
 545     || $self->ut_text('pkg')
 546     || $self->ut_text('comment')
 547     || $self->ut_textn('promo_code')
 548     || $self->ut_alphan('plan')
 549     || $self->ut_enum('setuptax', [ '', 'Y' ] )
 550     || $self->ut_enum('recurtax', [ '', 'Y' ] )
 551     || $self->ut_textn('taxclass')
 552     || $self->ut_enum('disabled', [ '', 'Y' ] )
 553     || $self->ut_enum('custom', [ '', 'Y' ] )
 554     || $self->ut_enum('no_auto', [ '', 'Y' ])
 555     #|| $self->ut_moneyn('setup_cost')
 556     #|| $self->ut_moneyn('recur_cost')
 557     || $self->ut_floatn('setup_cost')
 558     || $self->ut_floatn('recur_cost')
 559     || $self->ut_floatn('pay_weight')
 560     || $self->ut_floatn('credit_weight')
 561     || $self->ut_numbern('taxproductnum')
 562     || $self->ut_foreign_keyn('classnum',       'pkg_class', 'classnum')
 563     || $self->ut_foreign_keyn('addon_classnum', 'pkg_class', 'classnum')
 564     || $self->ut_foreign_keyn('taxproductnum',
 565                               'part_pkg_taxproduct',
 566                               'taxproductnum'
 567                              )
 568     || ( $setup_hack
 569            ? $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum' )
 570            : $self->ut_agentnum_acl('agentnum', \@null_agentnum_right)
 571        )
 572     || $self->ut_numbern('fcc_ds0s')
 573     || $self->SUPER::check
 574   ;
 575   return $error if $error;
 576
 577   return 'Unknown plan '. $self->plan
 578     unless exists($plans{$self->plan});
 579
 580   my $conf = new FS::Conf;
 581   return 'Taxclass is required'
 582     if ! $self->taxclass && $conf->exists('require_taxclasses');
 583
 584   '';
 585 }
 586
 587 =item pkg_comment [ OPTION => VALUE... ]
 588
 589 Returns an (internal) string representing this package.  Currently,
 590 "pkgpart: pkg - comment", is returned.  "pkg - comment" may be returned in the
 591 future, omitting pkgpart.  The comment will have '(CUSTOM) ' prepended if
 592 custom is Y.
 593
 594 If the option nopkgpart is true then the "pkgpart: ' is omitted.
 595
 596 =cut
 597
 598 sub pkg_comment {
 599   my $self = shift;
 600   my %opt = @_;
 601
 602   #$self->pkg. ' - '. $self->comment;
 603   #$self->pkg. ' ('. $self->comment. ')';
 604   my $pre = $opt{nopkgpart} ? '' : $self->pkgpart. ': ';
 605   $pre. $self->pkg. ' - '. $self->custom_comment;
 606 }
 607
 608 sub custom_comment {
 609   my $self = shift;
 610   ( $self->custom ? '(CUSTOM) ' : '' ). $self->comment;
 611 }
 612
 613 =item pkg_class
 614
 615 Returns the package class, as an FS::pkg_class object, or the empty string
 616 if there is no package class.
 617
 618 =cut
 619
 620 sub pkg_class {
 621   my $self = shift;
 622   if ( $self->classnum ) {
 623     qsearchs('pkg_class', { 'classnum' => $self->classnum } );
 624   } else {
 625     return '';
 626   }
 627 }
 628
 629 =item addon_pkg_class
 630
 631 Returns the add-on package class, as an FS::pkg_class object, or the empty
 632 string if there is no add-on package class.
 633
 634 =cut
 635
 636 sub addon_pkg_class {
 637   my $self = shift;
 638   if ( $self->addon_classnum ) {
 639     qsearchs('pkg_class', { 'classnum' => $self->addon_classnum } );
 640   } else {
 641     return '';
 642   }
 643 }
 644
 645 =item categoryname
 646
 647 Returns the package category name, or the empty string if there is no package
 648 category.
 649
 650 =cut
 651
 652 sub categoryname {
 653   my $self = shift;
 654   my $pkg_class = $self->pkg_class;
 655   $pkg_class
 656     ? $pkg_class->categoryname
 657     : '';
 658 }
 659
 660 =item classname
 661
 662 Returns the package class name, or the empty string if there is no package
 663 class.
 664
 665 =cut
 666
 667 sub classname {
 668   my $self = shift;
 669   my $pkg_class = $self->pkg_class;
 670   $pkg_class
 671     ? $pkg_class->classname
 672     : '';
 673 }
 674
 675 =item addon_classname
 676
 677 Returns the add-on package class name, or the empty string if there is no
 678 add-on package class.
 679
 680 =cut
 681
 682 sub addon_classname {
 683   my $self = shift;
 684   my $pkg_class = $self->addon_pkg_class;
 685   $pkg_class
 686     ? $pkg_class->classname
 687     : '';
 688 }
 689
 690 =item agent
 691
 692 Returns the associated agent for this event, if any, as an FS::agent object.
 693
 694 =cut
 695
 696 sub agent {
 697   my $self = shift;
 698   qsearchs('agent', { 'agentnum' => $self->agentnum } );
 699 }
 700
 701 =item pkg_svc [ HASHREF | OPTION => VALUE ]
 702
 703 Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
 704 definition (with non-zero quantity).
 705
 706 One option is available, I<disable_linked>.  If set true it will return the
 707 services for this package definition alone, omitting services from any add-on
 708 packages.
 709
 710 =cut
 711
 712 =item type_pkgs
 713
 714 Returns all FS::type_pkgs objects (see L<FS::type_pkgs>) for this package
 715 definition.
 716
 717 =cut
 718
 719 sub type_pkgs {
 720   my $self = shift;
 721   qsearch('type_pkgs', { 'pkgpart' => $self->pkgpart } );
 722 }
 723
 724 sub pkg_svc {
 725   my $self = shift;
 726
 727 #  #sort { $b->primary cmp $a->primary }
 728 #    grep { $_->quantity }
 729 #      qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
 730
 731   my $opt = ref($_[0]) ? $_[0] : { @_ };
 732   my %pkg_svc = map  { $_->svcpart => $_ }
 733                 grep { $_->quantity }
 734                 qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
 735
 736   unless ( $opt->{disable_linked} ) {
 737     foreach my $dst_pkg ( map $_->dst_pkg, $self->svc_part_pkg_link ) {
 738       my @pkg_svc = grep { $_->quantity }
 739                     qsearch( 'pkg_svc', { pkgpart=>$dst_pkg->pkgpart } );
 740       foreach my $pkg_svc ( @pkg_svc ) {
 741         if ( $pkg_svc{$pkg_svc->svcpart} ) {
 742           my $quantity = $pkg_svc{$pkg_svc->svcpart}->quantity;
 743           $pkg_svc{$pkg_svc->svcpart}->quantity($quantity + $pkg_svc->quantity);
 744         } else {
 745           $pkg_svc{$pkg_svc->svcpart} = $pkg_svc;
 746         }
 747       }
 748     }
 749   }
 750
 751   values(%pkg_svc);
 752
 753 }
 754
 755 =item svcpart [ SVCDB ]
 756
 757 Returns the svcpart of the primary service definition (see L<FS::part_svc>)
 758 associated with this package definition (see L<FS::pkg_svc>).  Returns
 759 false if there not a primary service definition or exactly one service
 760 definition with quantity 1, or if SVCDB is specified and does not match the
 761 svcdb of the service definition.  SVCDB can be specified as a scalar table
 762 name, such as 'svc_acct', or as an arrayref of possible table names.
 763
 764 =cut
 765
 766 sub svcpart {
 767   my $pkg_svc = shift->_primary_pkg_svc(@_);
 768   $pkg_svc ? $pkg_svc->svcpart : '';
 769 }
 770
 771 =item part_svc [ SVCDB ]
 772
 773 Like the B<svcpart> method, but returns the FS::part_svc object (see
 774 L<FS::part_svc>).
 775
 776 =cut
 777
 778 sub part_svc {
 779   my $pkg_svc = shift->_primary_pkg_svc(@_);
 780   $pkg_svc ? $pkg_svc->part_svc : '';
 781 }
 782
 783 sub _primary_pkg_svc {
 784   my $self = shift;
 785
 786   my $svcdb = scalar(@_) ? shift : [];
 787   $svcdb = ref($svcdb) ? $svcdb : [ $svcdb ];
 788   my %svcdb = map { $_=>1 } @$svcdb;
 789
 790   my @svcdb_pkg_svc =
 791     grep { !scalar(@$svcdb) || $svcdb{ $_->part_svc->svcdb } }
 792          $self->pkg_svc;
 793
 794   my @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc;
 795   @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc
 796     unless @pkg_svc;
 797   return '' if scalar(@pkg_svc) != 1;
 798   $pkg_svc[0];
 799 }
 800
 801 =item svcpart_unique_svcdb SVCDB
 802
 803 Returns the svcpart of a service definition (see L<FS::part_svc>) matching
 804 SVCDB associated with this package definition (see L<FS::pkg_svc>).  Returns
 805 false if there not a primary service definition for SVCDB or there are multiple
 806 service definitions for SVCDB.
 807
 808 =cut
 809
 810 sub svcpart_unique_svcdb {
 811   my( $self, $svcdb ) = @_;
 812   my @svcdb_pkg_svc = grep { ( $svcdb eq $_->part_svc->svcdb ) } $self->pkg_svc;
 813   return '' if scalar(@svcdb_pkg_svc) != 1;
 814   $svcdb_pkg_svc[0]->svcpart;
 815 }
 816
 817 =item payby
 818
 819 Returns a list of the acceptable payment types for this package.  Eventually
 820 this should come out of a database table and be editable, but currently has the
 821 following logic instead:
 822
 823 If the package is free, the single item B<BILL> is
 824 returned, otherwise, the single item B<CARD> is returned.
 825
 826 (CHEK?  LEC?  Probably shouldn't accept those by default, prone to abuse)
 827
 828 =cut
 829
 830 sub payby {
 831   my $self = shift;
 832   if ( $self->is_free ) {
 833     ( 'BILL' );
 834   } else {
 835     ( 'CARD' );
 836   }
 837 }
 838
 839 =item is_free
 840
 841 Returns true if this package is free.
 842
 843 =cut
 844
 845 sub is_free {
 846   my $self = shift;
 847   unless ( $self->plan ) {
 848     $self->setup =~ /^\s*0+(\.0*)?\s*$/
 849       && $self->recur =~ /^\s*0+(\.0*)?\s*$/;
 850   } elsif ( $self->can('is_free_options') ) {
 851     not grep { $_ !~ /^\s*0*(\.0*)?\s*$/ }
 852          map { $self->option($_) }
 853              $self->is_free_options;
 854   } else {
 855     warn "FS::part_pkg::is_free: FS::part_pkg::". $self->plan. " subclass ".
 856          "provides neither is_free_options nor is_free method; returning false";
 857     0;
 858   }
 859 }
 860
 861 sub can_discount { 0; }
 862
 863 sub freqs_href {
 864   # moved to FS::Misc to make this accessible to other packages
 865   # at initialization
 866   FS::Misc::pkg_freqs();
 867 }
 868
 869 =item freq_pretty
 870
 871 Returns an english representation of the I<freq> field, such as "monthly",
 872 "weekly", "semi-annually", etc.
 873
 874 =cut
 875
 876 sub freq_pretty {
 877   my $self = shift;
 878   my $freq = $self->freq;
 879
 880   #my $freqs_href = $self->freqs_href;
 881   my $freqs_href = freqs_href();
 882
 883   if ( exists($freqs_href->{$freq}) ) {
 884     $freqs_href->{$freq};
 885   } else {
 886     my $interval = 'month';
 887     if ( $freq =~ /^(\d+)([hdw])$/ ) {
 888       my %interval = ( 'h' => 'hour', 'd'=>'day', 'w'=>'week' );
 889       $interval = $interval{$2};
 890     }
 891     if ( $1 == 1 ) {
 892       "every $interval";
 893     } else {
 894       "every $freq ${interval}s";
 895     }
 896   }
 897 }
 898
 899 =item add_freq TIMESTAMP [ FREQ ]
 900
 901 Adds a billing period of some frequency to the provided timestamp and
 902 returns the resulting timestamp, or -1 if the frequency could not be
 903 parsed (shouldn't happen).  By default, the frequency of this package
 904 will be used; to override this, pass a different frequency as a second
 905 argument.
 906
 907 =cut
 908
 909 sub add_freq {
 910   my( $self, $date, $freq ) = @_;
 911   $freq = $self->freq unless $freq;
 912
 913   #change this bit to use Date::Manip? CAREFUL with timezones (see
 914   # mailing list archive)
 915   my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($date) )[0,1,2,3,4,5];
 916
 917   if ( $freq =~ /^\d+$/ ) {
 918     $mon += $freq;
 919     until ( $mon < 12 ) { $mon -= 12; $year++; }
 920   } elsif ( $freq =~ /^(\d+)w$/ ) {
 921     my $weeks = $1;
 922     $mday += $weeks * 7;
 923   } elsif ( $freq =~ /^(\d+)d$/ ) {
 924     my $days = $1;
 925     $mday += $days;
 926   } elsif ( $freq =~ /^(\d+)h$/ ) {
 927     my $hours = $1;
 928     $hour += $hours;
 929   } else {
 930     return -1;
 931   }
 932
 933   timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
 934 }
 935
 936 =item plandata
 937
 938 For backwards compatibility, returns the plandata field as well as all options
 939 from FS::part_pkg_option.
 940
 941 =cut
 942
 943 sub plandata {
 944   my $self = shift;
 945   carp "plandata is deprecated";
 946   if ( @_ ) {
 947     $self->SUPER::plandata(@_);
 948   } else {
 949     my $plandata = $self->get('plandata');
 950     my %options = $self->options;
 951     $plandata .= join('', map { "$_=$options{$_}\n" } keys %options );
 952     $plandata;
 953   }
 954 }
 955
 956 =item part_pkg_vendor
 957
 958 Returns all vendor/external package ids as FS::part_pkg_vendor objects (see
 959 L<FS::part_pkg_vendor>).
 960
 961 =cut
 962
 963 sub part_pkg_vendor {
 964   my $self = shift;
 965   qsearch('part_pkg_vendor', { 'pkgpart' => $self->pkgpart } );
 966 }
 967
 968 =item vendor_pkg_ids
 969
 970 Returns a list of vendor/external package ids by exportnum
 971
 972 =cut
 973
 974 sub vendor_pkg_ids {
 975   my $self = shift;
 976   map { $_->exportnum => $_->vendor_pkg_id } $self->part_pkg_vendor;
 977 }
 978
 979 =item part_pkg_option
 980
 981 Returns all options as FS::part_pkg_option objects (see
 982 L<FS::part_pkg_option>).
 983
 984 =cut
 985
 986 sub part_pkg_option {
 987   my $self = shift;
 988   qsearch('part_pkg_option', { 'pkgpart' => $self->pkgpart } );
 989 }
 990
 991 =item options
 992
 993 Returns a list of option names and values suitable for assigning to a hash.
 994
 995 =cut
 996
 997 sub options {
 998   my $self = shift;
 999   map { $_->optionname => $_->optionvalue } $self->part_pkg_option;
1000 }
1001
1002 =item option OPTIONNAME [ QUIET ]
1003
1004 Returns the option value for the given name, or the empty string.  If a true
1005 value is passed as the second argument, warnings about missing the option
1006 will be suppressed.
1007
1008 =cut
1009
1010 sub option {
1011   my( $self, $opt, $ornull ) = @_;
1012   my $part_pkg_option =
1013     qsearchs('part_pkg_option', {
1014       pkgpart    => $self->pkgpart,
1015       optionname => $opt,
1016   } );
1017   return $part_pkg_option->optionvalue if $part_pkg_option;
1018   my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); }
1019                      split("\n", $self->get('plandata') );
1020   return $plandata{$opt} if exists $plandata{$opt};
1021   cluck "WARNING: (pkgpart ". $self->pkgpart. ") Package def option $opt ".
1022         "not found in options or plandata!\n"
1023     unless $ornull;
1024   '';
1025 }
1026
1027 =item bill_part_pkg_link
1028
1029 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1030
1031 =cut
1032
1033 sub bill_part_pkg_link {
1034   shift->_part_pkg_link('bill', @_);
1035 }
1036
1037 =item svc_part_pkg_link
1038
1039 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1040
1041 =cut
1042
1043 sub svc_part_pkg_link {
1044   shift->_part_pkg_link('svc', @_);
1045 }
1046
1047 sub _part_pkg_link {
1048   my( $self, $type ) = @_;
1049   qsearch({ table    => 'part_pkg_link',
1050             hashref  => { 'src_pkgpart' => $self->pkgpart,
1051                           'link_type'   => $type,
1052                           #protection against infinite recursive links
1053                           'dst_pkgpart' => { op=>'!=', value=> $self->pkgpart },
1054                         },
1055             order_by => "ORDER BY hidden",
1056          });
1057 }
1058
1059 sub self_and_bill_linked {
1060   shift->_self_and_linked('bill', @_);
1061 }
1062
1063 sub _self_and_linked {
1064   my( $self, $type, $hidden ) = @_;
1065   $hidden ||= '';
1066
1067   my @result = ();
1068   foreach ( ( $self, map { $_->dst_pkg->_self_and_linked($type, $_->hidden) }
1069                      $self->_part_pkg_link($type) ) )
1070   {
1071     $_->hidden($hidden) if $hidden;
1072     push @result, $_;
1073   }
1074
1075   (@result);
1076 }
1077
1078 =item part_pkg_taxoverride [ CLASS ]
1079
1080 Returns all associated FS::part_pkg_taxoverride objects (see
1081 L<FS::part_pkg_taxoverride>).  Limits the returned set to those
1082 of class CLASS if defined.  Class may be one of 'setup', 'recur',
1083 the empty string (default), or a usage class number (see L<FS::usage_class>).
1084 When a class is specified, the empty string class (default) is returned
1085 if no more specific values exist.
1086
1087 =cut
1088
1089 sub part_pkg_taxoverride {
1090   my $self = shift;
1091   my $class = shift;
1092
1093   my $hashref = { 'pkgpart' => $self->pkgpart };
1094   $hashref->{'usage_class'} = $class if defined($class);
1095   my @overrides = qsearch('part_pkg_taxoverride', $hashref );
1096
1097   unless ( scalar(@overrides) || !defined($class) || !$class ){
1098     $hashref->{'usage_class'} = '';
1099     @overrides = qsearch('part_pkg_taxoverride', $hashref );
1100   }
1101
1102   @overrides;
1103 }
1104
1105 =item has_taxproduct
1106
1107 Returns true if this package has any taxproduct associated with it.
1108
1109 =cut
1110
1111 sub has_taxproduct {
1112   my $self = shift;
1113
1114   $self->taxproductnum ||
1115   scalar( grep { $_ =~/^usage_taxproductnum_/ && $self->option($_) }
1116           keys %{ {$self->options} }
1117   )
1118
1119 }
1120
1121
1122 =item taxproduct [ CLASS ]
1123
1124 Returns the associated tax product for this package definition (see
1125 L<FS::part_pkg_taxproduct>).  CLASS may be one of 'setup', 'recur' or
1126 the usage classnum (see L<FS::usage_class>).  Returns the default
1127 tax product for this record if the more specific CLASS value does
1128 not exist.
1129
1130 =cut
1131
1132 sub taxproduct {
1133   my $self = shift;
1134   my $class = shift;
1135
1136   my $part_pkg_taxproduct;
1137
1138   my $taxproductnum = $self->taxproductnum;
1139   if ($class) {
1140     my $class_taxproductnum = $self->option("usage_taxproductnum_$class", 1);
1141     $taxproductnum = $class_taxproductnum
1142       if $class_taxproductnum
1143   }
1144
1145   $part_pkg_taxproduct =
1146     qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1147
1148   unless ($part_pkg_taxproduct || $taxproductnum eq $self->taxproductnum ) {
1149     $taxproductnum = $self->taxproductnum;
1150     $part_pkg_taxproduct =
1151       qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1152   }
1153
1154   $part_pkg_taxproduct;
1155 }
1156
1157 =item taxproduct_description [ CLASS ]
1158
1159 Returns the description of the associated tax product for this package
1160 definition (see L<FS::part_pkg_taxproduct>).
1161
1162 =cut
1163
1164 sub taxproduct_description {
1165   my $self = shift;
1166   my $part_pkg_taxproduct = $self->taxproduct(@_);
1167   $part_pkg_taxproduct ? $part_pkg_taxproduct->description : '';
1168 }
1169
1170 =item part_pkg_taxrate DATA_PROVIDER, GEOCODE, [ CLASS ]
1171
1172 Returns the package to taxrate m2m records for this package in the location
1173 specified by GEOCODE (see L<FS::part_pkg_taxrate>) and usage class CLASS.
1174 CLASS may be one of 'setup', 'recur', or one of the usage classes numbers
1175 (see L<FS::usage_class>).
1176
1177 =cut
1178
1179 sub _expand_cch_taxproductnum {
1180   my $self = shift;
1181   my $class = shift;
1182   my $part_pkg_taxproduct = $self->taxproduct($class);
1183
1184   my ($a,$b,$c,$d) = ( $part_pkg_taxproduct
1185                          ? ( split ':', $part_pkg_taxproduct->taxproduct )
1186                          : ()
1187                      );
1188   $a = '' unless $a; $b = '' unless $b; $c = '' unless $c; $d = '' unless $d;
1189   my $extra_sql = "AND ( taxproduct = '$a:$b:$c:$d'
1190                       OR taxproduct = '$a:$b:$c:'
1191                       OR taxproduct = '$a:$b:".":$d'
1192                       OR taxproduct = '$a:$b:".":' )";
1193   map { $_->taxproductnum } qsearch( { 'table'     => 'part_pkg_taxproduct',
1194                                        'hashref'   => { 'data_vendor'=>'cch' },
1195                                        'extra_sql' => $extra_sql,
1196                                    } );
1197
1198 }
1199
1200 sub part_pkg_taxrate {
1201   my $self = shift;
1202   my ($data_vendor, $geocode, $class) = @_;
1203
1204   my $dbh = dbh;
1205   my $extra_sql = 'WHERE part_pkg_taxproduct.data_vendor = '.
1206                   dbh->quote($data_vendor);
1207
1208   # CCH oddness in m2m
1209   $extra_sql .= ' AND ('.
1210     join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
1211                  qw(10 5 2)
1212         ).
1213     ')';
1214   # much more CCH oddness in m2m -- this is kludgy
1215   my @tpnums = $self->_expand_cch_taxproductnum($class);
1216   if (scalar(@tpnums)) {
1217     $extra_sql .= ' AND ('.
1218                             join(' OR ', map{ "taxproductnum = $_" } @tpnums ).
1219                        ')';
1220   } else {
1221     $extra_sql .= ' AND ( 0 = 1 )';
1222   }
1223
1224   my $addl_from = 'LEFT JOIN part_pkg_taxproduct USING ( taxproductnum )';
1225   my $order_by = 'ORDER BY taxclassnum, length(geocode) desc, length(taxproduct) desc';
1226   my $select   = 'DISTINCT ON(taxclassnum) *, taxproduct';
1227
1228   # should qsearch preface columns with the table to facilitate joins?
1229   qsearch( { 'table'     => 'part_pkg_taxrate',
1230              'select'    => $select,
1231              'hashref'   => { # 'data_vendor'   => $data_vendor,
1232                               # 'taxproductnum' => $self->taxproductnum,
1233                             },
1234              'addl_from' => $addl_from,
1235              'extra_sql' => $extra_sql,
1236              'order_by'  => $order_by,
1237          } );
1238 }
1239
1240 =item part_pkg_discount
1241
1242 Returns the package to discount m2m records (see L<FS::part_pkg_discount>)
1243 for this package.
1244
1245 =cut
1246
1247 sub part_pkg_discount {
1248   my $self = shift;
1249   qsearch('part_pkg_discount', { 'pkgpart' => $self->pkgpart });
1250 }
1251
1252 =item _rebless
1253
1254 Reblesses the object into the FS::part_pkg::PLAN class (if available), where
1255 PLAN is the object's I<plan> field.  There should be better docs
1256 on how to create new price plans, but until then, see L</NEW PLAN CLASSES>.
1257
1258 =cut
1259
1260 sub _rebless {
1261   my $self = shift;
1262   my $plan = $self->plan;
1263   unless ( $plan ) {
1264     cluck "no price plan found for pkgpart ". $self->pkgpart. "\n"
1265       if $DEBUG;
1266     return $self;
1267   }
1268   return $self if ref($self) =~ /::$plan$/; #already blessed into plan subclass
1269   my $class = ref($self). "::$plan";
1270   warn "reblessing $self into $class" if $DEBUG;
1271   eval "use $class;";
1272   die $@ if $@;
1273   bless($self, $class) unless $@;
1274   $self;
1275 }
1276
1277 #fallbacks that eval the setup and recur fields, for backwards compat
1278
1279 sub calc_setup {
1280   my $self = shift;
1281   warn 'no price plan class for '. $self->plan. ", eval-ing setup\n";
1282   $self->_calc_eval('setup', @_);
1283 }
1284
1285 sub calc_recur {
1286   my $self = shift;
1287   warn 'no price plan class for '. $self->plan. ", eval-ing recur\n";
1288   $self->_calc_eval('recur', @_);
1289 }
1290
1291 use vars qw( $sdate @details );
1292 sub _calc_eval {
1293   #my( $self, $field, $cust_pkg ) = @_;
1294   my( $self, $field, $cust_pkg, $sdateref, $detailsref ) = @_;
1295   *sdate = $sdateref;
1296   *details = $detailsref;
1297   $self->$field() =~ /^(.*)$/
1298     or die "Illegal $field (pkgpart ". $self->pkgpart. '): '.
1299             $self->$field(). "\n";
1300   my $prog = $1;
1301   return 0 if $prog =~ /^\s*$/;
1302   my $value = eval $prog;
1303   die $@ if $@;
1304   $value;
1305 }
1306
1307 #fallback that return 0 for old legacy packages with no plan
1308
1309 sub calc_remain { 0; }
1310 sub calc_cancel { 0; }
1311 sub calc_units  { 0; }
1312
1313 #fallback for everything except bulk.pm
1314 sub hide_svc_detail { 0; }
1315
1316 =item recur_cost_permonth CUST_PKG
1317
1318 recur_cost divided by freq (only supported for monthly and longer frequencies)
1319
1320 =cut
1321
1322 sub recur_cost_permonth {
1323   my($self, $cust_pkg) = @_;
1324   return 0 unless $self->freq =~ /^\d+$/ && $self->freq > 0;
1325   sprintf('%.2f', $self->recur_cost / $self->freq );
1326 }
1327
1328 =item format OPTION DATA
1329
1330 Returns data formatted according to the function 'format' described
1331 in the plan info.  Returns DATA if no such function exists.
1332
1333 =cut
1334
1335 sub format {
1336   my ($self, $option, $data) = (shift, shift, shift);
1337   if (exists($plans{$self->plan}->{fields}->{$option}{format})) {
1338     &{$plans{$self->plan}->{fields}->{$option}{format}}($data);
1339   }else{
1340     $data;
1341   }
1342 }
1343
1344 =item parse OPTION DATA
1345
1346 Returns data parsed according to the function 'parse' described
1347 in the plan info.  Returns DATA if no such function exists.
1348
1349 =cut
1350
1351 sub parse {
1352   my ($self, $option, $data) = (shift, shift, shift);
1353   if (exists($plans{$self->plan}->{fields}->{$option}{parse})) {
1354     &{$plans{$self->plan}->{fields}->{$option}{parse}}($data);
1355   }else{
1356     $data;
1357   }
1358 }
1359
1360 =back
1361
1362 =cut
1363
1364 =head1 CLASS METHODS
1365
1366 =over 4
1367
1368 =cut
1369
1370 # _upgrade_data
1371 #
1372 # Used by FS::Upgrade to migrate to a new database.
1373
1374 sub _upgrade_data { # class method
1375   my($class, %opts) = @_;
1376
1377   warn "[FS::part_pkg] upgrading $class\n" if $DEBUG;
1378
1379   my @part_pkg = qsearch({
1380     'table'     => 'part_pkg',
1381     'extra_sql' => "WHERE ". join(' OR ',
1382                      ( map "($_ IS NOT NULL AND $_ != '' )",
1383                            qw( plandata setup recur ) ),
1384                      'plan IS NULL', "plan = '' ",
1385                    ),
1386   });
1387
1388   foreach my $part_pkg (@part_pkg) {
1389
1390     unless ( $part_pkg->plan ) {
1391       $part_pkg->plan('flat');
1392     }
1393
1394     if ( length($part_pkg->option('setup_fee')) == 0
1395          && $part_pkg->setup =~ /^\s*([\d\.]+)\s*$/ ) {
1396
1397       my $opt = new FS::part_pkg_option {
1398         'pkgpart'     => $part_pkg->pkgpart,
1399         'optionname'  => 'setup_fee',
1400         'optionvalue' => $1,
1401       };
1402       my $error = $opt->insert;
1403       die $error if $error;
1404
1405
1406       #} else {
1407       #  die "Can't parse part_pkg.setup for fee; convert pkgnum ".
1408       #      $part_pkg->pkgnum. " manually: ". $part_pkg->setup. "\n";
1409     }
1410     $part_pkg->setup('');
1411
1412     if ( length($part_pkg->option('recur_fee')) == 0
1413          && $part_pkg->recur =~ /^\s*([\d\.]+)\s*$/ ) {
1414
1415         my $opt = new FS::part_pkg_option {
1416           'pkgpart'     => $part_pkg->pkgpart,
1417           'optionname'  => 'recur_fee',
1418           'optionvalue' => $1,
1419         };
1420         my $error = $opt->insert;
1421         die $error if $error;
1422
1423
1424       #} else {
1425       #  die "Can't parse part_pkg.setup for fee; convert pkgnum ".
1426       #      $part_pkg->pkgnum. " manually: ". $part_pkg->setup. "\n";
1427     }
1428     $part_pkg->recur('');
1429
1430     $part_pkg->replace; #this should take care of plandata, right?
1431
1432   }
1433
1434   # now upgrade to the explicit custom flag
1435
1436   @part_pkg = qsearch({
1437     'table'     => 'part_pkg',
1438     'hashref'   => { disabled => 'Y', custom => '' },
1439     'extra_sql' => "AND comment LIKE '(CUSTOM) %'",
1440   });
1441
1442   foreach my $part_pkg (@part_pkg) {
1443     my $new = new FS::part_pkg { $part_pkg->hash };
1444     $new->custom('Y');
1445     my $comment = $part_pkg->comment;
1446     $comment =~ s/^\(CUSTOM\) //;
1447     $comment = '(none)' unless $comment =~ /\S/;
1448     $new->comment($comment);
1449
1450     my $pkg_svc = { map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc };
1451     my $primary = $part_pkg->svcpart;
1452     my $options = { $part_pkg->options };
1453
1454     my $error = $new->replace( $part_pkg,
1455                                'pkg_svc'     => $pkg_svc,
1456                                'primary_svc' => $primary,
1457                                'options'     => $options,
1458                              );
1459     die $error if $error;
1460   }
1461
1462   my @part_pkg_option = qsearch('part_pkg_option',
1463     { 'optionname'  => 'unused_credit',
1464       'optionvalue' => 1,
1465     });
1466   foreach my $old_opt (@part_pkg_option) {
1467     my $pkgpart = $old_opt->pkgpart;
1468     my $error = $old_opt->delete;
1469     die $error if $error;
1470
1471     foreach (qw(unused_credit_cancel unused_credit_change)) {
1472       my $new_opt = new FS::part_pkg_option {
1473         'pkgpart'     => $pkgpart,
1474         'optionname'  => $_,
1475         'optionvalue' => 1,
1476       };
1477       $error = $new_opt->insert;
1478       die $error if $error;
1479     }
1480   }
1481 }
1482
1483 =item curuser_pkgs_sql
1484
1485 Returns an SQL fragment for searching for packages the current user can
1486 use, either via part_pkg.agentnum directly, or via agent type (see
1487 L<FS::type_pkgs>).
1488
1489 =cut
1490
1491 sub curuser_pkgs_sql {
1492   my $class = shift;
1493
1494   $class->_pkgs_sql( $FS::CurrentUser::CurrentUser->agentnums );
1495
1496 }
1497
1498 =item agent_pkgs_sql AGENT | AGENTNUM, ...
1499
1500 Returns an SQL fragment for searching for packages the provided agent or agents
1501 can use, either via part_pkg.agentnum directly, or via agent type (see
1502 L<FS::type_pkgs>).
1503
1504 =cut
1505
1506 sub agent_pkgs_sql {
1507   my $class = shift;  #i'm a class method, not a sub (the question is... why??)
1508   my @agentnums = map { ref($_) ? $_->agentnum : $_ } @_;
1509
1510   $class->_pkgs_sql(@agentnums); #is this why
1511
1512 }
1513
1514 sub _pkgs_sql {
1515   my( $class, @agentnums ) = @_;
1516   my $agentnums = join(',', @agentnums);
1517
1518   "
1519     (
1520       ( agentnum IS NOT NULL AND agentnum IN ($agentnums) )
1521       OR ( agentnum IS NULL
1522            AND EXISTS ( SELECT 1
1523                           FROM type_pkgs
1524                             LEFT JOIN agent_type USING ( typenum )
1525                             LEFT JOIN agent AS typeagent USING ( typenum )
1526                           WHERE type_pkgs.pkgpart = part_pkg.pkgpart
1527                             AND typeagent.agentnum IN ($agentnums)
1528                       )
1529          )
1530     )
1531   ";
1532
1533 }
1534
1535 =back
1536
1537 =head1 SUBROUTINES
1538
1539 =over 4
1540
1541 =item plan_info
1542
1543 =cut
1544
1545 #false laziness w/part_export & cdr
1546 my %info;
1547 foreach my $INC ( @INC ) {
1548   warn "globbing $INC/FS/part_pkg/*.pm\n" if $DEBUG;
1549   foreach my $file ( glob("$INC/FS/part_pkg/*.pm") ) {
1550     warn "attempting to load plan info from $file\n" if $DEBUG;
1551     $file =~ /\/(\w+)\.pm$/ or do {
1552       warn "unrecognized file in $INC/FS/part_pkg/: $file\n";
1553       next;
1554     };
1555     my $mod = $1;
1556     my $info = eval "use FS::part_pkg::$mod; ".
1557                     "\\%FS::part_pkg::$mod\::info;";
1558     if ( $@ ) {
1559       die "error using FS::part_pkg::$mod (skipping): $@\n" if $@;
1560       next;
1561     }
1562     unless ( keys %$info ) {
1563       warn "no %info hash found in FS::part_pkg::$mod, skipping\n";
1564       next;
1565     }
1566     warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG;
1567     #if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
1568     #  warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG;
1569     #  next;
1570     #}
1571     $info{$mod} = $info;
1572     $info->{'weight'} ||= 0; # quiet warnings
1573   }
1574 }
1575
1576 # copy one level deep to allow replacement of fields and fieldorder
1577 tie %plans, 'Tie::IxHash',
1578   map  { my %infohash = %{ $info{$_} };
1579           $_ => \%infohash }
1580   sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} }
1581   keys %info;
1582
1583 # inheritance of plan options
1584 foreach my $name (keys(%info)) {
1585   if (exists($info{$name}->{'disabled'}) and $info{$name}->{'disabled'}) {
1586     warn "skipping disabled plan FS::part_pkg::$name" if $DEBUG;
1587     delete $plans{$name};
1588     next;
1589   }
1590   my $parents = $info{$name}->{'inherit_fields'} || [];
1591   my (%fields, %field_exists, @fieldorder);
1592   foreach my $parent ($name, @$parents) {
1593     %fields = ( # avoid replacing existing fields
1594       %{ $info{$parent}->{'fields'} || {} },
1595       %fields
1596     );
1597     foreach (@{ $info{$parent}->{'fieldorder'} || [] }) {
1598       # avoid duplicates
1599       next if $field_exists{$_};
1600       $field_exists{$_} = 1;
1601       # allow inheritors to remove inherited fields from the fieldorder
1602       push @fieldorder, $_ if !exists($fields{$_}->{'disabled'});
1603     }
1604   }
1605   $plans{$name}->{'fields'} = \%fields;
1606   $plans{$name}->{'fieldorder'} = \@fieldorder;
1607 }
1608
1609 sub plan_info {
1610   \%plans;
1611 }
1612
1613
1614 =back
1615
1616 =head1 NEW PLAN CLASSES
1617
1618 A module should be added in FS/FS/part_pkg/  Eventually, an example may be
1619 found in eg/plan_template.pm.  Until then, it is suggested that you use the
1620 other modules in FS/FS/part_pkg/ as a guide.
1621
1622 =head1 BUGS
1623
1624 The delete method is unimplemented.
1625
1626 setup and recur semantics are not yet defined (and are implemented in
1627 FS::cust_bill.  hmm.).  now they're deprecated and need to go.
1628
1629 plandata should go
1630
1631 part_pkg_taxrate is Pg specific
1632
1633 replace should be smarter about managing the related tables (options, pkg_svc)
1634
1635 =head1 SEE ALSO
1636
1637 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
1638 schema.html from the base documentation.
1639
1640 =cut
1641
1642 1;
1643