FS/FS/part_pkg.pm

   1 package FS::part_pkg;
   2 use base qw( FS::part_pkg::API
   3              FS::m2m_Common FS::o2m_Common FS::option_Common
   4            );
   5
   6 use strict;
   7 use vars qw( %plans $DEBUG $setup_hack $skip_pkg_svc_hack
   8              $cache_enabled %cache_link %cache_pkg_svc
   9            );
  10 use Carp qw(carp cluck confess);
  11 use Scalar::Util qw( blessed );
  12 use DateTime;
  13 use Time::Local qw( timelocal timelocal_nocheck ); # eventually replace with DateTime
  14 use Tie::IxHash;
  15 use FS::Conf;
  16 use FS::Record qw( qsearch qsearchs dbh dbdef );
  17 use FS::Cursor; # for upgrade
  18 use FS::pkg_svc;
  19 use FS::part_svc;
  20 use FS::cust_pkg;
  21 use FS::agent_type;
  22 use FS::type_pkgs;
  23 use FS::part_pkg_option;
  24 use FS::part_pkg_fcc_option;
  25 use FS::pkg_class;
  26 use FS::agent;
  27 use FS::part_pkg_msgcat;
  28 use FS::part_pkg_taxrate;
  29 use FS::part_pkg_taxoverride;
  30 use FS::part_pkg_taxproduct;
  31 use FS::part_pkg_link;
  32 use FS::part_pkg_discount;
  33 use FS::part_pkg_vendor;
  34 use FS::part_pkg_currency;
  35 use FS::part_svc_link;
  36
  37 $DEBUG = 0;
  38
  39 $setup_hack = 0;
  40 $skip_pkg_svc_hack = 0;
  41
  42 $cache_enabled = 0;
  43 %cache_link = ();
  44 %cache_pkg_svc = ();
  45
  46 =head1 NAME
  47
  48 FS::part_pkg - Object methods for part_pkg objects
  49
  50 =head1 SYNOPSIS
  51
  52   use FS::part_pkg;
  53
  54   $record = new FS::part_pkg \%hash
  55   $record = new FS::part_pkg { 'column' => 'value' };
  56
  57   $custom_record = $template_record->clone;
  58
  59   $error = $record->insert;
  60
  61   $error = $new_record->replace($old_record);
  62
  63   $error = $record->delete;
  64
  65   $error = $record->check;
  66
  67   @pkg_svc = $record->pkg_svc;
  68
  69   $svcnum = $record->svcpart;
  70   $svcnum = $record->svcpart( 'svc_acct' );
  71
  72 =head1 DESCRIPTION
  73
  74 An FS::part_pkg object represents a package definition.  FS::part_pkg
  75 inherits from FS::Record.  The following fields are currently supported:
  76
  77 =over 4
  78
  79 =item pkgpart - primary key (assigned automatically for new package definitions)
  80
  81 =item pkg - Text name of this package definition (customer-viewable)
  82
  83 =item comment - Text name of this package definition (non-customer-viewable)
  84
  85 =item classnum - Optional package class (see L<FS::pkg_class>)
  86
  87 =item promo_code - Promotional code
  88
  89 =item setup - Setup fee expression (deprecated)
  90
  91 =item freq - Frequency of recurring fee
  92
  93 =item recur - Recurring fee expression (deprecated)
  94
  95 =item setuptax - Setup fee tax exempt flag, empty or `Y'
  96
  97 =item recurtax - Recurring fee tax exempt flag, empty or `Y'
  98
  99 =item taxclass - Tax class
 100
 101 =item plan - Price plan
 102
 103 =item plandata - Price plan data (deprecated - see L<FS::part_pkg_option> instead)
 104
 105 =item disabled - Disabled flag, empty or `Y'
 106
 107 =item custom - Custom flag, empty or `Y'
 108
 109 =item setup_cost - for cost tracking
 110
 111 =item recur_cost - for cost tracking
 112
 113 =item pay_weight - Weight (relative to credit_weight and other package definitions) that controls payment application to specific line items.
 114
 115 =item credit_weight - Weight (relative to other package definitions) that controls credit application to specific line items.
 116
 117 =item agentnum - Optional agentnum (see L<FS::agent>)
 118
 119 =item fcc_ds0s - Optional DS0 equivalency number for FCC form 477
 120
 121 =item fcc_voip_class - Which column of FCC form 477 part II.B this package
 122 belongs in.
 123
 124 =item successor - Foreign key for the part_pkg that replaced this record.
 125 If this record is not obsolete, will be null.
 126
 127 =item family_pkgpart - Foreign key for the part_pkg that was the earliest
 128 ancestor of this record.  If this record is not a successor to another
 129 part_pkg, will be equal to pkgpart.
 130
 131 =item delay_start - Number of days to delay package start, by default
 132
 133 =item start_on_hold - 'Y' to suspend this package immediately when it is
 134 ordered. The package will not start billing or have a setup fee charged
 135 until it is manually unsuspended.
 136
 137 =item change_to_pkgpart - When this package is ordered, schedule a future
 138 package change. The 'expire_months' field will determine when the package
 139 change occurs.
 140
 141 =item expire_months - Number of months until this package expires (or changes
 142 to another package).
 143
 144 =item adjourn_months - Number of months until this package becomes suspended.
 145
 146 =item contract_end_months - Number of months until the package's contract
 147 ends.
 148
 149 =back
 150
 151 =head1 METHODS
 152
 153 =over 4
 154
 155 =item new HASHREF
 156
 157 Creates a new package definition.  To add the package definition to
 158 the database, see L<"insert">.
 159
 160 =cut
 161
 162 sub table { 'part_pkg'; }
 163
 164 =item clone
 165
 166 An alternate constructor.  Creates a new package definition by duplicating
 167 an existing definition.  A new pkgpart is assigned and the custom flag is
 168 set to Y.  To add the package definition to the database, see L<"insert">.
 169
 170 =cut
 171
 172 sub clone {
 173   my $self = shift;
 174   my $class = ref($self);
 175   my %hash = $self->hash;
 176   $hash{'pkgpart'} = '';
 177   $hash{'custom'} = 'Y';
 178   #new FS::part_pkg ( \%hash ); # ?
 179   new $class ( \%hash ); # ?
 180 }
 181
 182 =item insert [ , OPTION => VALUE ... ]
 183
 184 Adds this package definition to the database.  If there is an error,
 185 returns the error, otherwise returns false.
 186
 187 Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg>,
 188 I<custnum_ref> and I<options>.
 189
 190 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
 191 values, appropriate FS::pkg_svc records will be inserted.  I<hidden_svc> can
 192 be set to a hashref of svcparts and flag values ('Y' or '') to set the
 193 'hidden' field in these records, and I<provision_hold> can be set similarly
 194 for the 'provision_hold' field in these records.
 195
 196 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
 197 FS::pkg_svc record will be updated.
 198
 199 If I<cust_pkg> is set to a pkgnum of a FS::cust_pkg record (or the FS::cust_pkg
 200 record itself), the object will be updated to point to this package definition.
 201
 202 In conjunction with I<cust_pkg>, if I<custnum_ref> is set to a scalar reference,
 203 the scalar will be updated with the custnum value from the cust_pkg record.
 204
 205 If I<tax_overrides> is set to a hashref with usage classes as keys and comma
 206 separated tax class numbers as values, appropriate FS::part_pkg_taxoverride
 207 records will be inserted.
 208
 209 If I<options> is set to a hashref of options, appropriate FS::part_pkg_option
 210 records will be inserted.
 211
 212 If I<part_pkg_currency> is set to a hashref of options (with the keys as
 213 option_CURRENCY), appropriate FS::part_pkg::currency records will be inserted.
 214
 215 =cut
 216
 217 sub insert {
 218   my $self = shift;
 219   my %options = @_;
 220   warn "FS::part_pkg::insert called on $self with options ".
 221        join(', ', map "$_=>$options{$_}", keys %options)
 222     if $DEBUG;
 223
 224   local $SIG{HUP} = 'IGNORE';
 225   local $SIG{INT} = 'IGNORE';
 226   local $SIG{QUIT} = 'IGNORE';
 227   local $SIG{TERM} = 'IGNORE';
 228   local $SIG{TSTP} = 'IGNORE';
 229   local $SIG{PIPE} = 'IGNORE';
 230
 231   my $oldAutoCommit = $FS::UID::AutoCommit;
 232   local $FS::UID::AutoCommit = 0;
 233   my $dbh = dbh;
 234
 235   if ( length($self->classnum) && $self->classnum !~ /^(\d+)$/ ) {
 236     my $pkg_class = qsearchs('pkg_class', { 'classname' => $self->classnum } )
 237                  || new FS::pkg_class { classname => $self->classnum };
 238     unless ( $pkg_class->classnum ) {
 239       my $error = $pkg_class->insert;
 240       if ( $error ) {
 241         $dbh->rollback if $oldAutoCommit;
 242         return $error;
 243       }
 244     }
 245     $self->classnum( $pkg_class->classnum );
 246   }
 247
 248   warn "  inserting part_pkg record" if $DEBUG;
 249   my $error = $self->SUPER::insert( $options{options} );
 250   if ( $error ) {
 251     $dbh->rollback if $oldAutoCommit;
 252     return $error;
 253   }
 254
 255   # set family_pkgpart
 256   if ( $self->get('family_pkgpart') eq '' ) {
 257     $self->set('family_pkgpart' => $self->pkgpart);
 258     $error = $self->SUPER::replace;
 259     if ( $error ) {
 260       $dbh->rollback if $oldAutoCommit;
 261       return $error;
 262     }
 263   }
 264
 265   warn "  inserting part_pkg_taxoverride records" if $DEBUG;
 266   my %overrides = %{ $options{'tax_overrides'} || {} };
 267   foreach my $usage_class ( keys %overrides ) {
 268     my $override =
 269       ( exists($overrides{$usage_class}) && defined($overrides{$usage_class}) )
 270         ? $overrides{$usage_class}
 271         : '';
 272     my @overrides = (grep "$_", split(',', $override) );
 273     my $error = $self->process_m2m (
 274                   'link_table'   => 'part_pkg_taxoverride',
 275                   'target_table' => 'tax_class',
 276                   'hashref'      => { 'usage_class' => $usage_class },
 277                   'params'       => \@overrides,
 278                 );
 279     if ( $error ) {
 280       $dbh->rollback if $oldAutoCommit;
 281       return $error;
 282     }
 283   }
 284
 285   warn "  inserting part_pkg_currency records" if $DEBUG;
 286   my %part_pkg_currency = %{ $options{'part_pkg_currency'} || {} };
 287   foreach my $key ( keys %part_pkg_currency ) {
 288     $key =~ /^(.+)_([A-Z]{3})$/ or next;
 289     my( $optionname, $currency ) = ( $1, $2 );
 290     if ( $part_pkg_currency{$key} =~ /^\s*$/ ) {
 291       if ( $self->option($optionname) == 0 ) {
 292         $part_pkg_currency{$key} = '0';
 293       } else {
 294         $dbh->rollback if $oldAutoCommit;
 295         ( my $thing = $optionname ) =~ s/_/ /g;
 296         return ucfirst($thing). " $currency is required";
 297       }
 298     }
 299     my $part_pkg_currency = new FS::part_pkg_currency {
 300       'pkgpart'     => $self->pkgpart,
 301       'optionname'  => $optionname,
 302       'currency'    => $currency,
 303       'optionvalue' => $part_pkg_currency{$key},
 304     };
 305     my $error = $part_pkg_currency->insert;
 306     if ( $error ) {
 307       $dbh->rollback if $oldAutoCommit;
 308       return $error;
 309     }
 310   }
 311
 312   unless ( $skip_pkg_svc_hack ) {
 313
 314     warn "  inserting pkg_svc records" if $DEBUG;
 315     my $pkg_svc = $options{'pkg_svc'} || {};
 316     my $hidden_svc = $options{'hidden_svc'} || {};
 317     my $provision_hold = $options{'provision_hold'} || {};
 318     foreach my $part_svc ( qsearch('part_svc', {} ) ) {
 319       my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
 320       my $primary_svc =
 321         ( $options{'primary_svc'} && $options{'primary_svc'}==$part_svc->svcpart )
 322           ? 'Y'
 323           : '';
 324
 325       my $pkg_svc = new FS::pkg_svc( {
 326         'pkgpart'     => $self->pkgpart,
 327         'svcpart'     => $part_svc->svcpart,
 328         'quantity'    => $quantity,
 329         'primary_svc' => $primary_svc,
 330         'hidden'      => $hidden_svc->{$part_svc->svcpart},
 331         'provision_hold' => $provision_hold->{$part_svc->svcpart},
 332       } );
 333       my $error = $pkg_svc->insert;
 334       if ( $error ) {
 335         $dbh->rollback if $oldAutoCommit;
 336         return $error;
 337       }
 338     }
 339
 340     my $error = $self->check_pkg_svc(%options);
 341     if ( $error ) {
 342       $dbh->rollback if $oldAutoCommit;
 343       return $error;
 344     }
 345
 346   }
 347
 348   if ( $options{'cust_pkg'} ) {
 349     warn "  updating cust_pkg record " if $DEBUG;
 350     my $old_cust_pkg =
 351       ref($options{'cust_pkg'})
 352         ? $options{'cust_pkg'}
 353         : qsearchs('cust_pkg', { pkgnum => $options{'cust_pkg'} } );
 354     ${ $options{'custnum_ref'} } = $old_cust_pkg->custnum
 355       if $options{'custnum_ref'};
 356     my %hash = $old_cust_pkg->hash;
 357     $hash{'pkgpart'} = $self->pkgpart,
 358     my $new_cust_pkg = new FS::cust_pkg \%hash;
 359     local($FS::cust_pkg::disable_agentcheck) = 1;
 360     my $error = $new_cust_pkg->replace($old_cust_pkg);
 361     if ( $error ) {
 362       $dbh->rollback if $oldAutoCommit;
 363       return "Error modifying cust_pkg record: $error";
 364     }
 365   }
 366
 367   if ( $options{'part_pkg_vendor'} ) {
 368       while ( my ($exportnum, $vendor_pkg_id) =
 369                 each %{ $options{part_pkg_vendor} }
 370             )
 371       {
 372             my $ppv = new FS::part_pkg_vendor( {
 373                     'pkgpart' => $self->pkgpart,
 374                     'exportnum' => $exportnum,
 375                     'vendor_pkg_id' => $vendor_pkg_id,
 376                 } );
 377             my $error = $ppv->insert;
 378             if ( $error ) {
 379               $dbh->rollback if $oldAutoCommit;
 380               return "Error inserting part_pkg_vendor record: $error";
 381             }
 382       }
 383   }
 384
 385   if ( $options{fcc_options} ) {
 386     warn "  updating fcc options " if $DEBUG;
 387     $self->set_fcc_options( $options{fcc_options} );
 388   }
 389
 390   warn "  committing transaction" if $DEBUG and $oldAutoCommit;
 391   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 392
 393   '';
 394 }
 395
 396 =item delete
 397
 398 Currently unimplemented.
 399
 400 =cut
 401
 402 sub delete {
 403   return "Can't (yet?) delete package definitions.";
 404 # check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
 405 }
 406
 407 =item replace OLD_RECORD [ , OPTION => VALUE ... ]
 408
 409 Replaces OLD_RECORD with this one in the database.  If there is an error,
 410 returns the error, otherwise returns false.
 411
 412 Currently available options are: I<pkg_svc>, I<hidden_svc>, I<primary_svc>,
 413 I<bulk_skip>, I<provision_hold> and I<options>
 414
 415 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
 416 values, the appropriate FS::pkg_svc records will be replaced.  I<hidden_svc>
 417 can be set to a hashref of svcparts and flag values ('Y' or '') to set the
 418 'hidden' field in these records.  I<bulk_skip> and I<provision_hold> can be
 419 set to a hashref of svcparts and flag values ('Y' or '') to set the
 420 respective field in those records.
 421
 422 If I<primary_svc> is set to the svcpart of the primary service, the
 423 appropriate FS::pkg_svc record will be updated.
 424
 425 If I<options> is set to a hashref, the appropriate FS::part_pkg_option
 426 records will be replaced.
 427
 428 If I<part_pkg_currency> is set to a hashref of options (with the keys as
 429 option_CURRENCY), appropriate FS::part_pkg::currency records will be
 430 replaced.
 431
 432 =cut
 433
 434 sub replace {
 435   my $new = shift;
 436
 437   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 438               ? shift
 439               : $new->replace_old;
 440
 441   my $options =
 442     ( ref($_[0]) eq 'HASH' )
 443       ? shift
 444       : { @_ };
 445
 446   $options->{options} = { $old->options } unless defined($options->{options});
 447
 448   warn "FS::part_pkg::replace called on $new to replace $old with options".
 449        join(', ', map "$_ => ". $options->{$_}, keys %$options)
 450     if $DEBUG;
 451
 452   local $SIG{HUP} = 'IGNORE';
 453   local $SIG{INT} = 'IGNORE';
 454   local $SIG{QUIT} = 'IGNORE';
 455   local $SIG{TERM} = 'IGNORE';
 456   local $SIG{TSTP} = 'IGNORE';
 457   local $SIG{PIPE} = 'IGNORE';
 458
 459   my $oldAutoCommit = $FS::UID::AutoCommit;
 460   local $FS::UID::AutoCommit = 0;
 461   my $dbh = dbh;
 462
 463   my $conf = new FS::Conf;
 464   if ( $conf->exists('part_pkg-lineage') ) {
 465     if ( grep { $options->{options}->{$_} ne $old->option($_, 1) }
 466           qw(setup_fee recur_fee) #others? config?
 467         ) {
 468
 469       warn "  superseding package" if $DEBUG;
 470
 471       my $error = $new->supersede($old, %$options);
 472       if ( $error ) {
 473         $dbh->rollback if $oldAutoCommit;
 474         return $error;
 475       }
 476       else {
 477         warn "  committing transaction" if $DEBUG and $oldAutoCommit;
 478         $dbh->commit if $oldAutoCommit;
 479         return $error;
 480       }
 481     }
 482     #else nothing
 483   }
 484
 485   #plandata shit stays in replace for upgrades until after 2.0 (or edit
 486   #_upgrade_data)
 487   warn "  saving legacy plandata" if $DEBUG;
 488   my $plandata = $new->get('plandata');
 489   $new->set('plandata', '');
 490
 491   warn "  deleting old part_pkg_option records" if $DEBUG;
 492   foreach my $part_pkg_option ( $old->part_pkg_option ) {
 493     my $error = $part_pkg_option->delete;
 494     if ( $error ) {
 495       $dbh->rollback if $oldAutoCommit;
 496       return $error;
 497     }
 498   }
 499
 500   warn "  replacing part_pkg record" if $DEBUG;
 501   my $error = $new->SUPER::replace($old, $options->{options} );
 502   if ( $error ) {
 503     $dbh->rollback if $oldAutoCommit;
 504     return $error;
 505   }
 506
 507   warn "  inserting part_pkg_option records for plandata: $plandata|" if $DEBUG;
 508   foreach my $part_pkg_option (
 509     map { /^(\w+)=(.*)$/ or do { $dbh->rollback if $oldAutoCommit;
 510                                  return "illegal plandata: $plandata";
 511                                };
 512           new FS::part_pkg_option {
 513             'pkgpart'     => $new->pkgpart,
 514             'optionname'  => $1,
 515             'optionvalue' => $2,
 516           };
 517         }
 518     split("\n", $plandata)
 519   ) {
 520     my $error = $part_pkg_option->insert;
 521     if ( $error ) {
 522       $dbh->rollback if $oldAutoCommit;
 523       return $error;
 524     }
 525   }
 526
 527   #trivial nit: not the most efficient to delete and reinsert
 528   warn "  deleting old part_pkg_currency records" if $DEBUG;
 529   foreach my $part_pkg_currency ( $old->part_pkg_currency ) {
 530     my $error = $part_pkg_currency->delete;
 531     if ( $error ) {
 532       $dbh->rollback if $oldAutoCommit;
 533       return "error deleting part_pkg_currency record: $error";
 534     }
 535   }
 536
 537   warn "  inserting new part_pkg_currency records" if $DEBUG;
 538   my %part_pkg_currency = %{ $options->{'part_pkg_currency'} || {} };
 539   foreach my $key ( keys %part_pkg_currency ) {
 540     $key =~ /^(.+)_([A-Z]{3})$/ or next;
 541     my $part_pkg_currency = new FS::part_pkg_currency {
 542       'pkgpart'     => $new->pkgpart,
 543       'optionname'  => $1,
 544       'currency'    => $2,
 545       'optionvalue' => $part_pkg_currency{$key},
 546     };
 547     my $error = $part_pkg_currency->insert;
 548     if ( $error ) {
 549       $dbh->rollback if $oldAutoCommit;
 550       return "error inserting part_pkg_currency record: $error";
 551     }
 552   }
 553
 554
 555   warn "  replacing pkg_svc records" if $DEBUG;
 556   my $pkg_svc = $options->{'pkg_svc'};
 557   my $hidden_svc = $options->{'hidden_svc'} || {};
 558   my $bulk_skip  = $options->{'bulk_skip'} || {};
 559   my $provision_hold = $options->{'provision_hold'} || {};
 560   if ( $pkg_svc ) { # if it wasn't passed, don't change existing pkg_svcs
 561
 562     foreach my $part_svc ( qsearch('part_svc', {} ) ) {
 563       my $quantity  = $pkg_svc->{$part_svc->svcpart} || 0;
 564       my $hidden    = $hidden_svc->{$part_svc->svcpart} || '';
 565       my $bulk_skip = $bulk_skip->{$part_svc->svcpart} || '';
 566       my $provision_hold = $provision_hold->{$part_svc->svcpart} || '';
 567       my $primary_svc =
 568         ( defined($options->{'primary_svc'}) && $options->{'primary_svc'}
 569           && $options->{'primary_svc'} == $part_svc->svcpart
 570         )
 571           ? 'Y'
 572           : '';
 573
 574       my $old_pkg_svc = qsearchs('pkg_svc', {
 575           'pkgpart' => $old->pkgpart,
 576           'svcpart' => $part_svc->svcpart,
 577         }
 578       );
 579       my $old_quantity = 0;
 580       my $old_primary_svc = '';
 581       my $old_hidden = '';
 582       my $old_bulk_skip = '';
 583       my $old_provision_hold = '';
 584       if ( $old_pkg_svc ) {
 585         $old_quantity = $old_pkg_svc->quantity;
 586         $old_primary_svc = $old_pkg_svc->primary_svc
 587           if $old_pkg_svc->dbdef_table->column('primary_svc'); # is this needed?
 588         $old_hidden = $old_pkg_svc->hidden;
 589         $old_bulk_skip = $old_pkg_svc->old_bulk_skip; # should this just be bulk_skip?
 590         $old_provision_hold = $old_pkg_svc->provision_hold;
 591       }
 592
 593       next unless $old_quantity    != $quantity
 594                || $old_primary_svc ne $primary_svc
 595                || $old_hidden      ne $hidden
 596                || $old_bulk_skip   ne $bulk_skip
 597                || $old_provision_hold ne $provision_hold;
 598
 599       my $new_pkg_svc = new FS::pkg_svc( {
 600         'pkgsvcnum'   => ( $old_pkg_svc ? $old_pkg_svc->pkgsvcnum : '' ),
 601         'pkgpart'     => $new->pkgpart,
 602         'svcpart'     => $part_svc->svcpart,
 603         'quantity'    => $quantity,
 604         'primary_svc' => $primary_svc,
 605         'hidden'      => $hidden,
 606         'bulk_skip'   => $bulk_skip,
 607         'provision_hold' => $provision_hold,
 608       } );
 609       my $error = $old_pkg_svc
 610                     ? $new_pkg_svc->replace($old_pkg_svc)
 611                     : $new_pkg_svc->insert;
 612       if ( $error ) {
 613         $dbh->rollback if $oldAutoCommit;
 614         return $error;
 615       }
 616     } #foreach $part_svc
 617
 618     my $error = $new->check_pkg_svc(%$options);
 619     if ( $error ) {
 620       $dbh->rollback if $oldAutoCommit;
 621       return $error;
 622     }
 623
 624   } #if $options->{pkg_svc}
 625
 626   my @part_pkg_vendor = $old->part_pkg_vendor;
 627   my @current_exportnum = ();
 628   if ( $options->{'part_pkg_vendor'} ) {
 629       my($exportnum,$vendor_pkg_id);
 630       while ( ($exportnum,$vendor_pkg_id)
 631                                 = each %{$options->{'part_pkg_vendor'}} ) {
 632           my $noinsert = 0;
 633           foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
 634             if($exportnum == $part_pkg_vendor->exportnum
 635                 && $vendor_pkg_id ne $part_pkg_vendor->vendor_pkg_id) {
 636                 $part_pkg_vendor->vendor_pkg_id($vendor_pkg_id);
 637                 my $error = $part_pkg_vendor->replace;
 638                 if ( $error ) {
 639                   $dbh->rollback if $oldAutoCommit;
 640                   return "Error replacing part_pkg_vendor record: $error";
 641                 }
 642                 $noinsert = 1;
 643                 last;
 644             }
 645             elsif($exportnum == $part_pkg_vendor->exportnum
 646                 && $vendor_pkg_id eq $part_pkg_vendor->vendor_pkg_id) {
 647                 $noinsert = 1;
 648                 last;
 649             }
 650           }
 651           unless ( $noinsert ) {
 652             my $ppv = new FS::part_pkg_vendor( {
 653                     'pkgpart' => $new->pkgpart,
 654                     'exportnum' => $exportnum,
 655                     'vendor_pkg_id' => $vendor_pkg_id,
 656                 } );
 657             my $error = $ppv->insert;
 658             if ( $error ) {
 659               $dbh->rollback if $oldAutoCommit;
 660               return "Error inserting part_pkg_vendor record: $error";
 661             }
 662           }
 663           push @current_exportnum, $exportnum;
 664       }
 665   }
 666   foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
 667       unless ( grep($_ eq $part_pkg_vendor->exportnum, @current_exportnum) ) {
 668         my $error = $part_pkg_vendor->delete;
 669         if ( $error ) {
 670           $dbh->rollback if $oldAutoCommit;
 671           return "Error deleting part_pkg_vendor record: $error";
 672         }
 673       }
 674   }
 675
 676   # propagate changes to certain core fields
 677   if ( $conf->exists('part_pkg-lineage') ) {
 678     warn "  propagating changes to family" if $DEBUG;
 679     my $error = $new->propagate($old);
 680     if ( $error ) {
 681       $dbh->rollback if $oldAutoCommit;
 682       return $error;
 683     }
 684   }
 685
 686   if ( $options->{fcc_options} ) {
 687     warn "  updating fcc options " if $DEBUG;
 688     $new->set_fcc_options( $options->{fcc_options} );
 689   }
 690
 691   warn "  committing transaction" if $DEBUG and $oldAutoCommit;
 692   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 693   '';
 694 }
 695
 696 sub validate_number {
 697   my ($option, $valref) = @_;
 698
 699   $$valref = 0 unless $$valref;
 700   return "Invalid $option"
 701     unless ($$valref) = ($$valref =~ /^\s*(\d+)\s*$/);
 702   return '';
 703 }
 704
 705 sub validate_number_blank {
 706   my ($option, $valref) = @_;
 707
 708   if ($$valref) {
 709     return "Invalid $option"
 710       unless ($$valref) = ($$valref =~ /^\s*(\d+)\s*$/);
 711   }
 712   return '';
 713 }
 714
 715 =item check
 716
 717 Checks all fields to make sure this is a valid package definition.  If
 718 there is an error, returns the error, otherwise returns false.  Called by the
 719 insert and replace methods.
 720
 721 =cut
 722
 723 sub check {
 724   my $self = shift;
 725   warn "FS::part_pkg::check called on $self" if $DEBUG;
 726
 727   for (qw(setup recur plandata)) {
 728     #$self->set($_=>0) if $self->get($_) =~ /^\s*$/; }
 729     return "Use of $_ field is deprecated; set a plan and options: ".
 730            $self->get($_)
 731       if length($self->get($_));
 732     $self->set($_, '');
 733   }
 734
 735   if ( $self->dbdef_table->column('freq')->type =~ /(int)/i ) {
 736     my $error = $self->ut_number('freq');
 737     return $error if $error;
 738   } else {
 739     $self->freq =~ /^(\d+[hdw]?)$/
 740       or return "Illegal or empty freq: ". $self->freq;
 741     $self->freq($1);
 742   }
 743
 744   my @null_agentnum_right = ( 'Edit global package definitions' );
 745   push @null_agentnum_right, 'One-time charge'
 746     if $self->freq =~ /^0/;
 747   push @null_agentnum_right, 'Customize customer package'
 748     if $self->disabled eq 'Y'; #good enough
 749
 750   my $error = $self->ut_numbern('pkgpart')
 751     || $self->ut_text('pkg')
 752     || $self->ut_textn('comment')
 753     || $self->ut_textn('promo_code')
 754     || $self->ut_alphan('plan')
 755     || $self->ut_flag('setuptax')
 756     || $self->ut_flag('recurtax')
 757     || $self->ut_textn('taxclass')
 758     || $self->ut_flag('disabled')
 759     || $self->ut_flag('custom')
 760     || $self->ut_flag('no_auto')
 761     || $self->ut_flag('recur_show_zero')
 762     || $self->ut_flag('setup_show_zero')
 763     || $self->ut_flag('start_on_hold')
 764     #|| $self->ut_moneyn('setup_cost')
 765     #|| $self->ut_moneyn('recur_cost')
 766     || $self->ut_floatn('setup_cost')
 767     || $self->ut_floatn('recur_cost')
 768     || $self->ut_floatn('pay_weight')
 769     || $self->ut_floatn('credit_weight')
 770     || $self->ut_numbern('taxproductnum')
 771     || $self->ut_numbern('units_taxproductnum')
 772     || $self->ut_foreign_keyn('classnum',       'pkg_class', 'classnum')
 773     || $self->ut_foreign_keyn('addon_classnum', 'pkg_class', 'classnum')
 774     || $self->ut_foreign_keyn('taxproductnum',
 775                               'part_pkg_taxproduct',
 776                               'taxproductnum'
 777                              )
 778     || ( $setup_hack
 779            ? $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum' )
 780            : $self->ut_agentnum_acl('agentnum', \@null_agentnum_right)
 781        )
 782     || $self->ut_numbern('fcc_ds0s')
 783     || $self->ut_numbern('fcc_voip_class')
 784     || $self->ut_numbern('delay_start')
 785     || $self->ut_foreign_keyn('successor', 'part_pkg', 'pkgpart')
 786     || $self->ut_foreign_keyn('family_pkgpart', 'part_pkg', 'pkgpart')
 787     || $self->ut_numbern('expire_months')
 788     || $self->ut_numbern('adjourn_months')
 789     || $self->ut_numbern('contract_end_months')
 790     || $self->ut_numbern('change_to_pkgpart')
 791     || $self->ut_foreign_keyn('change_to_pkgpart', 'part_pkg', 'pkgpart')
 792     || $self->ut_alphan('agent_pkgpartid')
 793     || $self->SUPER::check
 794   ;
 795   return $error if $error;
 796
 797   return 'Unknown plan '. $self->plan
 798     unless exists($plans{$self->plan});
 799
 800   my $conf = new FS::Conf;
 801   return 'Taxclass is required'
 802     if ! $self->taxclass && $conf->exists('require_taxclasses');
 803
 804   '';
 805 }
 806
 807 =item check_options
 808
 809 Pass an I<$options> hashref that contains the values to be
 810 inserted or updated for any FS::part_pkg::MODULE.pm.
 811
 812 For each key in I<$options>, validates the value by calling
 813 the 'validate' subroutine defined for that option e.g.
 814 FS::part_pkg::MODULE::plan_info()->{$KEY}->{validate}.  The
 815 option validation function is only called when the hashkey for
 816 that option exists in I<$options>.
 817
 818 Then the module validation function is called, from
 819 FS::part_pkg::MODULE::plan_info()->{validate}
 820
 821 Returns error message, or empty string if valid.
 822
 823 Invoked by L</insert> and L</replace> via the equivalent
 824 methods in L<FS::option_Common>.
 825
 826 =cut
 827
 828 sub check_options {
 829   my ($self,$options) = @_;
 830   foreach my $option (keys %$options) {
 831     if (exists $plans{ $self->plan }->{fields}->{$option}) {
 832       if (exists($plans{$self->plan}->{fields}->{$option}->{'validate'})) {
 833         # pass option name for use in error message
 834         # pass a reference to the $options value, so it can be cleaned up
 835         my $error = &{$plans{$self->plan}->{fields}->{$option}->{'validate'}}($option,\($options->{$option}));
 836         return $error if $error;
 837       }
 838     } # else "option does not exist" error?
 839   }
 840   if (exists($plans{$self->plan}->{'validate'})) {
 841     my $error = &{$plans{$self->plan}->{'validate'}}($options);
 842     return $error if $error;
 843   }
 844   return '';
 845 }
 846
 847 =item check_pkg_svc
 848
 849 Checks pkg_svc records as a whole (for part_svc_link dependencies).
 850
 851 If there is an error, returns the error, otherwise returns false.
 852
 853 =cut
 854
 855 sub check_pkg_svc {
 856   my( $self, %opt ) = @_;
 857
 858   my $agentnum = $self->agentnum;
 859
 860   my %pkg_svc = map { $_->svcpart => $_ } $self->pkg_svc;
 861
 862   foreach my $svcpart ( keys %pkg_svc ) {
 863
 864     foreach my $part_svc_link ( $self->part_svc_link(
 865                                   'src_svcpart' => $svcpart,
 866                                   'link_type'   => 'part_pkg_restrict',
 867                                 )
 868     ) {
 869
 870       return $part_svc_link->dst_svc. ' must be included with '.
 871              $part_svc_link->src_svc
 872         unless $pkg_svc{ $part_svc_link->dst_svcpart };
 873     }
 874
 875   }
 876
 877   return '' if $opt{part_pkg_restrict_soft_override};
 878
 879   foreach my $svcpart ( keys %pkg_svc ) {
 880
 881     foreach my $part_svc_link ( $self->part_svc_link(
 882                                   'src_svcpart' => $svcpart,
 883                                   'link_type'   => 'part_pkg_restrict_soft',
 884                                 )
 885     ) {
 886       return $part_svc_link->dst_svc. ' is suggested with '.
 887              $part_svc_link->src_svc
 888         unless $pkg_svc{ $part_svc_link->dst_svcpart };
 889     }
 890
 891   }
 892
 893   '';
 894 }
 895
 896 =item part_svc_link OPTION => VALUE ...
 897
 898 Returns the service dependencies (see L<FS::part_svc_link>) for the given
 899 search options, taking into account this package definition's agent.
 900
 901 Available options are any field in part_svc_link.  Typically used options are
 902 src_svcpart and link_type.
 903
 904 =cut
 905
 906 sub part_svc_link {
 907   FS::part_svc_link->by_agentnum( shift->agentnum, @_ );
 908 }
 909
 910 =item supersede OLD [, OPTION => VALUE ... ]
 911
 912 Inserts this package as a successor to the package OLD.  All options are as
 913 for C<insert>.  After inserting, disables OLD and sets the new package as its
 914 successor.
 915
 916 =cut
 917
 918 sub supersede {
 919   my ($new, $old, %options) = @_;
 920   my $error;
 921
 922   $new->set('pkgpart' => '');
 923   $new->set('family_pkgpart' => $old->family_pkgpart);
 924   warn "    inserting successor package\n" if $DEBUG;
 925   $error = $new->insert(%options);
 926   return $error if $error;
 927
 928   warn "    disabling superseded package\n" if $DEBUG;
 929   $old->set('successor' => $new->pkgpart);
 930   $old->set('disabled' => 'Y');
 931   $error = $old->SUPER::replace; # don't change its options/pkg_svc records
 932   return $error if $error;
 933
 934   warn "  propagating changes to family" if $DEBUG;
 935   $new->propagate($old);
 936 }
 937
 938 =item propagate OLD
 939
 940 If any of certain fields have changed from OLD to this package, then,
 941 for all packages in the same lineage as this one, sets those fields
 942 to their values in this package.
 943
 944 =cut
 945
 946 my @propagate_fields = (
 947   qw( pkg classnum setup_cost recur_cost taxclass
 948   setuptax recurtax pay_weight credit_weight
 949   )
 950 );
 951
 952 sub propagate {
 953   my $new = shift;
 954   my $old = shift;
 955   my %fields = (
 956     map { $_ => $new->get($_) }
 957     grep { $new->get($_) ne $old->get($_) }
 958     @propagate_fields
 959   );
 960
 961   my @part_pkg = qsearch('part_pkg', {
 962       'family_pkgpart' => $new->family_pkgpart
 963   });
 964   my @error;
 965   foreach my $part_pkg ( @part_pkg ) {
 966     my $pkgpart = $part_pkg->pkgpart;
 967     next if $pkgpart == $new->pkgpart; # don't modify $new
 968     warn "    propagating to pkgpart $pkgpart\n" if $DEBUG;
 969     foreach ( keys %fields ) {
 970       $part_pkg->set($_, $fields{$_});
 971     }
 972     # SUPER::replace to avoid changing non-core fields
 973     my $error = $part_pkg->SUPER::replace;
 974     push @error, "pkgpart $pkgpart: $error"
 975       if $error;
 976   }
 977   join("\n", @error);
 978 }
 979
 980 =item set_fcc_options HASHREF
 981
 982 Sets the FCC options on this package definition to the values specified
 983 in HASHREF.
 984
 985 =cut
 986
 987 sub set_fcc_options {
 988   my $self = shift;
 989   my $pkgpart = $self->pkgpart;
 990   my $options;
 991   if (ref $_[0]) {
 992     $options = shift;
 993   } else {
 994     $options = { @_ };
 995   }
 996
 997   my %existing_num = map { $_->fccoptionname => $_->num }
 998                      qsearch('part_pkg_fcc_option', { pkgpart => $pkgpart });
 999
1000   local $FS::Record::nowarn_identical = 1;
1001   # set up params for process_o2m
1002   my $i = 0;
1003   my $params = {};
1004   foreach my $name (keys %$options ) {
1005     $params->{ "num$i" } = $existing_num{$name} || '';
1006     $params->{ "num$i".'_fccoptionname' } = $name;
1007     $params->{ "num$i".'_optionvalue'   } = $options->{$name};
1008     $i++;
1009   }
1010
1011   $self->process_o2m(
1012     table   => 'part_pkg_fcc_option',
1013     fields  => [qw( fccoptionname optionvalue )],
1014     params  => $params,
1015   );
1016 }
1017
1018 =item pkg_locale LOCALE
1019
1020 Returns a customer-viewable string representing this package for the given
1021 locale, from the part_pkg_msgcat table.  If the given locale is empty or no
1022 localized string is found, returns the base pkg field.
1023
1024 =cut
1025
1026 sub pkg_locale {
1027   my( $self, $locale ) = @_;
1028   return $self->pkg unless $locale;
1029   my $part_pkg_msgcat = $self->part_pkg_msgcat($locale) or return $self->pkg;
1030   $part_pkg_msgcat->pkg;
1031 }
1032
1033 =item part_pkg_msgcat LOCALE
1034
1035 Like pkg_locale, but returns the FS::part_pkg_msgcat object itself.
1036
1037 =cut
1038
1039 sub part_pkg_msgcat {
1040   my( $self, $locale ) = @_;
1041   qsearchs( 'part_pkg_msgcat', {
1042     pkgpart => $self->pkgpart,
1043     locale  => $locale,
1044   });
1045 }
1046
1047 =item pkg_comment [ OPTION => VALUE... ]
1048
1049 Returns an (internal) string representing this package.  Currently,
1050 "pkgpart: pkg - comment", is returned.  "pkg - comment" may be returned in the
1051 future, omitting pkgpart.  The comment will have '(CUSTOM) ' prepended if
1052 custom is Y.
1053
1054 If the option nopkgpart is true then the "pkgpart: ' is omitted.
1055
1056 =cut
1057
1058 sub pkg_comment {
1059   my $self = shift;
1060   my %opt = @_;
1061
1062   #$self->pkg. ' - '. $self->comment;
1063   #$self->pkg. ' ('. $self->comment. ')';
1064   my $pre = $opt{nopkgpart} ? '' : $self->pkgpart. ': ';
1065   my $custom_comment = $self->custom_comment(%opt);
1066   $pre. $self->pkg. ( $custom_comment ? " - $custom_comment" : '' );
1067 }
1068
1069 #without price info (so without hitting the DB again)
1070 sub pkg_comment_only {
1071   my $self = shift;
1072   my %opt = @_;
1073
1074   my $pre = $opt{nopkgpart} ? '' : $self->pkgpart. ': ';
1075   my $comment = $self->comment;
1076   $pre. $self->pkg. ( $comment ? " - $comment" : '' );
1077 }
1078
1079 sub price_info { # safety, in case a part_pkg hasn't defined price_info
1080     '';
1081 }
1082
1083 sub custom_comment {
1084   my $self = shift;
1085   my $price_info = $self->price_info(@_);
1086   ( $self->custom ? '(CUSTOM) ' : '' ).
1087     $self->comment.
1088     ( ($self->custom || $self->comment) ? ' - ' : '' ).
1089     ($price_info || 'No charge');
1090 }
1091
1092 sub pkg_price_info {
1093   my $self = shift;
1094   $self->pkg. ' - '. ($self->price_info || 'No charge');
1095 }
1096
1097 =item pkg_class
1098
1099 Returns the package class, as an FS::pkg_class object, or the empty string
1100 if there is no package class.
1101
1102 =item addon_pkg_class
1103
1104 Returns the add-on package class, as an FS::pkg_class object, or the empty
1105 string if there is no add-on package class.
1106
1107 =cut
1108
1109 sub addon_pkg_class {
1110   my $self = shift;
1111   if ( $self->addon_classnum ) {
1112     qsearchs('pkg_class', { 'classnum' => $self->addon_classnum } );
1113   } else {
1114     return '';
1115   }
1116 }
1117
1118 =item categoryname
1119
1120 Returns the package category name, or the empty string if there is no package
1121 category.
1122
1123 =cut
1124
1125 sub categoryname {
1126   my $self = shift;
1127   my $pkg_class = $self->pkg_class;
1128   $pkg_class
1129     ? $pkg_class->categoryname
1130     : '';
1131 }
1132
1133 =item classname
1134
1135 Returns the package class name, or the empty string if there is no package
1136 class.
1137
1138 =cut
1139
1140 sub classname {
1141   my $self = shift;
1142   my $pkg_class = $self->pkg_class;
1143   $pkg_class
1144     ? $pkg_class->classname
1145     : '';
1146 }
1147
1148 =item addon_classname
1149
1150 Returns the add-on package class name, or the empty string if there is no
1151 add-on package class.
1152
1153 =cut
1154
1155 sub addon_classname {
1156   my $self = shift;
1157   my $pkg_class = $self->addon_pkg_class;
1158   $pkg_class
1159     ? $pkg_class->classname
1160     : '';
1161 }
1162
1163 =item agent
1164
1165 Returns the associated agent for this event, if any, as an FS::agent object.
1166
1167 =item pkg_svc [ HASHREF | OPTION => VALUE ]
1168
1169 Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
1170 definition (with non-zero quantity).
1171
1172 One option is available, I<disable_linked>.  If set true it will return the
1173 services for this package definition alone, omitting services from any add-on
1174 packages.
1175
1176 =cut
1177
1178 =item type_pkgs
1179
1180 Returns all FS::type_pkgs objects (see L<FS::type_pkgs>) for this package
1181 definition.
1182
1183 =cut
1184
1185 sub pkg_svc {
1186   my $self = shift;
1187
1188   return @{ $cache_pkg_svc{$self->pkgpart} }
1189     if $cache_enabled && $cache_pkg_svc{$self->pkgpart};
1190
1191 #  #sort { $b->primary cmp $a->primary }
1192 #    grep { $_->quantity }
1193 #      qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
1194
1195   my $opt = ref($_[0]) ? $_[0] : { @_ };
1196   my %pkg_svc = map  { $_->svcpart => $_ } $self->_pkg_svc;
1197
1198   unless ( $opt->{disable_linked} ) {
1199     foreach my $dst_pkg ( map $_->dst_pkg, $self->svc_part_pkg_link ) {
1200       my @pkg_svc = $dst_pkg->_pkg_svc;
1201       foreach my $pkg_svc ( @pkg_svc ) {
1202         if ( $pkg_svc{$pkg_svc->svcpart} ) {
1203           my $quantity = $pkg_svc{$pkg_svc->svcpart}->quantity;
1204           $pkg_svc{$pkg_svc->svcpart}->quantity($quantity + $pkg_svc->quantity);
1205         } else {
1206           $pkg_svc{$pkg_svc->svcpart} = $pkg_svc;
1207         }
1208       }
1209     }
1210   }
1211
1212   my @pkg_svc = values(%pkg_svc);
1213
1214   $cache_pkg_svc{$self->pkgpart} = \@pkg_svc if $cache_enabled;
1215
1216   @pkg_svc;
1217
1218 }
1219
1220 sub _pkg_svc {
1221   my $self = shift;
1222   grep { $_->quantity }
1223     qsearch({
1224       'select'    => 'pkg_svc.*, part_svc.*',
1225       'table'     => 'pkg_svc',
1226       'addl_from' => 'LEFT JOIN part_svc USING ( svcpart )',
1227       'hashref'   => { 'pkgpart' => $self->pkgpart },
1228     });
1229 }
1230
1231 =item svcpart [ SVCDB ]
1232
1233 Returns the svcpart of the primary service definition (see L<FS::part_svc>)
1234 associated with this package definition (see L<FS::pkg_svc>).  Returns
1235 false if there not a primary service definition or exactly one service
1236 definition with quantity 1, or if SVCDB is specified and does not match the
1237 svcdb of the service definition.  SVCDB can be specified as a scalar table
1238 name, such as 'svc_acct', or as an arrayref of possible table names.
1239
1240 =cut
1241
1242 sub svcpart {
1243   my $pkg_svc = shift->_primary_pkg_svc(@_);
1244   $pkg_svc ? $pkg_svc->svcpart : '';
1245 }
1246
1247 =item part_svc [ SVCDB ]
1248
1249 Like the B<svcpart> method, but returns the FS::part_svc object (see
1250 L<FS::part_svc>).
1251
1252 =cut
1253
1254 sub part_svc {
1255   my $pkg_svc = shift->_primary_pkg_svc(@_);
1256   $pkg_svc ? $pkg_svc->part_svc : '';
1257 }
1258
1259 sub _primary_pkg_svc {
1260   my $self = shift;
1261
1262   my $svcdb = scalar(@_) ? shift : [];
1263   $svcdb = ref($svcdb) ? $svcdb : [ $svcdb ];
1264   my %svcdb = map { $_=>1 } @$svcdb;
1265
1266   my @svcdb_pkg_svc =
1267     grep { !scalar(@$svcdb) || $svcdb{ $_->part_svc->svcdb } }
1268          $self->pkg_svc;
1269
1270   my @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc;
1271   @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc
1272     unless @pkg_svc;
1273   return '' if scalar(@pkg_svc) != 1;
1274   $pkg_svc[0];
1275 }
1276
1277 =item svcpart_unique_svcdb SVCDB
1278
1279 Returns the svcpart of a service definition (see L<FS::part_svc>) matching
1280 SVCDB associated with this package definition (see L<FS::pkg_svc>).  Returns
1281 false if there not a primary service definition for SVCDB or there are multiple
1282 service definitions for SVCDB.
1283
1284 =cut
1285
1286 sub svcpart_unique_svcdb {
1287   my( $self, $svcdb ) = @_;
1288   my @svcdb_pkg_svc = grep { ( $svcdb eq $_->part_svc->svcdb ) } $self->pkg_svc;
1289   return '' if scalar(@svcdb_pkg_svc) != 1;
1290   $svcdb_pkg_svc[0]->svcpart;
1291 }
1292
1293 =item payby
1294
1295 Returns a list of the acceptable payment types for this package.  Eventually
1296 this should come out of a database table and be editable, but currently has the
1297 following logic instead:
1298
1299 If the package is free, the single item B<BILL> is
1300 returned, otherwise, the single item B<CARD> is returned.
1301
1302 (CHEK?  LEC?  Probably shouldn't accept those by default, prone to abuse)
1303
1304 =cut
1305
1306 sub payby {
1307   my $self = shift;
1308   if ( $self->is_free ) {
1309     ( 'BILL' );
1310   } else {
1311     ( 'CARD' );
1312   }
1313 }
1314
1315 =item is_free
1316
1317 Returns true if this package is free.
1318
1319 =cut
1320
1321 sub is_free {
1322   my $self = shift;
1323   if ( $self->can('is_free_options') ) {
1324     not grep { $_ !~ /^\s*0*(\.0*)?\s*$/ }
1325          map { $self->option($_) }
1326              $self->is_free_options;
1327   } else {
1328     warn "FS::part_pkg::is_free: FS::part_pkg::". $self->plan. " subclass ".
1329          "provides neither is_free_options nor is_free method; returning false";
1330     0;
1331   }
1332 }
1333
1334 # whether the plan allows discounts to be applied to this package
1335 sub can_discount { 0; }
1336
1337 # whether the plan allows changing the start date
1338 sub can_start_date {
1339   my $self = shift;
1340   $self->start_on_hold ? 0 : 1;
1341 }
1342
1343 # whether the plan supports part_pkg_usageprice add-ons (a specific kind of
1344 #  pre-selectable usage pricing, there's others this doesn't refer to)
1345 sub can_usageprice { 0; }
1346
1347 # the delay start date if present
1348 sub delay_start_date {
1349   my $self = shift;
1350
1351   my $delay = $self->delay_start or return '';
1352
1353   # avoid timelocal silliness
1354   my $dt = DateTime->today(time_zone => 'local');
1355   $dt->add(days => $delay);
1356   $dt->epoch;
1357 }
1358
1359 sub can_currency_exchange { 0; }
1360
1361 sub freqs_href {
1362   # moved to FS::Misc to make this accessible to other packages
1363   # at initialization
1364   FS::Misc::pkg_freqs();
1365 }
1366
1367 =item freq_pretty
1368
1369 Returns an english representation of the I<freq> field, such as "monthly",
1370 "weekly", "semi-annually", etc.
1371
1372 =cut
1373
1374 sub freq_pretty {
1375   my $self = shift;
1376   my $freq = $self->freq;
1377
1378   #my $freqs_href = $self->freqs_href;
1379   my $freqs_href = freqs_href();
1380
1381   if ( exists($freqs_href->{$freq}) ) {
1382     $freqs_href->{$freq};
1383   } else {
1384     my $interval = 'month';
1385     if ( $freq =~ /^(\d+)([hdw])$/ ) {
1386       my %interval = ( 'h' => 'hour', 'd'=>'day', 'w'=>'week' );
1387       $interval = $interval{$2};
1388     }
1389     if ( $1 == 1 ) {
1390       "every $interval";
1391     } else {
1392       "every $freq ${interval}s";
1393     }
1394   }
1395 }
1396
1397 =item add_freq TIMESTAMP [ FREQ ]
1398
1399 Adds a billing period of some frequency to the provided timestamp and
1400 returns the resulting timestamp, or -1 if the frequency could not be
1401 parsed (shouldn't happen).  By default, the frequency of this package
1402 will be used; to override this, pass a different frequency as a second
1403 argument.
1404
1405 =cut
1406
1407 sub add_freq {
1408   my( $self, $date, $freq ) = @_;
1409   $freq = $self->freq unless $freq;
1410
1411   #change this bit to use Date::Manip? CAREFUL with timezones (see
1412   # mailing list archive)
1413   my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($date) )[0,1,2,3,4,5];
1414
1415   if ( $freq =~ /^\d+$/ ) {
1416     $mon += $freq;
1417     until ( $mon < 12 ) { $mon -= 12; $year++; }
1418
1419     $mday = 28 if $mday > 28 && FS::Conf->new->exists('anniversary-rollback');
1420
1421   } elsif ( $freq =~ /^(\d+)w$/ ) {
1422     my $weeks = $1;
1423     $mday += $weeks * 7;
1424   } elsif ( $freq =~ /^(\d+)d$/ ) {
1425     my $days = $1;
1426     $mday += $days;
1427   } elsif ( $freq =~ /^(\d+)h$/ ) {
1428     my $hours = $1;
1429     $hour += $hours;
1430   } else {
1431     return -1;
1432   }
1433
1434   timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
1435 }
1436
1437 =item plandata
1438
1439 For backwards compatibility, returns the plandata field as well as all options
1440 from FS::part_pkg_option.
1441
1442 =cut
1443
1444 sub plandata {
1445   my $self = shift;
1446   carp "plandata is deprecated";
1447   if ( @_ ) {
1448     $self->SUPER::plandata(@_);
1449   } else {
1450     my $plandata = $self->get('plandata');
1451     my %options = $self->options;
1452     $plandata .= join('', map { "$_=$options{$_}\n" } keys %options );
1453     $plandata;
1454   }
1455 }
1456
1457 =item part_pkg_vendor
1458
1459 Returns all vendor/external package ids as FS::part_pkg_vendor objects (see
1460 L<FS::part_pkg_vendor>).
1461
1462 =item vendor_pkg_ids
1463
1464 Returns a list of vendor/external package ids by exportnum
1465
1466 =cut
1467
1468 sub vendor_pkg_ids {
1469   my $self = shift;
1470   map { $_->exportnum => $_->vendor_pkg_id } $self->part_pkg_vendor;
1471 }
1472
1473 =item part_pkg_option
1474
1475 Returns all options as FS::part_pkg_option objects (see
1476 L<FS::part_pkg_option>).
1477
1478 =item options
1479
1480 Returns a list of option names and values suitable for assigning to a hash.
1481
1482 =cut
1483
1484 sub options {
1485   my $self = shift;
1486   map { $_->optionname => $_->optionvalue } $self->part_pkg_option;
1487 }
1488
1489 =item option OPTIONNAME [ QUIET ]
1490
1491 Returns the option value for the given name, or the empty string.  If a true
1492 value is passed as the second argument, warnings about missing the option
1493 will be suppressed.
1494
1495 =cut
1496
1497 sub option {
1498   my( $self, $opt, $ornull ) = @_;
1499
1500   #cache: was pulled up in the original part_pkg query
1501   return $self->hashref->{"_opt_$opt"}
1502     if exists $self->hashref->{"_opt_$opt"};
1503
1504   cluck "$self -> option: searching for $opt" if $DEBUG;
1505   my $part_pkg_option =
1506     qsearchs('part_pkg_option', {
1507       pkgpart    => $self->pkgpart,
1508       optionname => $opt,
1509   } );
1510   return $part_pkg_option->optionvalue if $part_pkg_option;
1511
1512   my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); }
1513                      split("\n", $self->get('plandata') );
1514   return $plandata{$opt} if exists $plandata{$opt};
1515
1516   # check whether the option is defined in plan info (if so, don't warn)
1517   if (exists $plans{ $self->plan }->{fields}->{$opt}) {
1518     return '';
1519   }
1520   cluck "WARNING: (pkgpart ". $self->pkgpart. ") Package def option $opt ".
1521         "not found in options or plandata!\n"
1522     unless $ornull;
1523
1524   '';
1525 }
1526
1527 =item part_pkg_currency [ CURRENCY ]
1528
1529 Returns all currency options as FS::part_pkg_currency objects (see
1530 L<FS::part_pkg_currency>), or, if a currency is specified, only return the
1531 objects for that currency.
1532
1533 =cut
1534
1535 sub part_pkg_currency {
1536   my $self = shift;
1537   my %hash = ( 'pkgpart' => $self->pkgpart );
1538   $hash{'currency'} = shift if @_;
1539   qsearch('part_pkg_currency', \%hash );
1540 }
1541
1542 =item part_pkg_currency_options CURRENCY
1543
1544 Returns a list of option names and values from FS::part_pkg_currency for the
1545 specified currency.
1546
1547 =cut
1548
1549 sub part_pkg_currency_options {
1550   my $self = shift;
1551   map { $_->optionname => $_->optionvalue } $self->part_pkg_currency(shift);
1552 }
1553
1554 =item part_pkg_currency_option CURRENCY OPTIONNAME
1555
1556 Returns the option value for the given name and currency.
1557
1558 =cut
1559
1560 sub part_pkg_currency_option {
1561   my( $self, $currency, $optionname ) = @_;
1562   my $part_pkg_currency =
1563     qsearchs('part_pkg_currency', { 'pkgpart'    => $self->pkgpart,
1564                                     'currency'   => $currency,
1565                                     'optionname' => $optionname,
1566                                   }
1567             )#;
1568   #fatal if not found?  that works for our use cases from
1569   #part_pkg/currency_fixed, but isn't how we would typically/expect the method
1570   #to behave.  have to catch it there if we change it here...
1571     or die "Unknown price for ". $self->pkg_comment. " in $currency\n";
1572
1573   $part_pkg_currency->optionvalue;
1574 }
1575
1576 =item fcc_option OPTIONNAME
1577
1578 Returns the FCC 477 report option value for the given name, or the empty
1579 string.
1580
1581 =cut
1582
1583 sub fcc_option {
1584   my ($self, $name) = @_;
1585   my $part_pkg_fcc_option =
1586     qsearchs('part_pkg_fcc_option', {
1587         pkgpart => $self->pkgpart,
1588         fccoptionname => $name,
1589     });
1590   $part_pkg_fcc_option ? $part_pkg_fcc_option->optionvalue : '';
1591 }
1592
1593 =item fcc_options
1594
1595 Returns all FCC 477 report options for this package, as a hash-like list.
1596
1597 =cut
1598
1599 sub fcc_options {
1600   my $self = shift;
1601   map { $_->fccoptionname => $_->optionvalue }
1602     qsearch('part_pkg_fcc_option', { pkgpart => $self->pkgpart });
1603 }
1604
1605 =item bill_part_pkg_link
1606
1607 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1608
1609 =cut
1610
1611 sub bill_part_pkg_link {
1612   shift->_part_pkg_link('bill', @_);
1613 }
1614
1615 =item svc_part_pkg_link
1616
1617 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1618
1619 =cut
1620
1621 sub svc_part_pkg_link {
1622   shift->_part_pkg_link('svc', @_);
1623 }
1624
1625 =item supp_part_pkg_link
1626
1627 Returns the associated part_pkg_link records of type 'supp' (supplemental
1628 packages).
1629
1630 =cut
1631
1632 sub supp_part_pkg_link {
1633   shift->_part_pkg_link('supp', @_);
1634 }
1635
1636 sub _part_pkg_link {
1637   my( $self, $type ) = @_;
1638
1639   return @{ $cache_link{$type}->{$self->pkgpart} }
1640     if $cache_enabled && $cache_link{$type}->{$self->pkgpart};
1641
1642   cluck $type.'_part_pkg_link called' if $DEBUG;
1643
1644   my @ppl =
1645     qsearch({ table    => 'part_pkg_link',
1646               hashref  => { src_pkgpart => $self->pkgpart,
1647                             link_type   => $type,
1648                             #protection against infinite recursive links
1649                             dst_pkgpart => { op=>'!=', value=> $self->pkgpart },
1650                           },
1651               order_by => "ORDER BY hidden",
1652            });
1653
1654   $cache_link{$type}->{$self->pkgpart} = \@ppl if $cache_enabled;
1655
1656   return @ppl;
1657 }
1658
1659 sub self_and_bill_linked {
1660   shift->_self_and_linked('bill', @_);
1661 }
1662
1663 sub self_and_svc_linked {
1664   shift->_self_and_linked('svc', @_);
1665 }
1666
1667 sub _self_and_linked {
1668   my( $self, $type, $hidden ) = @_;
1669   $hidden ||= '';
1670
1671   my @result = ();
1672   foreach ( ( $self, map { $_->dst_pkg->_self_and_linked($type, $_->hidden) }
1673                      $self->_part_pkg_link($type) ) )
1674   {
1675     $_->hidden($hidden) if $hidden;
1676     push @result, $_;
1677   }
1678
1679   (@result);
1680 }
1681
1682 =item part_pkg_taxoverride [ CLASS ]
1683
1684 Returns all associated FS::part_pkg_taxoverride objects (see
1685 L<FS::part_pkg_taxoverride>).  Limits the returned set to those
1686 of class CLASS if defined.  Class may be one of 'setup', 'recur',
1687 the empty string (default), or a usage class number (see L<FS::usage_class>).
1688 When a class is specified, the empty string class (default) is returned
1689 if no more specific values exist.
1690
1691 =cut
1692
1693 sub part_pkg_taxoverride {
1694   my $self = shift;
1695   my $class = shift;
1696
1697   my $hashref = { 'pkgpart' => $self->pkgpart };
1698   $hashref->{'usage_class'} = $class if defined($class);
1699   my @overrides = qsearch('part_pkg_taxoverride', $hashref );
1700
1701   unless ( scalar(@overrides) || !defined($class) || !$class ){
1702     $hashref->{'usage_class'} = '';
1703     @overrides = qsearch('part_pkg_taxoverride', $hashref );
1704   }
1705
1706   @overrides;
1707 }
1708
1709 =item has_taxproduct
1710
1711 Returns true if this package has any taxproduct associated with it.
1712
1713 =cut
1714
1715 sub has_taxproduct {
1716   my $self = shift;
1717
1718   $self->taxproductnum ||
1719   scalar( grep { $_ =~/^usage_taxproductnum_/ && $self->option($_) }
1720           keys %{ {$self->options} }
1721   )
1722
1723 }
1724
1725
1726 =item taxproduct [ CLASS ]
1727
1728 Returns the associated tax product for this package definition (see
1729 L<FS::part_pkg_taxproduct>).  CLASS may be one of 'setup', 'recur' or
1730 the usage classnum (see L<FS::usage_class>).  Returns the default
1731 tax product for this record if the more specific CLASS value does
1732 not exist.
1733
1734 =cut
1735
1736 sub taxproduct {
1737   my $self = shift;
1738   my $class = shift;
1739
1740   my $part_pkg_taxproduct;
1741
1742   my $taxproductnum = $self->taxproductnum;
1743   if ($class) {
1744     my $class_taxproductnum = $self->option("usage_taxproductnum_$class", 1);
1745     $taxproductnum = $class_taxproductnum
1746       if $class_taxproductnum
1747   }
1748
1749   $part_pkg_taxproduct =
1750     qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1751
1752   unless ($part_pkg_taxproduct || $taxproductnum eq $self->taxproductnum ) {
1753     $taxproductnum = $self->taxproductnum;
1754     $part_pkg_taxproduct =
1755       qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1756   }
1757
1758   $part_pkg_taxproduct;
1759 }
1760
1761 =item taxproduct_description [ CLASS ]
1762
1763 Returns the description of the associated tax product for this package
1764 definition (see L<FS::part_pkg_taxproduct>).
1765
1766 =cut
1767
1768 sub taxproduct_description {
1769   my $self = shift;
1770   my $part_pkg_taxproduct = $self->taxproduct(@_);
1771   $part_pkg_taxproduct ? $part_pkg_taxproduct->description : '';
1772 }
1773
1774 =item units_taxproduct
1775
1776 Returns the L<FS::part_pkg_taxproduct> record used to report the taxable
1777 service units (usually phone lines) on this package.
1778
1779 =cut
1780
1781 sub units_taxproduct {
1782   my $self = shift;
1783   $self->units_taxproductnum
1784     ? FS::part_pkg_taxproduct->by_key($self->units_taxproductnum)
1785     : '';
1786 }
1787
1788 =item tax_rates DATA_PROVIDER, GEOCODE, [ CLASS ]
1789
1790 Returns the tax table entries (L<FS::tax_rate> objects) that apply to this
1791 package in the location specified by GEOCODE, for usage class CLASS (one of
1792 'setup', 'recur', null, or a C<usage_class> number).
1793
1794 =cut
1795
1796 sub tax_rates {
1797   my $self = shift;
1798   my ($vendor, $geocode, $class) = @_;
1799   # if this part_pkg is overridden into a specific taxclass, get that class
1800   my @taxclassnums = map { $_->taxclassnum }
1801                      $self->part_pkg_taxoverride($class);
1802   # otherwise, get its tax product category
1803   if (!@taxclassnums) {
1804     my $part_pkg_taxproduct = $self->taxproduct($class);
1805     # If this isn't defined, then the class has no taxproduct designation,
1806     # so return no tax rates.
1807     return () if !$part_pkg_taxproduct;
1808
1809     # convert the taxproduct to the tax classes that might apply to it in
1810     # $geocode
1811     @taxclassnums = map { $_->taxclassnum }
1812                     grep { $_->taxable eq 'Y' } # why do we need this?
1813                     $part_pkg_taxproduct->part_pkg_taxrate($geocode);
1814   }
1815   return unless @taxclassnums;
1816
1817   # then look up the actual tax_rate entries
1818   warn "Found taxclassnum values of ". join(',', @taxclassnums) ."\n"
1819       if $DEBUG;
1820   my $extra_sql = "AND taxclassnum IN (". join(',', @taxclassnums) . ")";
1821   my @taxes = qsearch({ 'table'     => 'tax_rate',
1822                         'hashref'   => { 'geocode'     => $geocode,
1823                                          'data_vendor' => $vendor,
1824                                          'disabled'    => '' },
1825                         'extra_sql' => $extra_sql,
1826                       });
1827   warn "Found taxes ". join(',', map {$_->taxnum} @taxes) ."\n"
1828       if $DEBUG;
1829
1830   return @taxes;
1831 }
1832
1833 =item part_pkg_discount
1834
1835 Returns the package to discount m2m records (see L<FS::part_pkg_discount>)
1836 for this package.
1837
1838 =item part_pkg_usage
1839
1840 Returns the voice usage pools (see L<FS::part_pkg_usage>) defined for
1841 this package.
1842
1843 =item change_to_pkg
1844
1845 Returns the automatic transfer target for this package, or an empty string
1846 if there isn't one.
1847
1848 =cut
1849
1850 sub change_to_pkg {
1851   my $self = shift;
1852   my $pkgpart = $self->change_to_pkgpart or return '';
1853   FS::part_pkg->by_key($pkgpart);
1854 }
1855
1856 =item _rebless
1857
1858 Reblesses the object into the FS::part_pkg::PLAN class (if available), where
1859 PLAN is the object's I<plan> field.  There should be better docs
1860 on how to create new price plans, but until then, see L</NEW PLAN CLASSES>.
1861
1862 =cut
1863
1864 sub _rebless {
1865   my $self = shift;
1866   my $plan = $self->plan;
1867   unless ( $plan ) {
1868     cluck "no price plan found for pkgpart ". $self->pkgpart. "\n"
1869       if $DEBUG;
1870     return $self;
1871   }
1872   return $self if ref($self) =~ /::$plan$/; #already blessed into plan subclass
1873   my $class = ref($self). "::$plan";
1874   warn "reblessing $self into $class" if $DEBUG > 1;
1875   eval "use $class;";
1876   die $@ if $@;
1877   bless($self, $class) unless $@;
1878   $self;
1879 }
1880
1881 =item calc_setup CUST_PKG START_DATE DETAILS_ARRAYREF OPTIONS_HASHREF
1882
1883 =item calc_recur CUST_PKG START_DATE_SCALARREF DETAILS_ARRAYREF OPTIONS_HASHREF
1884
1885 Calculates and returns the setup or recurring fees, respectively, for this
1886 package.  Implementation is in the FS::part_pkg:* module specific to this price
1887 plan.
1888
1889 Adds invoicing details to the passed-in DETAILS_ARRAYREF
1890
1891 Options are passed as a hashref.  Available options:
1892
1893 =over 4
1894
1895 =item freq_override
1896
1897 Frequency override (for calc_recur)
1898
1899 =item discounts
1900
1901 This option is filled in by the method rather than controlling its operation.
1902 It is an arrayref.  Applicable discounts will be added to the arrayref, as
1903 L<FS::cust_bill_pkg_discount> records.
1904
1905 =item real_pkgpart
1906
1907 For package add-ons, is the base L<FS::part_pkg> package definition, otherwise
1908 no different than pkgpart.
1909
1910 =item precommit_hooks
1911
1912 This option is filled in by the method rather than controlling its operation.
1913 It is an arrayref.  Anonymous coderefs will be added to the arrayref.  They
1914 need to be called before completing the billing operation.  For calc_recur
1915 only.
1916
1917 =item increment_next_bill
1918
1919 Increment the next bill date (boolean, for calc_recur).  Typically true except
1920 for particular situations.
1921
1922 =item setup_fee
1923
1924 This option is filled in by the method rather than controlling its operation.
1925 It indicates a deferred setup fee that is billed at calc_recur time (see price
1926 plan option prorate_defer_bill).
1927
1928 =back
1929
1930 Note: Don't calculate prices when not actually billing the package.  For that,
1931 see the L<FS::cust_pkg/base_setup> and L<FS::cust_pkg/base_recur> methods.
1932
1933 =cut
1934
1935 #fatal fallbacks
1936 sub calc_setup { die 'no calc_setup for '. shift->plan. "\n"; }
1937 sub calc_recur { die 'no calc_recur for '. shift->plan. "\n"; }
1938
1939 =item calc_remain CUST_PKG [ OPTION => VALUE ... ]
1940
1941 Calculates and returns the remaining value to be credited upon package
1942 suspension, change, or cancellation, if enabled.
1943
1944 Options are passed as a list of keys and values.  Available options:
1945
1946 =over 4
1947
1948 =item time
1949
1950 Override for the current time
1951
1952 =item cust_credit_source_bill_pkg
1953
1954 This option is filled in by the method rather than controlling its operation.
1955 It is an arrayref.
1956 L<FS::cust_credit_source_bill_pkg|FS::cust_credit_source_bill_pkg> records will
1957 be added to the arrayref indicating the specific line items and amounts which
1958 are the source of this remaining credit.
1959
1960 =back
1961
1962 Note: Don't calculate prices when not actually suspending or cancelling the
1963 package.
1964
1965 =cut
1966
1967 #fallback that returns 0 for old legacy packages with no plan
1968 sub calc_remain { 0; }
1969
1970 =item calc_units CUST_PKG
1971
1972 This returns the number of provisioned svc_phone records, or, of the package
1973 count_available_phones option is set, the number available to be provisioned
1974 in the package.
1975
1976 =cut
1977
1978 sub calc_units {
1979   my($self, $cust_pkg ) = @_;
1980   my $count = 0;
1981   if ( $self->option('count_available_phones', 1)) {
1982     foreach my $pkg_svc ($cust_pkg->part_pkg->pkg_svc) {
1983       if ($pkg_svc->part_svc->svcdb eq 'svc_phone') { # svc_pbx?
1984         $count += $pkg_svc->quantity || 0;
1985       }
1986     }
1987     $count *= $cust_pkg->quantity;
1988   } else {
1989     $count =
1990       scalar(grep { $_->part_svc->svcdb eq 'svc_phone' } $cust_pkg->cust_svc);
1991   }
1992   $count;
1993 }
1994
1995 #fallback for everything not based on flat.pm
1996 sub recur_temporality { 'upcoming'; }
1997
1998 =item calc_cancel START_DATE DETAILS_ARRAYREF OPTIONS_HASHREF
1999
2000 Runs any necessary billing on cancellation: another recurring cycle for
2001 recur_temporailty 'preceding' pacakges with the bill_recur_on_cancel option
2002 set (calc_recur), or, any outstanding usage for pacakges with the
2003 bill_usage_on_cancel option set (calc_usage).
2004
2005 =cut
2006
2007 #fallback for everything not based on flat.pm, doesn't do this yet (which is
2008 #okay, nothing of ours not based on flat.pm does usage-on-cancel billing
2009 sub calc_cancel { 0; }
2010
2011 #fallback for everything except bulk.pm
2012 sub hide_svc_detail { 0; }
2013
2014 #fallback for packages that can't/won't summarize usage
2015 sub sum_usage { 0; }
2016
2017 =item recur_cost_permonth CUST_PKG
2018
2019 recur_cost divided by freq (only supported for monthly and longer frequencies)
2020
2021 =cut
2022
2023 sub recur_cost_permonth {
2024   my($self, $cust_pkg) = @_;
2025   return 0 unless $self->freq =~ /^\d+$/ && $self->freq > 0;
2026   sprintf('%.2f', ($self->recur_cost || 0) / $self->freq );
2027 }
2028
2029 =item cust_bill_pkg_recur CUST_PKG
2030
2031 Actual recurring charge for the specified customer package from customer's most
2032 recent invoice
2033
2034 =cut
2035
2036 sub cust_bill_pkg_recur {
2037   my($self, $cust_pkg) = @_;
2038   my $cust_bill_pkg = qsearchs({
2039     'table'     => 'cust_bill_pkg',
2040     'addl_from' => 'LEFT JOIN cust_bill USING ( invnum )',
2041     'hashref'   => { 'pkgnum' => $cust_pkg->pkgnum,
2042                      'recur'  => { op=>'>', value=>'0' },
2043                    },
2044     'order_by'  => 'ORDER BY cust_bill._date     DESC,
2045                              cust_bill_pkg.sdate DESC
2046                      LIMIT 1
2047                    ',
2048   }) or return 0; #die "use cust_bill_pkg_recur credits with once_perinv condition";
2049   $cust_bill_pkg->recur;
2050 }
2051
2052 =item unit_setup CUST_PKG
2053
2054 Returns the setup fee for one unit of the package.
2055
2056 =cut
2057
2058 sub unit_setup {
2059   my ($self, $cust_pkg) = @_;
2060   $self->option('setup_fee') || 0;
2061 }
2062
2063 =item setup_margin
2064
2065 unit_setup minus setup_cost
2066
2067 =cut
2068
2069 sub setup_margin {
2070   my $self = shift;
2071   $self->unit_setup(@_) - ($self->setup_cost || 0);
2072 }
2073
2074 =item recur_margin_permonth
2075
2076 base_recur_permonth minus recur_cost_permonth
2077
2078 =cut
2079
2080 sub recur_margin_permonth {
2081   my $self = shift;
2082   $self->base_recur_permonth(@_) - $self->recur_cost_permonth(@_);
2083 }
2084
2085 =item intro_end PACKAGE
2086
2087 Takes an L<FS::cust_pkg> object.  If this plan has an introductory rate,
2088 returns the expected date the intro period will end. If there is no intro
2089 rate, returns zero.
2090
2091 =cut
2092
2093 sub intro_end {
2094   0;
2095 }
2096
2097 =item format OPTION DATA
2098
2099 Returns data formatted according to the function 'format' described
2100 in the plan info.  Returns DATA if no such function exists.
2101
2102 =cut
2103
2104 sub format {
2105   my ($self, $option, $data) = (shift, shift, shift);
2106   if (exists($plans{$self->plan}->{fields}->{$option}{format})) {
2107     &{$plans{$self->plan}->{fields}->{$option}{format}}($data);
2108   }else{
2109     $data;
2110   }
2111 }
2112
2113 =item parse OPTION DATA
2114
2115 Returns data parsed according to the function 'parse' described
2116 in the plan info.  Returns DATA if no such function exists.
2117
2118 =cut
2119
2120 sub parse {
2121   my ($self, $option, $data) = (shift, shift, shift);
2122   if (exists($plans{$self->plan}->{fields}->{$option}{parse})) {
2123     &{$plans{$self->plan}->{fields}->{$option}{parse}}($data);
2124   }else{
2125     $data;
2126   }
2127 }
2128
2129 =back
2130
2131 =cut
2132
2133 =head1 CLASS METHODS
2134
2135 =over 4
2136
2137 =cut
2138
2139 # _upgrade_data
2140 #
2141 # Used by FS::Upgrade to migrate to a new database.
2142
2143 sub _upgrade_data { # class method
2144    my($class, %opts) = @_;
2145
2146   warn "[FS::part_pkg] upgrading $class\n" if $DEBUG;
2147
2148   my @part_pkg = qsearch({
2149     'table'     => 'part_pkg',
2150     'extra_sql' => "WHERE ". join(' OR ',
2151                      'plan IS NULL', "plan = '' ",
2152                    ),
2153   });
2154
2155   foreach my $part_pkg (@part_pkg) {
2156
2157     unless ( $part_pkg->plan ) {
2158       $part_pkg->plan('flat');
2159     }
2160
2161     $part_pkg->replace;
2162
2163   }
2164
2165   # Convert RADIUS accounting usage metrics from megabytes to gigabytes
2166   # (FS RT#28105)
2167   my $upgrade = 'part_pkg_gigabyte_usage';
2168   if (!FS::upgrade_journal->is_done($upgrade)) {
2169     foreach my $part_pkg (qsearch('part_pkg',
2170                                   { plan => 'sqlradacct_hour' })
2171                          ){
2172
2173       my $pkgpart = $part_pkg->pkgpart;
2174
2175       foreach my $opt (qsearch('part_pkg_option',
2176                                { 'optionname'  => { op => 'LIKE',
2177                                                     value => 'recur_included_%',
2178                                                   },
2179                                  pkgpart => $pkgpart,
2180                                })){
2181
2182         next if $opt->optionname eq 'recur_included_hours'; # unfortunately named field
2183         next if $opt->optionvalue == 0;
2184
2185         $opt->optionvalue($opt->optionvalue / 1024);
2186
2187         my $error = $opt->replace;
2188         die $error if $error;
2189       }
2190
2191       foreach my $opt (qsearch('part_pkg_option',
2192                                { 'optionname'  => { op => 'LIKE',
2193                                                     value => 'recur_%_charge',
2194                                                   },
2195                                  pkgpart => $pkgpart,
2196                                })){
2197         $opt->optionvalue($opt->optionvalue * 1024);
2198
2199         my $error = $opt->replace;
2200         die $error if $error;
2201       }
2202
2203     }
2204     FS::upgrade_journal->set_done($upgrade);
2205   }
2206
2207   # the rest can be done asynchronously
2208 }
2209
2210 sub queueable_upgrade {
2211   # now upgrade to the explicit custom flag
2212
2213   my $search = FS::Cursor->new({
2214     'table'     => 'part_pkg',
2215     'hashref'   => { disabled => 'Y', custom => '' },
2216     'extra_sql' => "AND comment LIKE '(CUSTOM) %'",
2217   });
2218   my $dbh = dbh;
2219
2220   while (my $part_pkg = $search->fetch) {
2221     my $new = new FS::part_pkg { $part_pkg->hash };
2222     $new->custom('Y');
2223     my $comment = $part_pkg->comment;
2224     $comment =~ s/^\(CUSTOM\) //;
2225     $comment = '(none)' unless $comment =~ /\S/;
2226     $new->comment($comment);
2227
2228     my $pkg_svc = { map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc };
2229     my $primary = $part_pkg->svcpart;
2230     my $options = { $part_pkg->options };
2231
2232     my $error = $new->replace( $part_pkg,
2233                                'pkg_svc'     => $pkg_svc,
2234                                'primary_svc' => $primary,
2235                                'options'     => $options,
2236                              );
2237     if ($error) {
2238       warn "pkgpart#".$part_pkg->pkgpart.": $error\n";
2239       $dbh->rollback;
2240     } else {
2241       $dbh->commit;
2242     }
2243   }
2244
2245   # set family_pkgpart on any packages that don't have it
2246   $search = FS::Cursor->new('part_pkg', { 'family_pkgpart' => '' });
2247   while (my $part_pkg = $search->fetch) {
2248     $part_pkg->set('family_pkgpart' => $part_pkg->pkgpart);
2249     my $error = $part_pkg->SUPER::replace;
2250     if ($error) {
2251       warn "pkgpart#".$part_pkg->pkgpart.": $error\n";
2252       $dbh->rollback;
2253     } else {
2254       $dbh->commit;
2255     }
2256   }
2257
2258   my @part_pkg_option = qsearch('part_pkg_option',
2259     { 'optionname'  => 'unused_credit',
2260       'optionvalue' => 1,
2261     });
2262   foreach my $old_opt (@part_pkg_option) {
2263     my $pkgpart = $old_opt->pkgpart;
2264     my $error = $old_opt->delete;
2265     die $error if $error;
2266
2267     foreach (qw(unused_credit_cancel unused_credit_change)) {
2268       my $new_opt = new FS::part_pkg_option {
2269         'pkgpart'     => $pkgpart,
2270         'optionname'  => $_,
2271         'optionvalue' => 1,
2272       };
2273       $error = $new_opt->insert;
2274       die $error if $error;
2275     }
2276   }
2277
2278   # migrate use_disposition_taqua and use_disposition to disposition_in
2279   @part_pkg_option = qsearch('part_pkg_option',
2280     { 'optionname'  => { op => 'LIKE',
2281                          value => 'use_disposition%',
2282                        },
2283       'optionvalue' => 1,
2284     });
2285   my %newopts = map { $_->pkgpart => $_ }
2286     qsearch('part_pkg_option',  { 'optionname'  => 'disposition_in', } );
2287   foreach my $old_opt (@part_pkg_option) {
2288         my $pkgpart = $old_opt->pkgpart;
2289         my $newval = $old_opt->optionname eq 'use_disposition_taqua' ? '100'
2290                                                                   : 'ANSWERED';
2291         my $error = $old_opt->delete;
2292         die $error if $error;
2293
2294         if ( exists($newopts{$pkgpart}) ) {
2295             my $opt = $newopts{$pkgpart};
2296             $opt->optionvalue($opt->optionvalue.",$newval");
2297             $error = $opt->replace;
2298             die $error if $error;
2299         } else {
2300             my $new_opt = new FS::part_pkg_option {
2301                 'pkgpart'     => $pkgpart,
2302                 'optionname'  => 'disposition_in',
2303                 'optionvalue' => $newval,
2304               };
2305               $error = $new_opt->insert;
2306               die $error if $error;
2307               $newopts{$pkgpart} = $new_opt;
2308         }
2309   }
2310
2311   # set any package with FCC voice lines to the "VoIP with broadband" category
2312   # for backward compatibility
2313   #
2314   # recover from a bad upgrade bug
2315   my $upgrade = 'part_pkg_fcc_voip_class_FIX';
2316   if (!FS::upgrade_journal->is_done($upgrade)) {
2317     my $bad_upgrade = qsearchs('upgrade_journal',
2318       { upgrade => 'part_pkg_fcc_voip_class' }
2319     );
2320     if ( $bad_upgrade ) {
2321       my $where = 'WHERE history_date <= '.$bad_upgrade->_date.
2322                   ' AND  history_date >  '.($bad_upgrade->_date - 3600);
2323       my @h_part_pkg_option = map { FS::part_pkg_option->new($_->hashref) }
2324         qsearch({
2325           'select'    => '*',
2326           'table'     => 'h_part_pkg_option',
2327           'hashref'   => {},
2328           'extra_sql' => "$where AND history_action = 'delete'",
2329           'order_by'  => 'ORDER BY history_date ASC',
2330         });
2331       my @h_pkg_svc = map { FS::pkg_svc->new($_->hashref) }
2332         qsearch({
2333           'select'    => '*',
2334           'table'     => 'h_pkg_svc',
2335           'hashref'   => {},
2336           'extra_sql' => "$where AND history_action = 'replace_old'",
2337           'order_by'  => 'ORDER BY history_date ASC',
2338         });
2339       my %opt;
2340       foreach my $deleted (@h_part_pkg_option, @h_pkg_svc) {
2341         my $pkgpart ||= $deleted->pkgpart;
2342         $opt{$pkgpart} ||= {
2343           options => {},
2344           pkg_svc => {},
2345           primary_svc => '',
2346           hidden_svc => {},
2347         };
2348         if ( $deleted->isa('FS::part_pkg_option') ) {
2349           $opt{$pkgpart}{options}{ $deleted->optionname } = $deleted->optionvalue;
2350         } else { # pkg_svc
2351           my $svcpart = $deleted->svcpart;
2352           $opt{$pkgpart}{pkg_svc}{$svcpart} = $deleted->quantity;
2353           $opt{$pkgpart}{hidden_svc}{$svcpart} ||= $deleted->hidden;
2354           $opt{$pkgpart}{primary_svc} = $svcpart if $deleted->primary_svc;
2355         }
2356       }
2357       foreach my $pkgpart (keys %opt) {
2358         my $part_pkg = FS::part_pkg->by_key($pkgpart);
2359         my $error = $part_pkg->replace( $part_pkg->replace_old, $opt{$pkgpart} );
2360         if ( $error ) {
2361           die "error recovering damaged pkgpart $pkgpart:\n$error\n";
2362         }
2363       }
2364     } # $bad_upgrade exists
2365     else { # do the original upgrade, but correctly this time
2366       my @part_pkg = qsearch('part_pkg', {
2367           fcc_ds0s        => { op => '>', value => 0 },
2368           fcc_voip_class  => ''
2369       });
2370       foreach my $part_pkg (@part_pkg) {
2371         $part_pkg->set(fcc_voip_class => 2);
2372         my @pkg_svc = $part_pkg->pkg_svc;
2373         my %quantity = map {$_->svcpart, $_->quantity} @pkg_svc;
2374         my %hidden   = map {$_->svcpart, $_->hidden  } @pkg_svc;
2375         my $error = $part_pkg->replace(
2376           $part_pkg->replace_old,
2377           options     => { $part_pkg->options },
2378           pkg_svc     => \%quantity,
2379           hidden_svc  => \%hidden,
2380           primary_svc => ($part_pkg->svcpart || ''),
2381         );
2382         die $error if $error;
2383       }
2384     }
2385     FS::upgrade_journal->set_done($upgrade);
2386   }
2387
2388   # migrate adjourn_months, expire_months, and contract_end_months to
2389   # real fields
2390   foreach my $field (qw(adjourn_months expire_months contract_end_months)) {
2391     foreach my $option (qsearch('part_pkg_option', { optionname => $field })) {
2392       my $part_pkg = $option->part_pkg;
2393       my $error = $option->delete;
2394       if ( $option->optionvalue and $part_pkg->get($field) eq '' ) {
2395         $part_pkg->set($field, $option->optionvalue);
2396         $error ||= $part_pkg->replace;
2397       }
2398       die $error if $error;
2399     }
2400   }
2401
2402   # remove custom flag from one-time charge packages that were accidentally
2403   # flagged as custom
2404   $search = FS::Cursor->new({
2405     'table'   => 'part_pkg',
2406     'hashref' => { 'freq'   => '0',
2407                    'custom' => 'Y',
2408                    'family_pkgpart' => { op => '!=', value => '' },
2409                  },
2410     'addl_from' => ' JOIN
2411   (select pkgpart from cust_pkg group by pkgpart having count(*) = 1)
2412     AS singular_pkg USING (pkgpart)',
2413   });
2414   my @fields = grep {     $_ ne 'pkgpart'
2415                       and $_ ne 'custom'
2416                       and $_ ne 'disabled' } FS::part_pkg->fields;
2417   PKGPART: while (my $part_pkg = $search->fetch) {
2418     # can't merge the package back into its parent (too late for that)
2419     # but we can remove the custom flag if it's not actually customized,
2420     # i.e. nothing has been changed.
2421
2422     my $family_pkgpart = $part_pkg->family_pkgpart;
2423     next PKGPART if $family_pkgpart == $part_pkg->pkgpart;
2424     my $parent_pkg = FS::part_pkg->by_key($family_pkgpart);
2425     foreach my $field (@fields) {
2426       if ($part_pkg->get($field) ne $parent_pkg->get($field)) {
2427         next PKGPART;
2428       }
2429     }
2430     # options have to be identical too
2431     # but links, FCC options, discount plans, and usage packages can't be
2432     # changed through the "modify charge" UI, so skip them
2433     my %newopt = $part_pkg->options;
2434     my %oldopt = $parent_pkg->options;
2435     OPTION: foreach my $option (keys %newopt) {
2436       if (delete $newopt{$option} ne delete $oldopt{$option}) {
2437         next PKGPART;
2438       }
2439     }
2440     if (keys(%newopt) or keys(%oldopt)) {
2441       next PKGPART;
2442     }
2443     # okay, now replace it
2444     warn "Removing custom flag from part_pkg#".$part_pkg->pkgpart."\n";
2445     $part_pkg->set('custom', '');
2446     my $error = $part_pkg->replace;
2447     die $error if $error;
2448   } # $search->fetch
2449
2450   return;
2451 }
2452
2453 =item curuser_pkgs_sql
2454
2455 Returns an SQL fragment for searching for packages the current user can
2456 use, either via part_pkg.agentnum directly, or via agent type (see
2457 L<FS::type_pkgs>).
2458
2459 =cut
2460
2461 sub curuser_pkgs_sql {
2462   my $class = shift;
2463
2464   $class->_pkgs_sql( $FS::CurrentUser::CurrentUser->agentnums );
2465
2466 }
2467
2468 =item agent_pkgs_sql AGENT | AGENTNUM, ...
2469
2470 Returns an SQL fragment for searching for packages the provided agent or agents
2471 can use, either via part_pkg.agentnum directly, or via agent type (see
2472 L<FS::type_pkgs>).
2473
2474 =cut
2475
2476 sub agent_pkgs_sql {
2477   my $class = shift;  #i'm a class method, not a sub (the question is... why??)
2478   my @agentnums = map { ref($_) ? $_->agentnum : $_ } @_;
2479
2480   $class->_pkgs_sql(@agentnums); #is this why
2481
2482 }
2483
2484 sub _pkgs_sql {
2485   my( $class, @agentnums ) = @_;
2486   my $agentnums = join(',', @agentnums);
2487
2488   "
2489     (
2490       ( agentnum IS NOT NULL AND agentnum IN ($agentnums) )
2491       OR ( agentnum IS NULL
2492            AND EXISTS ( SELECT 1
2493                           FROM type_pkgs
2494                             LEFT JOIN agent_type USING ( typenum )
2495                             LEFT JOIN agent AS typeagent USING ( typenum )
2496                           WHERE type_pkgs.pkgpart = part_pkg.pkgpart
2497                             AND typeagent.agentnum IN ($agentnums)
2498                       )
2499          )
2500     )
2501   ";
2502
2503 }
2504
2505 =item join_options_sql
2506
2507 Returns an SQL fragment for JOINing the part_pkg_option records for this
2508 package's setup_fee and recur_fee (as setup_option and recur_option,
2509 respectively).  Useful for optimization.
2510
2511 =cut
2512
2513 sub join_options_sql {
2514   #my $class = shift;
2515   "
2516     LEFT JOIN part_pkg_option AS setup_option
2517       ON (     part_pkg.pkgpart = setup_option.pkgpart
2518            AND setup_option.optionname = 'setup_fee' )
2519     LEFT JOIN part_pkg_option AS recur_option
2520       ON (     part_pkg.pkgpart = recur_option.pkgpart
2521            AND recur_option.optionname = 'recur_fee' )
2522   ";
2523 }
2524
2525 =back
2526
2527 =head1 SUBROUTINES
2528
2529 =over 4
2530
2531 =item plan_info
2532
2533 =cut
2534
2535 #false laziness w/part_export & cdr
2536 my %info;
2537 foreach my $INC ( @INC ) {
2538   warn "globbing $INC/FS/part_pkg/[a-z]*.pm\n" if $DEBUG;
2539   foreach my $file ( glob("$INC/FS/part_pkg/[a-z]*.pm") ) {
2540     warn "attempting to load plan info from $file\n" if $DEBUG;
2541     $file =~ /\/(\w+)\.pm$/ or do {
2542       warn "unrecognized file in $INC/FS/part_pkg/: $file\n";
2543       next;
2544     };
2545     my $mod = $1;
2546     my $info = eval "use FS::part_pkg::$mod; ".
2547                     "\\%FS::part_pkg::$mod\::info;";
2548     if ( $@ ) {
2549       die "error using FS::part_pkg::$mod (skipping): $@\n" if $@;
2550       next;
2551     }
2552     unless ( keys %$info ) {
2553       warn "no %info hash found in FS::part_pkg::$mod, skipping\n";
2554       next;
2555     }
2556     warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG;
2557     #if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
2558     #  warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG;
2559     #  next;
2560     #}
2561     $info{$mod} = $info;
2562     $info->{'weight'} ||= 0; # quiet warnings
2563   }
2564 }
2565
2566 # copy one level deep to allow replacement of fields and fieldorder
2567 tie %plans, 'Tie::IxHash',
2568   map  { my %infohash = %{ $info{$_} };
2569           $_ => \%infohash }
2570   sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} }
2571   keys %info;
2572
2573 # inheritance of plan options
2574 foreach my $name (keys(%info)) {
2575   if (exists($info{$name}->{'disabled'}) and $info{$name}->{'disabled'}) {
2576     warn "skipping disabled plan FS::part_pkg::$name" if $DEBUG;
2577     delete $plans{$name};
2578     next;
2579   }
2580   my $parents = $info{$name}->{'inherit_fields'} || [];
2581   my (%fields, %field_exists, @fieldorder);
2582   foreach my $parent ($name, @$parents) {
2583     if ( !exists($info{$parent}) ) {
2584       warn "$name tried to inherit from nonexistent '$parent'\n";
2585       next;
2586     }
2587     %fields = ( # avoid replacing existing fields
2588       %{ $info{$parent}->{'fields'} || {} },
2589       %fields
2590     );
2591     foreach (@{ $info{$parent}->{'fieldorder'} || [] }) {
2592       # avoid duplicates
2593       next if $field_exists{$_};
2594       $field_exists{$_} = 1;
2595       # allow inheritors to remove inherited fields from the fieldorder
2596       push @fieldorder, $_ if !exists($fields{$_}) or
2597                               !exists($fields{$_}->{'disabled'});
2598     }
2599   }
2600   $plans{$name}->{'fields'} = \%fields;
2601   $plans{$name}->{'fieldorder'} = \@fieldorder;
2602 }
2603
2604 sub plan_info {
2605   \%plans;
2606 }
2607
2608
2609 =back
2610
2611 =head1 NEW PLAN CLASSES
2612
2613 A module should be added in FS/FS/part_pkg/  Eventually, an example may be
2614 found in eg/plan_template.pm.  Until then, it is suggested that you use the
2615 other modules in FS/FS/part_pkg/ as a guide.
2616
2617 =head1 BUGS
2618
2619 The delete method is unimplemented.
2620
2621 setup and recur semantics are not yet defined (and are implemented in
2622 FS::cust_bill.  hmm.).  now they're deprecated and need to go.
2623
2624 plandata should go
2625
2626 part_pkg_taxrate is Pg specific
2627
2628 replace should be smarter about managing the related tables (options, pkg_svc)
2629
2630 =head1 SEE ALSO
2631
2632 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
2633 schema.html from the base documentation.
2634
2635 =cut
2636
2637 1;