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   $$valref = 0 unless $$valref;
 699   return "Invalid $option"
 700     unless ($$valref) = ($$valref =~ /^\s*(\d+)\s*$/);
 701   return '';
 702 }
 703
 704 =item check
 705
 706 Checks all fields to make sure this is a valid package definition.  If
 707 there is an error, returns the error, otherwise returns false.  Called by the
 708 insert and replace methods.
 709
 710 =cut
 711
 712 sub check {
 713   my $self = shift;
 714   warn "FS::part_pkg::check called on $self" if $DEBUG;
 715
 716   for (qw(setup recur plandata)) {
 717     #$self->set($_=>0) if $self->get($_) =~ /^\s*$/; }
 718     return "Use of $_ field is deprecated; set a plan and options: ".
 719            $self->get($_)
 720       if length($self->get($_));
 721     $self->set($_, '');
 722   }
 723
 724   if ( $self->dbdef_table->column('freq')->type =~ /(int)/i ) {
 725     my $error = $self->ut_number('freq');
 726     return $error if $error;
 727   } else {
 728     $self->freq =~ /^(\d+[hdw]?)$/
 729       or return "Illegal or empty freq: ". $self->freq;
 730     $self->freq($1);
 731   }
 732
 733   my @null_agentnum_right = ( 'Edit global package definitions' );
 734   push @null_agentnum_right, 'One-time charge'
 735     if $self->freq =~ /^0/;
 736   push @null_agentnum_right, 'Customize customer package'
 737     if $self->disabled eq 'Y'; #good enough
 738
 739   my $error = $self->ut_numbern('pkgpart')
 740     || $self->ut_text('pkg')
 741     || $self->ut_textn('comment')
 742     || $self->ut_textn('promo_code')
 743     || $self->ut_alphan('plan')
 744     || $self->ut_flag('setuptax')
 745     || $self->ut_flag('recurtax')
 746     || $self->ut_textn('taxclass')
 747     || $self->ut_flag('disabled')
 748     || $self->ut_flag('custom')
 749     || $self->ut_flag('no_auto')
 750     || $self->ut_flag('recur_show_zero')
 751     || $self->ut_flag('setup_show_zero')
 752     || $self->ut_flag('start_on_hold')
 753     #|| $self->ut_moneyn('setup_cost')
 754     #|| $self->ut_moneyn('recur_cost')
 755     || $self->ut_floatn('setup_cost')
 756     || $self->ut_floatn('recur_cost')
 757     || $self->ut_floatn('pay_weight')
 758     || $self->ut_floatn('credit_weight')
 759     || $self->ut_numbern('taxproductnum')
 760     || $self->ut_numbern('units_taxproductnum')
 761     || $self->ut_foreign_keyn('classnum',       'pkg_class', 'classnum')
 762     || $self->ut_foreign_keyn('addon_classnum', 'pkg_class', 'classnum')
 763     || $self->ut_foreign_keyn('taxproductnum',
 764                               'part_pkg_taxproduct',
 765                               'taxproductnum'
 766                              )
 767     || ( $setup_hack
 768            ? $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum' )
 769            : $self->ut_agentnum_acl('agentnum', \@null_agentnum_right)
 770        )
 771     || $self->ut_numbern('fcc_ds0s')
 772     || $self->ut_numbern('fcc_voip_class')
 773     || $self->ut_numbern('delay_start')
 774     || $self->ut_foreign_keyn('successor', 'part_pkg', 'pkgpart')
 775     || $self->ut_foreign_keyn('family_pkgpart', 'part_pkg', 'pkgpart')
 776     || $self->ut_numbern('expire_months')
 777     || $self->ut_numbern('adjourn_months')
 778     || $self->ut_numbern('contract_end_months')
 779     || $self->ut_numbern('change_to_pkgpart')
 780     || $self->ut_foreign_keyn('change_to_pkgpart', 'part_pkg', 'pkgpart')
 781     || $self->ut_alphan('agent_pkgpartid')
 782     || $self->SUPER::check
 783   ;
 784   return $error if $error;
 785
 786   return 'Unknown plan '. $self->plan
 787     unless exists($plans{$self->plan});
 788
 789   my $conf = new FS::Conf;
 790   return 'Taxclass is required'
 791     if ! $self->taxclass && $conf->exists('require_taxclasses');
 792
 793   '';
 794 }
 795
 796 =item check_options
 797
 798 Pass an I<$options> hashref that contains the values to be
 799 inserted or updated for any FS::part_pkg::MODULE.pm.
 800
 801 For each key in I<$options>, validates the value by calling
 802 the 'validate' subroutine defined for that option e.g.
 803 FS::part_pkg::MODULE::plan_info()->{$KEY}->{validate}.  The
 804 option validation function is only called when the hashkey for
 805 that option exists in I<$options>.
 806
 807 Then the module validation function is called, from
 808 FS::part_pkg::MODULE::plan_info()->{validate}
 809
 810 Returns error message, or empty string if valid.
 811
 812 Invoked by L</insert> and L</replace> via the equivalent
 813 methods in L<FS::option_Common>.
 814
 815 =cut
 816
 817 sub check_options {
 818   my ($self,$options) = @_;
 819   foreach my $option (keys %$options) {
 820     if (exists $plans{ $self->plan }->{fields}->{$option}) {
 821       if (exists($plans{$self->plan}->{fields}->{$option}->{'validate'})) {
 822         # pass option name for use in error message
 823         # pass a reference to the $options value, so it can be cleaned up
 824         my $error = &{$plans{$self->plan}->{fields}->{$option}->{'validate'}}($option,\($options->{$option}));
 825         return $error if $error;
 826       }
 827     } # else "option does not exist" error?
 828   }
 829   if (exists($plans{$self->plan}->{'validate'})) {
 830     my $error = &{$plans{$self->plan}->{'validate'}}($options);
 831     return $error if $error;
 832   }
 833   return '';
 834 }
 835
 836 =item check_pkg_svc
 837
 838 Checks pkg_svc records as a whole (for part_svc_link dependencies).
 839
 840 If there is an error, returns the error, otherwise returns false.
 841
 842 =cut
 843
 844 sub check_pkg_svc {
 845   my( $self, %opt ) = @_;
 846
 847   my $agentnum = $self->agentnum;
 848
 849   my %pkg_svc = map { $_->svcpart => $_ } $self->pkg_svc;
 850
 851   foreach my $svcpart ( keys %pkg_svc ) {
 852
 853     foreach my $part_svc_link ( $self->part_svc_link(
 854                                   'src_svcpart' => $svcpart,
 855                                   'link_type'   => 'part_pkg_restrict',
 856                                 )
 857     ) {
 858
 859       return $part_svc_link->dst_svc. ' must be included with '.
 860              $part_svc_link->src_svc
 861         unless $pkg_svc{ $part_svc_link->dst_svcpart };
 862     }
 863
 864   }
 865
 866   return '' if $opt{part_pkg_restrict_soft_override};
 867
 868   foreach my $svcpart ( keys %pkg_svc ) {
 869
 870     foreach my $part_svc_link ( $self->part_svc_link(
 871                                   'src_svcpart' => $svcpart,
 872                                   'link_type'   => 'part_pkg_restrict_soft',
 873                                 )
 874     ) {
 875       return $part_svc_link->dst_svc. ' is suggested with '.
 876              $part_svc_link->src_svc
 877         unless $pkg_svc{ $part_svc_link->dst_svcpart };
 878     }
 879
 880   }
 881
 882   '';
 883 }
 884
 885 =item part_svc_link OPTION => VALUE ...
 886
 887 Returns the service dependencies (see L<FS::part_svc_link>) for the given
 888 search options, taking into account this package definition's agent.
 889
 890 Available options are any field in part_svc_link.  Typically used options are
 891 src_svcpart and link_type.
 892
 893 =cut
 894
 895 sub part_svc_link {
 896   FS::part_svc_link->by_agentnum( shift->agentnum, @_ );
 897 }
 898
 899 =item supersede OLD [, OPTION => VALUE ... ]
 900
 901 Inserts this package as a successor to the package OLD.  All options are as
 902 for C<insert>.  After inserting, disables OLD and sets the new package as its
 903 successor.
 904
 905 =cut
 906
 907 sub supersede {
 908   my ($new, $old, %options) = @_;
 909   my $error;
 910
 911   $new->set('pkgpart' => '');
 912   $new->set('family_pkgpart' => $old->family_pkgpart);
 913   warn "    inserting successor package\n" if $DEBUG;
 914   $error = $new->insert(%options);
 915   return $error if $error;
 916
 917   warn "    disabling superseded package\n" if $DEBUG;
 918   $old->set('successor' => $new->pkgpart);
 919   $old->set('disabled' => 'Y');
 920   $error = $old->SUPER::replace; # don't change its options/pkg_svc records
 921   return $error if $error;
 922
 923   warn "  propagating changes to family" if $DEBUG;
 924   $new->propagate($old);
 925 }
 926
 927 =item propagate OLD
 928
 929 If any of certain fields have changed from OLD to this package, then,
 930 for all packages in the same lineage as this one, sets those fields
 931 to their values in this package.
 932
 933 =cut
 934
 935 my @propagate_fields = (
 936   qw( pkg classnum setup_cost recur_cost taxclass
 937   setuptax recurtax pay_weight credit_weight
 938   )
 939 );
 940
 941 sub propagate {
 942   my $new = shift;
 943   my $old = shift;
 944   my %fields = (
 945     map { $_ => $new->get($_) }
 946     grep { $new->get($_) ne $old->get($_) }
 947     @propagate_fields
 948   );
 949
 950   my @part_pkg = qsearch('part_pkg', {
 951       'family_pkgpart' => $new->family_pkgpart
 952   });
 953   my @error;
 954   foreach my $part_pkg ( @part_pkg ) {
 955     my $pkgpart = $part_pkg->pkgpart;
 956     next if $pkgpart == $new->pkgpart; # don't modify $new
 957     warn "    propagating to pkgpart $pkgpart\n" if $DEBUG;
 958     foreach ( keys %fields ) {
 959       $part_pkg->set($_, $fields{$_});
 960     }
 961     # SUPER::replace to avoid changing non-core fields
 962     my $error = $part_pkg->SUPER::replace;
 963     push @error, "pkgpart $pkgpart: $error"
 964       if $error;
 965   }
 966   join("\n", @error);
 967 }
 968
 969 =item set_fcc_options HASHREF
 970
 971 Sets the FCC options on this package definition to the values specified
 972 in HASHREF.
 973
 974 =cut
 975
 976 sub set_fcc_options {
 977   my $self = shift;
 978   my $pkgpart = $self->pkgpart;
 979   my $options;
 980   if (ref $_[0]) {
 981     $options = shift;
 982   } else {
 983     $options = { @_ };
 984   }
 985
 986   my %existing_num = map { $_->fccoptionname => $_->num }
 987                      qsearch('part_pkg_fcc_option', { pkgpart => $pkgpart });
 988
 989   local $FS::Record::nowarn_identical = 1;
 990   # set up params for process_o2m
 991   my $i = 0;
 992   my $params = {};
 993   foreach my $name (keys %$options ) {
 994     $params->{ "num$i" } = $existing_num{$name} || '';
 995     $params->{ "num$i".'_fccoptionname' } = $name;
 996     $params->{ "num$i".'_optionvalue'   } = $options->{$name};
 997     $i++;
 998   }
 999
1000   $self->process_o2m(
1001     table   => 'part_pkg_fcc_option',
1002     fields  => [qw( fccoptionname optionvalue )],
1003     params  => $params,
1004   );
1005 }
1006
1007 =item pkg_locale LOCALE
1008
1009 Returns a customer-viewable string representing this package for the given
1010 locale, from the part_pkg_msgcat table.  If the given locale is empty or no
1011 localized string is found, returns the base pkg field.
1012
1013 =cut
1014
1015 sub pkg_locale {
1016   my( $self, $locale ) = @_;
1017   return $self->pkg unless $locale;
1018   my $part_pkg_msgcat = $self->part_pkg_msgcat($locale) or return $self->pkg;
1019   $part_pkg_msgcat->pkg;
1020 }
1021
1022 =item part_pkg_msgcat LOCALE
1023
1024 Like pkg_locale, but returns the FS::part_pkg_msgcat object itself.
1025
1026 =cut
1027
1028 sub part_pkg_msgcat {
1029   my( $self, $locale ) = @_;
1030   qsearchs( 'part_pkg_msgcat', {
1031     pkgpart => $self->pkgpart,
1032     locale  => $locale,
1033   });
1034 }
1035
1036 =item pkg_comment [ OPTION => VALUE... ]
1037
1038 Returns an (internal) string representing this package.  Currently,
1039 "pkgpart: pkg - comment", is returned.  "pkg - comment" may be returned in the
1040 future, omitting pkgpart.  The comment will have '(CUSTOM) ' prepended if
1041 custom is Y.
1042
1043 If the option nopkgpart is true then the "pkgpart: ' is omitted.
1044
1045 =cut
1046
1047 sub pkg_comment {
1048   my $self = shift;
1049   my %opt = @_;
1050
1051   #$self->pkg. ' - '. $self->comment;
1052   #$self->pkg. ' ('. $self->comment. ')';
1053   my $pre = $opt{nopkgpart} ? '' : $self->pkgpart. ': ';
1054   my $custom_comment = $self->custom_comment(%opt);
1055   $pre. $self->pkg. ( $custom_comment ? " - $custom_comment" : '' );
1056 }
1057
1058 #without price info (so without hitting the DB again)
1059 sub pkg_comment_only {
1060   my $self = shift;
1061   my %opt = @_;
1062
1063   my $pre = $opt{nopkgpart} ? '' : $self->pkgpart. ': ';
1064   my $comment = $self->comment;
1065   $pre. $self->pkg. ( $comment ? " - $comment" : '' );
1066 }
1067
1068 sub price_info { # safety, in case a part_pkg hasn't defined price_info
1069     '';
1070 }
1071
1072 sub custom_comment {
1073   my $self = shift;
1074   my $price_info = $self->price_info(@_);
1075   ( $self->custom ? '(CUSTOM) ' : '' ).
1076     $self->comment.
1077     ( ($self->custom || $self->comment) ? ' - ' : '' ).
1078     ($price_info || 'No charge');
1079 }
1080
1081 sub pkg_price_info {
1082   my $self = shift;
1083   $self->pkg. ' - '. ($self->price_info || 'No charge');
1084 }
1085
1086 =item pkg_class
1087
1088 Returns the package class, as an FS::pkg_class object, or the empty string
1089 if there is no package class.
1090
1091 =item addon_pkg_class
1092
1093 Returns the add-on package class, as an FS::pkg_class object, or the empty
1094 string if there is no add-on package class.
1095
1096 =cut
1097
1098 sub addon_pkg_class {
1099   my $self = shift;
1100   if ( $self->addon_classnum ) {
1101     qsearchs('pkg_class', { 'classnum' => $self->addon_classnum } );
1102   } else {
1103     return '';
1104   }
1105 }
1106
1107 =item categoryname
1108
1109 Returns the package category name, or the empty string if there is no package
1110 category.
1111
1112 =cut
1113
1114 sub categoryname {
1115   my $self = shift;
1116   my $pkg_class = $self->pkg_class;
1117   $pkg_class
1118     ? $pkg_class->categoryname
1119     : '';
1120 }
1121
1122 =item classname
1123
1124 Returns the package class name, or the empty string if there is no package
1125 class.
1126
1127 =cut
1128
1129 sub classname {
1130   my $self = shift;
1131   my $pkg_class = $self->pkg_class;
1132   $pkg_class
1133     ? $pkg_class->classname
1134     : '';
1135 }
1136
1137 =item addon_classname
1138
1139 Returns the add-on package class name, or the empty string if there is no
1140 add-on package class.
1141
1142 =cut
1143
1144 sub addon_classname {
1145   my $self = shift;
1146   my $pkg_class = $self->addon_pkg_class;
1147   $pkg_class
1148     ? $pkg_class->classname
1149     : '';
1150 }
1151
1152 =item agent
1153
1154 Returns the associated agent for this event, if any, as an FS::agent object.
1155
1156 =item pkg_svc [ HASHREF | OPTION => VALUE ]
1157
1158 Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
1159 definition (with non-zero quantity).
1160
1161 One option is available, I<disable_linked>.  If set true it will return the
1162 services for this package definition alone, omitting services from any add-on
1163 packages.
1164
1165 =cut
1166
1167 =item type_pkgs
1168
1169 Returns all FS::type_pkgs objects (see L<FS::type_pkgs>) for this package
1170 definition.
1171
1172 =cut
1173
1174 sub pkg_svc {
1175   my $self = shift;
1176
1177   return @{ $cache_pkg_svc{$self->pkgpart} }
1178     if $cache_enabled && $cache_pkg_svc{$self->pkgpart};
1179
1180 #  #sort { $b->primary cmp $a->primary }
1181 #    grep { $_->quantity }
1182 #      qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
1183
1184   my $opt = ref($_[0]) ? $_[0] : { @_ };
1185   my %pkg_svc = map  { $_->svcpart => $_ } $self->_pkg_svc;
1186
1187   unless ( $opt->{disable_linked} ) {
1188     foreach my $dst_pkg ( map $_->dst_pkg, $self->svc_part_pkg_link ) {
1189       my @pkg_svc = $dst_pkg->_pkg_svc;
1190       foreach my $pkg_svc ( @pkg_svc ) {
1191         if ( $pkg_svc{$pkg_svc->svcpart} ) {
1192           my $quantity = $pkg_svc{$pkg_svc->svcpart}->quantity;
1193           $pkg_svc{$pkg_svc->svcpart}->quantity($quantity + $pkg_svc->quantity);
1194         } else {
1195           $pkg_svc{$pkg_svc->svcpart} = $pkg_svc;
1196         }
1197       }
1198     }
1199   }
1200
1201   my @pkg_svc = values(%pkg_svc);
1202
1203   $cache_pkg_svc{$self->pkgpart} = \@pkg_svc if $cache_enabled;
1204
1205   @pkg_svc;
1206
1207 }
1208
1209 sub _pkg_svc {
1210   my $self = shift;
1211   grep { $_->quantity }
1212     qsearch({
1213       'select'    => 'pkg_svc.*, part_svc.*',
1214       'table'     => 'pkg_svc',
1215       'addl_from' => 'LEFT JOIN part_svc USING ( svcpart )',
1216       'hashref'   => { 'pkgpart' => $self->pkgpart },
1217     });
1218 }
1219
1220 =item svcpart [ SVCDB ]
1221
1222 Returns the svcpart of the primary service definition (see L<FS::part_svc>)
1223 associated with this package definition (see L<FS::pkg_svc>).  Returns
1224 false if there not a primary service definition or exactly one service
1225 definition with quantity 1, or if SVCDB is specified and does not match the
1226 svcdb of the service definition.  SVCDB can be specified as a scalar table
1227 name, such as 'svc_acct', or as an arrayref of possible table names.
1228
1229 =cut
1230
1231 sub svcpart {
1232   my $pkg_svc = shift->_primary_pkg_svc(@_);
1233   $pkg_svc ? $pkg_svc->svcpart : '';
1234 }
1235
1236 =item part_svc [ SVCDB ]
1237
1238 Like the B<svcpart> method, but returns the FS::part_svc object (see
1239 L<FS::part_svc>).
1240
1241 =cut
1242
1243 sub part_svc {
1244   my $pkg_svc = shift->_primary_pkg_svc(@_);
1245   $pkg_svc ? $pkg_svc->part_svc : '';
1246 }
1247
1248 sub _primary_pkg_svc {
1249   my $self = shift;
1250
1251   my $svcdb = scalar(@_) ? shift : [];
1252   $svcdb = ref($svcdb) ? $svcdb : [ $svcdb ];
1253   my %svcdb = map { $_=>1 } @$svcdb;
1254
1255   my @svcdb_pkg_svc =
1256     grep { !scalar(@$svcdb) || $svcdb{ $_->part_svc->svcdb } }
1257          $self->pkg_svc;
1258
1259   my @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc;
1260   @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc
1261     unless @pkg_svc;
1262   return '' if scalar(@pkg_svc) != 1;
1263   $pkg_svc[0];
1264 }
1265
1266 =item svcpart_unique_svcdb SVCDB
1267
1268 Returns the svcpart of a service definition (see L<FS::part_svc>) matching
1269 SVCDB associated with this package definition (see L<FS::pkg_svc>).  Returns
1270 false if there not a primary service definition for SVCDB or there are multiple
1271 service definitions for SVCDB.
1272
1273 =cut
1274
1275 sub svcpart_unique_svcdb {
1276   my( $self, $svcdb ) = @_;
1277   my @svcdb_pkg_svc = grep { ( $svcdb eq $_->part_svc->svcdb ) } $self->pkg_svc;
1278   return '' if scalar(@svcdb_pkg_svc) != 1;
1279   $svcdb_pkg_svc[0]->svcpart;
1280 }
1281
1282 =item payby
1283
1284 Returns a list of the acceptable payment types for this package.  Eventually
1285 this should come out of a database table and be editable, but currently has the
1286 following logic instead:
1287
1288 If the package is free, the single item B<BILL> is
1289 returned, otherwise, the single item B<CARD> is returned.
1290
1291 (CHEK?  LEC?  Probably shouldn't accept those by default, prone to abuse)
1292
1293 =cut
1294
1295 sub payby {
1296   my $self = shift;
1297   if ( $self->is_free ) {
1298     ( 'BILL' );
1299   } else {
1300     ( 'CARD' );
1301   }
1302 }
1303
1304 =item is_free
1305
1306 Returns true if this package is free.
1307
1308 =cut
1309
1310 sub is_free {
1311   my $self = shift;
1312   if ( $self->can('is_free_options') ) {
1313     not grep { $_ !~ /^\s*0*(\.0*)?\s*$/ }
1314          map { $self->option($_) }
1315              $self->is_free_options;
1316   } else {
1317     warn "FS::part_pkg::is_free: FS::part_pkg::". $self->plan. " subclass ".
1318          "provides neither is_free_options nor is_free method; returning false";
1319     0;
1320   }
1321 }
1322
1323 # whether the plan allows discounts to be applied to this package
1324 sub can_discount { 0; }
1325
1326 # whether the plan allows changing the start date
1327 sub can_start_date {
1328   my $self = shift;
1329   $self->start_on_hold ? 0 : 1;
1330 }
1331
1332 # whether the plan supports part_pkg_usageprice add-ons (a specific kind of
1333 #  pre-selectable usage pricing, there's others this doesn't refer to)
1334 sub can_usageprice { 0; }
1335
1336 # the delay start date if present
1337 sub delay_start_date {
1338   my $self = shift;
1339
1340   my $delay = $self->delay_start or return '';
1341
1342   # avoid timelocal silliness
1343   my $dt = DateTime->today(time_zone => 'local');
1344   $dt->add(days => $delay);
1345   $dt->epoch;
1346 }
1347
1348 sub can_currency_exchange { 0; }
1349
1350 sub freqs_href {
1351   # moved to FS::Misc to make this accessible to other packages
1352   # at initialization
1353   FS::Misc::pkg_freqs();
1354 }
1355
1356 =item freq_pretty
1357
1358 Returns an english representation of the I<freq> field, such as "monthly",
1359 "weekly", "semi-annually", etc.
1360
1361 =cut
1362
1363 sub freq_pretty {
1364   my $self = shift;
1365   my $freq = $self->freq;
1366
1367   #my $freqs_href = $self->freqs_href;
1368   my $freqs_href = freqs_href();
1369
1370   if ( exists($freqs_href->{$freq}) ) {
1371     $freqs_href->{$freq};
1372   } else {
1373     my $interval = 'month';
1374     if ( $freq =~ /^(\d+)([hdw])$/ ) {
1375       my %interval = ( 'h' => 'hour', 'd'=>'day', 'w'=>'week' );
1376       $interval = $interval{$2};
1377     }
1378     if ( $1 == 1 ) {
1379       "every $interval";
1380     } else {
1381       "every $freq ${interval}s";
1382     }
1383   }
1384 }
1385
1386 =item add_freq TIMESTAMP [ FREQ ]
1387
1388 Adds a billing period of some frequency to the provided timestamp and
1389 returns the resulting timestamp, or -1 if the frequency could not be
1390 parsed (shouldn't happen).  By default, the frequency of this package
1391 will be used; to override this, pass a different frequency as a second
1392 argument.
1393
1394 =cut
1395
1396 sub add_freq {
1397   my( $self, $date, $freq ) = @_;
1398   $freq = $self->freq unless $freq;
1399
1400   #change this bit to use Date::Manip? CAREFUL with timezones (see
1401   # mailing list archive)
1402   my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($date) )[0,1,2,3,4,5];
1403
1404   if ( $freq =~ /^\d+$/ ) {
1405     $mon += $freq;
1406     until ( $mon < 12 ) { $mon -= 12; $year++; }
1407
1408     $mday = 28 if $mday > 28 && FS::Conf->new->exists('anniversary-rollback');
1409
1410   } elsif ( $freq =~ /^(\d+)w$/ ) {
1411     my $weeks = $1;
1412     $mday += $weeks * 7;
1413   } elsif ( $freq =~ /^(\d+)d$/ ) {
1414     my $days = $1;
1415     $mday += $days;
1416   } elsif ( $freq =~ /^(\d+)h$/ ) {
1417     my $hours = $1;
1418     $hour += $hours;
1419   } else {
1420     return -1;
1421   }
1422
1423   timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
1424 }
1425
1426 =item plandata
1427
1428 For backwards compatibility, returns the plandata field as well as all options
1429 from FS::part_pkg_option.
1430
1431 =cut
1432
1433 sub plandata {
1434   my $self = shift;
1435   carp "plandata is deprecated";
1436   if ( @_ ) {
1437     $self->SUPER::plandata(@_);
1438   } else {
1439     my $plandata = $self->get('plandata');
1440     my %options = $self->options;
1441     $plandata .= join('', map { "$_=$options{$_}\n" } keys %options );
1442     $plandata;
1443   }
1444 }
1445
1446 =item part_pkg_vendor
1447
1448 Returns all vendor/external package ids as FS::part_pkg_vendor objects (see
1449 L<FS::part_pkg_vendor>).
1450
1451 =item vendor_pkg_ids
1452
1453 Returns a list of vendor/external package ids by exportnum
1454
1455 =cut
1456
1457 sub vendor_pkg_ids {
1458   my $self = shift;
1459   map { $_->exportnum => $_->vendor_pkg_id } $self->part_pkg_vendor;
1460 }
1461
1462 =item part_pkg_option
1463
1464 Returns all options as FS::part_pkg_option objects (see
1465 L<FS::part_pkg_option>).
1466
1467 =item options
1468
1469 Returns a list of option names and values suitable for assigning to a hash.
1470
1471 =cut
1472
1473 sub options {
1474   my $self = shift;
1475   map { $_->optionname => $_->optionvalue } $self->part_pkg_option;
1476 }
1477
1478 =item option OPTIONNAME [ QUIET ]
1479
1480 Returns the option value for the given name, or the empty string.  If a true
1481 value is passed as the second argument, warnings about missing the option
1482 will be suppressed.
1483
1484 =cut
1485
1486 sub option {
1487   my( $self, $opt, $ornull ) = @_;
1488
1489   #cache: was pulled up in the original part_pkg query
1490   return $self->hashref->{"_opt_$opt"}
1491     if exists $self->hashref->{"_opt_$opt"};
1492
1493   cluck "$self -> option: searching for $opt" if $DEBUG;
1494   my $part_pkg_option =
1495     qsearchs('part_pkg_option', {
1496       pkgpart    => $self->pkgpart,
1497       optionname => $opt,
1498   } );
1499   return $part_pkg_option->optionvalue if $part_pkg_option;
1500
1501   my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); }
1502                      split("\n", $self->get('plandata') );
1503   return $plandata{$opt} if exists $plandata{$opt};
1504
1505   # check whether the option is defined in plan info (if so, don't warn)
1506   if (exists $plans{ $self->plan }->{fields}->{$opt}) {
1507     return '';
1508   }
1509   cluck "WARNING: (pkgpart ". $self->pkgpart. ") Package def option $opt ".
1510         "not found in options or plandata!\n"
1511     unless $ornull;
1512
1513   '';
1514 }
1515
1516 =item part_pkg_currency [ CURRENCY ]
1517
1518 Returns all currency options as FS::part_pkg_currency objects (see
1519 L<FS::part_pkg_currency>), or, if a currency is specified, only return the
1520 objects for that currency.
1521
1522 =cut
1523
1524 sub part_pkg_currency {
1525   my $self = shift;
1526   my %hash = ( 'pkgpart' => $self->pkgpart );
1527   $hash{'currency'} = shift if @_;
1528   qsearch('part_pkg_currency', \%hash );
1529 }
1530
1531 =item part_pkg_currency_options CURRENCY
1532
1533 Returns a list of option names and values from FS::part_pkg_currency for the
1534 specified currency.
1535
1536 =cut
1537
1538 sub part_pkg_currency_options {
1539   my $self = shift;
1540   map { $_->optionname => $_->optionvalue } $self->part_pkg_currency(shift);
1541 }
1542
1543 =item part_pkg_currency_option CURRENCY OPTIONNAME
1544
1545 Returns the option value for the given name and currency.
1546
1547 =cut
1548
1549 sub part_pkg_currency_option {
1550   my( $self, $currency, $optionname ) = @_;
1551   my $part_pkg_currency =
1552     qsearchs('part_pkg_currency', { 'pkgpart'    => $self->pkgpart,
1553                                     'currency'   => $currency,
1554                                     'optionname' => $optionname,
1555                                   }
1556             )#;
1557   #fatal if not found?  that works for our use cases from
1558   #part_pkg/currency_fixed, but isn't how we would typically/expect the method
1559   #to behave.  have to catch it there if we change it here...
1560     or die "Unknown price for ". $self->pkg_comment. " in $currency\n";
1561
1562   $part_pkg_currency->optionvalue;
1563 }
1564
1565 =item fcc_option OPTIONNAME
1566
1567 Returns the FCC 477 report option value for the given name, or the empty
1568 string.
1569
1570 =cut
1571
1572 sub fcc_option {
1573   my ($self, $name) = @_;
1574   my $part_pkg_fcc_option =
1575     qsearchs('part_pkg_fcc_option', {
1576         pkgpart => $self->pkgpart,
1577         fccoptionname => $name,
1578     });
1579   $part_pkg_fcc_option ? $part_pkg_fcc_option->optionvalue : '';
1580 }
1581
1582 =item fcc_options
1583
1584 Returns all FCC 477 report options for this package, as a hash-like list.
1585
1586 =cut
1587
1588 sub fcc_options {
1589   my $self = shift;
1590   map { $_->fccoptionname => $_->optionvalue }
1591     qsearch('part_pkg_fcc_option', { pkgpart => $self->pkgpart });
1592 }
1593
1594 =item bill_part_pkg_link
1595
1596 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1597
1598 =cut
1599
1600 sub bill_part_pkg_link {
1601   shift->_part_pkg_link('bill', @_);
1602 }
1603
1604 =item svc_part_pkg_link
1605
1606 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1607
1608 =cut
1609
1610 sub svc_part_pkg_link {
1611   shift->_part_pkg_link('svc', @_);
1612 }
1613
1614 =item supp_part_pkg_link
1615
1616 Returns the associated part_pkg_link records of type 'supp' (supplemental
1617 packages).
1618
1619 =cut
1620
1621 sub supp_part_pkg_link {
1622   shift->_part_pkg_link('supp', @_);
1623 }
1624
1625 sub _part_pkg_link {
1626   my( $self, $type ) = @_;
1627
1628   return @{ $cache_link{$type}->{$self->pkgpart} }
1629     if $cache_enabled && $cache_link{$type}->{$self->pkgpart};
1630
1631   cluck $type.'_part_pkg_link called' if $DEBUG;
1632
1633   my @ppl =
1634     qsearch({ table    => 'part_pkg_link',
1635               hashref  => { src_pkgpart => $self->pkgpart,
1636                             link_type   => $type,
1637                             #protection against infinite recursive links
1638                             dst_pkgpart => { op=>'!=', value=> $self->pkgpart },
1639                           },
1640               order_by => "ORDER BY hidden",
1641            });
1642
1643   $cache_link{$type}->{$self->pkgpart} = \@ppl if $cache_enabled;
1644
1645   return @ppl;
1646 }
1647
1648 sub self_and_bill_linked {
1649   shift->_self_and_linked('bill', @_);
1650 }
1651
1652 sub self_and_svc_linked {
1653   shift->_self_and_linked('svc', @_);
1654 }
1655
1656 sub _self_and_linked {
1657   my( $self, $type, $hidden ) = @_;
1658   $hidden ||= '';
1659
1660   my @result = ();
1661   foreach ( ( $self, map { $_->dst_pkg->_self_and_linked($type, $_->hidden) }
1662                      $self->_part_pkg_link($type) ) )
1663   {
1664     $_->hidden($hidden) if $hidden;
1665     push @result, $_;
1666   }
1667
1668   (@result);
1669 }
1670
1671 =item part_pkg_taxoverride [ CLASS ]
1672
1673 Returns all associated FS::part_pkg_taxoverride objects (see
1674 L<FS::part_pkg_taxoverride>).  Limits the returned set to those
1675 of class CLASS if defined.  Class may be one of 'setup', 'recur',
1676 the empty string (default), or a usage class number (see L<FS::usage_class>).
1677 When a class is specified, the empty string class (default) is returned
1678 if no more specific values exist.
1679
1680 =cut
1681
1682 sub part_pkg_taxoverride {
1683   my $self = shift;
1684   my $class = shift;
1685
1686   my $hashref = { 'pkgpart' => $self->pkgpart };
1687   $hashref->{'usage_class'} = $class if defined($class);
1688   my @overrides = qsearch('part_pkg_taxoverride', $hashref );
1689
1690   unless ( scalar(@overrides) || !defined($class) || !$class ){
1691     $hashref->{'usage_class'} = '';
1692     @overrides = qsearch('part_pkg_taxoverride', $hashref );
1693   }
1694
1695   @overrides;
1696 }
1697
1698 =item has_taxproduct
1699
1700 Returns true if this package has any taxproduct associated with it.
1701
1702 =cut
1703
1704 sub has_taxproduct {
1705   my $self = shift;
1706
1707   $self->taxproductnum ||
1708   scalar( grep { $_ =~/^usage_taxproductnum_/ && $self->option($_) }
1709           keys %{ {$self->options} }
1710   )
1711
1712 }
1713
1714
1715 =item taxproduct [ CLASS ]
1716
1717 Returns the associated tax product for this package definition (see
1718 L<FS::part_pkg_taxproduct>).  CLASS may be one of 'setup', 'recur' or
1719 the usage classnum (see L<FS::usage_class>).  Returns the default
1720 tax product for this record if the more specific CLASS value does
1721 not exist.
1722
1723 =cut
1724
1725 sub taxproduct {
1726   my $self = shift;
1727   my $class = shift;
1728
1729   my $part_pkg_taxproduct;
1730
1731   my $taxproductnum = $self->taxproductnum;
1732   if ($class) {
1733     my $class_taxproductnum = $self->option("usage_taxproductnum_$class", 1);
1734     $taxproductnum = $class_taxproductnum
1735       if $class_taxproductnum
1736   }
1737
1738   $part_pkg_taxproduct =
1739     qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1740
1741   unless ($part_pkg_taxproduct || $taxproductnum eq $self->taxproductnum ) {
1742     $taxproductnum = $self->taxproductnum;
1743     $part_pkg_taxproduct =
1744       qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1745   }
1746
1747   $part_pkg_taxproduct;
1748 }
1749
1750 =item taxproduct_description [ CLASS ]
1751
1752 Returns the description of the associated tax product for this package
1753 definition (see L<FS::part_pkg_taxproduct>).
1754
1755 =cut
1756
1757 sub taxproduct_description {
1758   my $self = shift;
1759   my $part_pkg_taxproduct = $self->taxproduct(@_);
1760   $part_pkg_taxproduct ? $part_pkg_taxproduct->description : '';
1761 }
1762
1763 =item units_taxproduct
1764
1765 Returns the L<FS::part_pkg_taxproduct> record used to report the taxable
1766 service units (usually phone lines) on this package.
1767
1768 =cut
1769
1770 sub units_taxproduct {
1771   my $self = shift;
1772   $self->units_taxproductnum
1773     ? FS::part_pkg_taxproduct->by_key($self->units_taxproductnum)
1774     : '';
1775 }
1776
1777 =item tax_rates DATA_PROVIDER, GEOCODE, [ CLASS ]
1778
1779 Returns the tax table entries (L<FS::tax_rate> objects) that apply to this
1780 package in the location specified by GEOCODE, for usage class CLASS (one of
1781 'setup', 'recur', null, or a C<usage_class> number).
1782
1783 =cut
1784
1785 sub tax_rates {
1786   my $self = shift;
1787   my ($vendor, $geocode, $class) = @_;
1788   # if this part_pkg is overridden into a specific taxclass, get that class
1789   my @taxclassnums = map { $_->taxclassnum }
1790                      $self->part_pkg_taxoverride($class);
1791   # otherwise, get its tax product category
1792   if (!@taxclassnums) {
1793     my $part_pkg_taxproduct = $self->taxproduct($class);
1794     # If this isn't defined, then the class has no taxproduct designation,
1795     # so return no tax rates.
1796     return () if !$part_pkg_taxproduct;
1797
1798     # convert the taxproduct to the tax classes that might apply to it in
1799     # $geocode
1800     @taxclassnums = map { $_->taxclassnum }
1801                     grep { $_->taxable eq 'Y' } # why do we need this?
1802                     $part_pkg_taxproduct->part_pkg_taxrate($geocode);
1803   }
1804   return unless @taxclassnums;
1805
1806   # then look up the actual tax_rate entries
1807   warn "Found taxclassnum values of ". join(',', @taxclassnums) ."\n"
1808       if $DEBUG;
1809   my $extra_sql = "AND taxclassnum IN (". join(',', @taxclassnums) . ")";
1810   my @taxes = qsearch({ 'table'     => 'tax_rate',
1811                         'hashref'   => { 'geocode'     => $geocode,
1812                                          'data_vendor' => $vendor,
1813                                          'disabled'    => '' },
1814                         'extra_sql' => $extra_sql,
1815                       });
1816   warn "Found taxes ". join(',', map {$_->taxnum} @taxes) ."\n"
1817       if $DEBUG;
1818
1819   return @taxes;
1820 }
1821
1822 =item part_pkg_discount
1823
1824 Returns the package to discount m2m records (see L<FS::part_pkg_discount>)
1825 for this package.
1826
1827 =item part_pkg_usage
1828
1829 Returns the voice usage pools (see L<FS::part_pkg_usage>) defined for
1830 this package.
1831
1832 =item change_to_pkg
1833
1834 Returns the automatic transfer target for this package, or an empty string
1835 if there isn't one.
1836
1837 =cut
1838
1839 sub change_to_pkg {
1840   my $self = shift;
1841   my $pkgpart = $self->change_to_pkgpart or return '';
1842   FS::part_pkg->by_key($pkgpart);
1843 }
1844
1845 =item _rebless
1846
1847 Reblesses the object into the FS::part_pkg::PLAN class (if available), where
1848 PLAN is the object's I<plan> field.  There should be better docs
1849 on how to create new price plans, but until then, see L</NEW PLAN CLASSES>.
1850
1851 =cut
1852
1853 sub _rebless {
1854   my $self = shift;
1855   my $plan = $self->plan;
1856   unless ( $plan ) {
1857     cluck "no price plan found for pkgpart ". $self->pkgpart. "\n"
1858       if $DEBUG;
1859     return $self;
1860   }
1861   return $self if ref($self) =~ /::$plan$/; #already blessed into plan subclass
1862   my $class = ref($self). "::$plan";
1863   warn "reblessing $self into $class" if $DEBUG > 1;
1864   eval "use $class;";
1865   die $@ if $@;
1866   bless($self, $class) unless $@;
1867   $self;
1868 }
1869
1870 =item calc_setup CUST_PKG START_DATE DETAILS_ARRAYREF OPTIONS_HASHREF
1871
1872 =item calc_recur CUST_PKG START_DATE DETAILS_ARRAYREF OPTIONS_HASHREF
1873
1874 Calculates and returns the setup or recurring fees, respectively, for this
1875 package.  Implementation is in the FS::part_pkg:* module specific to this price
1876 plan.
1877
1878 Adds invoicing details to the passed-in DETAILS_ARRAYREF
1879
1880 Options are passed as a hashref.  Available options:
1881
1882 =over 4
1883
1884 =item freq_override
1885
1886 Frequency override (for calc_recur)
1887
1888 =item discounts
1889
1890 This option is filled in by the method rather than controlling its operation.
1891 It is an arrayref.  Applicable discounts will be added to the arrayref, as
1892 L<FS::cust_bill_pkg_discount|FS::cust_bill_pkg_discount records>.
1893
1894 =item real_pkgpart
1895
1896 For package add-ons, is the base L<FS::part_pkg|package definition>, otherwise
1897 no different than pkgpart.
1898
1899 =item precommit_hooks
1900
1901 This option is filled in by the method rather than controlling its operation.
1902 It is an arrayref.  Anonymous coderefs will be added to the arrayref.  They
1903 need to be called before completing the billing operation.  For calc_recur
1904 only.
1905
1906 =item increment_next_bill
1907
1908 Increment the next bill date (boolean, for calc_recur).  Typically true except
1909 for particular situations.
1910
1911 =item setup_fee
1912
1913 This option is filled in by the method rather than controlling its operation.
1914 It indicates a deferred setup fee that is billed at calc_recur time (see price
1915 plan option prorate_defer_bill).
1916
1917 =back
1918
1919 Note: Don't calculate prices when not actually billing the package.  For that,
1920 see the L</base_setup|base_setup> and L</base_recur|base_recur> methods.
1921
1922 =cut
1923
1924 #fatal fallbacks
1925 sub calc_setup { die 'no calc_setup for '. shift->plan. "\n"; }
1926 sub calc_recur { die 'no calc_recur for '. shift->plan. "\n"; }
1927
1928 =item calc_remain CUST_PKG [ OPTION => VALUE ... ]
1929
1930 Calculates and returns the remaining value to be credited upon package
1931 suspension, change, or cancellation, if enabled.
1932
1933 Options are passed as a list of keys and values.  Available options:
1934
1935 =over 4
1936
1937 =item time
1938
1939 Override for the current time
1940
1941 =item cust_credit_source_bill_pkg
1942
1943 This option is filled in by the method rather than controlling its operation.
1944 It is an arrayref.
1945 L<FS::cust_credit_source_bill_pkg|FS::cust_credit_source_bill_pkg> records will
1946 be added to the arrayref indicating the specific line items and amounts which
1947 are the source of this remaining credit.
1948
1949 =back
1950
1951 Note: Don't calculate prices when not actually suspending or cancelling the
1952 package.
1953
1954 =cut
1955
1956 #fallback that returns 0 for old legacy packages with no plan
1957 sub calc_remain { 0; }
1958
1959 =item calc_units CUST_PKG
1960
1961 This returns the number of provisioned svc_phone records, or, of the package
1962 count_available_phones option is set, the number available to be provisioned
1963 in the package.
1964
1965 =cut
1966
1967 sub calc_units {
1968   my($self, $cust_pkg ) = @_;
1969   my $count = 0;
1970   if ( $self->option('count_available_phones', 1)) {
1971     foreach my $pkg_svc ($cust_pkg->part_pkg->pkg_svc) {
1972       if ($pkg_svc->part_svc->svcdb eq 'svc_phone') { # svc_pbx?
1973         $count += $pkg_svc->quantity || 0;
1974       }
1975     }
1976     $count *= $cust_pkg->quantity;
1977   } else {
1978     $count =
1979       scalar(grep { $_->part_svc->svcdb eq 'svc_phone' } $cust_pkg->cust_svc);
1980   }
1981   $count;
1982 }
1983
1984 #fallback for everything not based on flat.pm
1985 sub recur_temporality { 'upcoming'; }
1986
1987 =item calc_cancel START_DATE DETAILS_ARRAYREF OPTIONS_HASHREF
1988
1989 Runs any necessary billing on cancellation: another recurring cycle for
1990 recur_temporailty 'preceding' pacakges with the bill_recur_on_cancel option
1991 set (calc_recur), or, any outstanding usage for pacakges with the
1992 bill_usage_on_cancel option set (calc_usage).
1993
1994 =cut
1995
1996 #fallback for everything not based on flat.pm, doesn't do this yet (which is
1997 #okay, nothing of ours not based on flat.pm does usage-on-cancel billing
1998 sub calc_cancel { 0; }
1999
2000 #fallback for everything except bulk.pm
2001 sub hide_svc_detail { 0; }
2002
2003 #fallback for packages that can't/won't summarize usage
2004 sub sum_usage { 0; }
2005
2006 =item recur_cost_permonth CUST_PKG
2007
2008 recur_cost divided by freq (only supported for monthly and longer frequencies)
2009
2010 =cut
2011
2012 sub recur_cost_permonth {
2013   my($self, $cust_pkg) = @_;
2014   return 0 unless $self->freq =~ /^\d+$/ && $self->freq > 0;
2015   sprintf('%.2f', ($self->recur_cost || 0) / $self->freq );
2016 }
2017
2018 =item cust_bill_pkg_recur CUST_PKG
2019
2020 Actual recurring charge for the specified customer package from customer's most
2021 recent invoice
2022
2023 =cut
2024
2025 sub cust_bill_pkg_recur {
2026   my($self, $cust_pkg) = @_;
2027   my $cust_bill_pkg = qsearchs({
2028     'table'     => 'cust_bill_pkg',
2029     'addl_from' => 'LEFT JOIN cust_bill USING ( invnum )',
2030     'hashref'   => { 'pkgnum' => $cust_pkg->pkgnum,
2031                      'recur'  => { op=>'>', value=>'0' },
2032                    },
2033     'order_by'  => 'ORDER BY cust_bill._date     DESC,
2034                              cust_bill_pkg.sdate DESC
2035                      LIMIT 1
2036                    ',
2037   }) or return 0; #die "use cust_bill_pkg_recur credits with once_perinv condition";
2038   $cust_bill_pkg->recur;
2039 }
2040
2041 =item unit_setup CUST_PKG
2042
2043 Returns the setup fee for one unit of the package.
2044
2045 =cut
2046
2047 sub unit_setup {
2048   my ($self, $cust_pkg) = @_;
2049   $self->option('setup_fee') || 0;
2050 }
2051
2052 =item setup_margin
2053
2054 unit_setup minus setup_cost
2055
2056 =cut
2057
2058 sub setup_margin {
2059   my $self = shift;
2060   $self->unit_setup(@_) - ($self->setup_cost || 0);
2061 }
2062
2063 =item recur_margin_permonth
2064
2065 base_recur_permonth minus recur_cost_permonth
2066
2067 =cut
2068
2069 sub recur_margin_permonth {
2070   my $self = shift;
2071   $self->base_recur_permonth(@_) - $self->recur_cost_permonth(@_);
2072 }
2073
2074 =item intro_end PACKAGE
2075
2076 Takes an L<FS::cust_pkg> object.  If this plan has an introductory rate,
2077 returns the expected date the intro period will end. If there is no intro
2078 rate, returns zero.
2079
2080 =cut
2081
2082 sub intro_end {
2083   0;
2084 }
2085
2086 =item format OPTION DATA
2087
2088 Returns data formatted according to the function 'format' described
2089 in the plan info.  Returns DATA if no such function exists.
2090
2091 =cut
2092
2093 sub format {
2094   my ($self, $option, $data) = (shift, shift, shift);
2095   if (exists($plans{$self->plan}->{fields}->{$option}{format})) {
2096     &{$plans{$self->plan}->{fields}->{$option}{format}}($data);
2097   }else{
2098     $data;
2099   }
2100 }
2101
2102 =item parse OPTION DATA
2103
2104 Returns data parsed according to the function 'parse' described
2105 in the plan info.  Returns DATA if no such function exists.
2106
2107 =cut
2108
2109 sub parse {
2110   my ($self, $option, $data) = (shift, shift, shift);
2111   if (exists($plans{$self->plan}->{fields}->{$option}{parse})) {
2112     &{$plans{$self->plan}->{fields}->{$option}{parse}}($data);
2113   }else{
2114     $data;
2115   }
2116 }
2117
2118 =back
2119
2120 =cut
2121
2122 =head1 CLASS METHODS
2123
2124 =over 4
2125
2126 =cut
2127
2128 # _upgrade_data
2129 #
2130 # Used by FS::Upgrade to migrate to a new database.
2131
2132 sub _upgrade_data { # class method
2133    my($class, %opts) = @_;
2134
2135   warn "[FS::part_pkg] upgrading $class\n" if $DEBUG;
2136
2137   my @part_pkg = qsearch({
2138     'table'     => 'part_pkg',
2139     'extra_sql' => "WHERE ". join(' OR ',
2140                      'plan IS NULL', "plan = '' ",
2141                    ),
2142   });
2143
2144   foreach my $part_pkg (@part_pkg) {
2145
2146     unless ( $part_pkg->plan ) {
2147       $part_pkg->plan('flat');
2148     }
2149
2150     $part_pkg->replace;
2151
2152   }
2153
2154   # Convert RADIUS accounting usage metrics from megabytes to gigabytes
2155   # (FS RT#28105)
2156   my $upgrade = 'part_pkg_gigabyte_usage';
2157   if (!FS::upgrade_journal->is_done($upgrade)) {
2158     foreach my $part_pkg (qsearch('part_pkg',
2159                                   { plan => 'sqlradacct_hour' })
2160                          ){
2161
2162       my $pkgpart = $part_pkg->pkgpart;
2163
2164       foreach my $opt (qsearch('part_pkg_option',
2165                                { 'optionname'  => { op => 'LIKE',
2166                                                     value => 'recur_included_%',
2167                                                   },
2168                                  pkgpart => $pkgpart,
2169                                })){
2170
2171         next if $opt->optionname eq 'recur_included_hours'; # unfortunately named field
2172         next if $opt->optionvalue == 0;
2173
2174         $opt->optionvalue($opt->optionvalue / 1024);
2175
2176         my $error = $opt->replace;
2177         die $error if $error;
2178       }
2179
2180       foreach my $opt (qsearch('part_pkg_option',
2181                                { 'optionname'  => { op => 'LIKE',
2182                                                     value => 'recur_%_charge',
2183                                                   },
2184                                  pkgpart => $pkgpart,
2185                                })){
2186         $opt->optionvalue($opt->optionvalue * 1024);
2187
2188         my $error = $opt->replace;
2189         die $error if $error;
2190       }
2191
2192     }
2193     FS::upgrade_journal->set_done($upgrade);
2194   }
2195
2196   # the rest can be done asynchronously
2197 }
2198
2199 sub queueable_upgrade {
2200   # now upgrade to the explicit custom flag
2201
2202   my $search = FS::Cursor->new({
2203     'table'     => 'part_pkg',
2204     'hashref'   => { disabled => 'Y', custom => '' },
2205     'extra_sql' => "AND comment LIKE '(CUSTOM) %'",
2206   });
2207   my $dbh = dbh;
2208
2209   while (my $part_pkg = $search->fetch) {
2210     my $new = new FS::part_pkg { $part_pkg->hash };
2211     $new->custom('Y');
2212     my $comment = $part_pkg->comment;
2213     $comment =~ s/^\(CUSTOM\) //;
2214     $comment = '(none)' unless $comment =~ /\S/;
2215     $new->comment($comment);
2216
2217     my $pkg_svc = { map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc };
2218     my $primary = $part_pkg->svcpart;
2219     my $options = { $part_pkg->options };
2220
2221     my $error = $new->replace( $part_pkg,
2222                                'pkg_svc'     => $pkg_svc,
2223                                'primary_svc' => $primary,
2224                                'options'     => $options,
2225                              );
2226     if ($error) {
2227       warn "pkgpart#".$part_pkg->pkgpart.": $error\n";
2228       $dbh->rollback;
2229     } else {
2230       $dbh->commit;
2231     }
2232   }
2233
2234   # set family_pkgpart on any packages that don't have it
2235   $search = FS::Cursor->new('part_pkg', { 'family_pkgpart' => '' });
2236   while (my $part_pkg = $search->fetch) {
2237     $part_pkg->set('family_pkgpart' => $part_pkg->pkgpart);
2238     my $error = $part_pkg->SUPER::replace;
2239     if ($error) {
2240       warn "pkgpart#".$part_pkg->pkgpart.": $error\n";
2241       $dbh->rollback;
2242     } else {
2243       $dbh->commit;
2244     }
2245   }
2246
2247   my @part_pkg_option = qsearch('part_pkg_option',
2248     { 'optionname'  => 'unused_credit',
2249       'optionvalue' => 1,
2250     });
2251   foreach my $old_opt (@part_pkg_option) {
2252     my $pkgpart = $old_opt->pkgpart;
2253     my $error = $old_opt->delete;
2254     die $error if $error;
2255
2256     foreach (qw(unused_credit_cancel unused_credit_change)) {
2257       my $new_opt = new FS::part_pkg_option {
2258         'pkgpart'     => $pkgpart,
2259         'optionname'  => $_,
2260         'optionvalue' => 1,
2261       };
2262       $error = $new_opt->insert;
2263       die $error if $error;
2264     }
2265   }
2266
2267   # migrate use_disposition_taqua and use_disposition to disposition_in
2268   @part_pkg_option = qsearch('part_pkg_option',
2269     { 'optionname'  => { op => 'LIKE',
2270                          value => 'use_disposition%',
2271                        },
2272       'optionvalue' => 1,
2273     });
2274   my %newopts = map { $_->pkgpart => $_ }
2275     qsearch('part_pkg_option',  { 'optionname'  => 'disposition_in', } );
2276   foreach my $old_opt (@part_pkg_option) {
2277         my $pkgpart = $old_opt->pkgpart;
2278         my $newval = $old_opt->optionname eq 'use_disposition_taqua' ? '100'
2279                                                                   : 'ANSWERED';
2280         my $error = $old_opt->delete;
2281         die $error if $error;
2282
2283         if ( exists($newopts{$pkgpart}) ) {
2284             my $opt = $newopts{$pkgpart};
2285             $opt->optionvalue($opt->optionvalue.",$newval");
2286             $error = $opt->replace;
2287             die $error if $error;
2288         } else {
2289             my $new_opt = new FS::part_pkg_option {
2290                 'pkgpart'     => $pkgpart,
2291                 'optionname'  => 'disposition_in',
2292                 'optionvalue' => $newval,
2293               };
2294               $error = $new_opt->insert;
2295               die $error if $error;
2296               $newopts{$pkgpart} = $new_opt;
2297         }
2298   }
2299
2300   # set any package with FCC voice lines to the "VoIP with broadband" category
2301   # for backward compatibility
2302   #
2303   # recover from a bad upgrade bug
2304   my $upgrade = 'part_pkg_fcc_voip_class_FIX';
2305   if (!FS::upgrade_journal->is_done($upgrade)) {
2306     my $bad_upgrade = qsearchs('upgrade_journal',
2307       { upgrade => 'part_pkg_fcc_voip_class' }
2308     );
2309     if ( $bad_upgrade ) {
2310       my $where = 'WHERE history_date <= '.$bad_upgrade->_date.
2311                   ' AND  history_date >  '.($bad_upgrade->_date - 3600);
2312       my @h_part_pkg_option = map { FS::part_pkg_option->new($_->hashref) }
2313         qsearch({
2314           'select'    => '*',
2315           'table'     => 'h_part_pkg_option',
2316           'hashref'   => {},
2317           'extra_sql' => "$where AND history_action = 'delete'",
2318           'order_by'  => 'ORDER BY history_date ASC',
2319         });
2320       my @h_pkg_svc = map { FS::pkg_svc->new($_->hashref) }
2321         qsearch({
2322           'select'    => '*',
2323           'table'     => 'h_pkg_svc',
2324           'hashref'   => {},
2325           'extra_sql' => "$where AND history_action = 'replace_old'",
2326           'order_by'  => 'ORDER BY history_date ASC',
2327         });
2328       my %opt;
2329       foreach my $deleted (@h_part_pkg_option, @h_pkg_svc) {
2330         my $pkgpart ||= $deleted->pkgpart;
2331         $opt{$pkgpart} ||= {
2332           options => {},
2333           pkg_svc => {},
2334           primary_svc => '',
2335           hidden_svc => {},
2336         };
2337         if ( $deleted->isa('FS::part_pkg_option') ) {
2338           $opt{$pkgpart}{options}{ $deleted->optionname } = $deleted->optionvalue;
2339         } else { # pkg_svc
2340           my $svcpart = $deleted->svcpart;
2341           $opt{$pkgpart}{pkg_svc}{$svcpart} = $deleted->quantity;
2342           $opt{$pkgpart}{hidden_svc}{$svcpart} ||= $deleted->hidden;
2343           $opt{$pkgpart}{primary_svc} = $svcpart if $deleted->primary_svc;
2344         }
2345       }
2346       foreach my $pkgpart (keys %opt) {
2347         my $part_pkg = FS::part_pkg->by_key($pkgpart);
2348         my $error = $part_pkg->replace( $part_pkg->replace_old, $opt{$pkgpart} );
2349         if ( $error ) {
2350           die "error recovering damaged pkgpart $pkgpart:\n$error\n";
2351         }
2352       }
2353     } # $bad_upgrade exists
2354     else { # do the original upgrade, but correctly this time
2355       my @part_pkg = qsearch('part_pkg', {
2356           fcc_ds0s        => { op => '>', value => 0 },
2357           fcc_voip_class  => ''
2358       });
2359       foreach my $part_pkg (@part_pkg) {
2360         $part_pkg->set(fcc_voip_class => 2);
2361         my @pkg_svc = $part_pkg->pkg_svc;
2362         my %quantity = map {$_->svcpart, $_->quantity} @pkg_svc;
2363         my %hidden   = map {$_->svcpart, $_->hidden  } @pkg_svc;
2364         my $error = $part_pkg->replace(
2365           $part_pkg->replace_old,
2366           options     => { $part_pkg->options },
2367           pkg_svc     => \%quantity,
2368           hidden_svc  => \%hidden,
2369           primary_svc => ($part_pkg->svcpart || ''),
2370         );
2371         die $error if $error;
2372       }
2373     }
2374     FS::upgrade_journal->set_done($upgrade);
2375   }
2376
2377   # migrate adjourn_months, expire_months, and contract_end_months to
2378   # real fields
2379   foreach my $field (qw(adjourn_months expire_months contract_end_months)) {
2380     foreach my $option (qsearch('part_pkg_option', { optionname => $field })) {
2381       my $part_pkg = $option->part_pkg;
2382       my $error = $option->delete;
2383       if ( $option->optionvalue and $part_pkg->get($field) eq '' ) {
2384         $part_pkg->set($field, $option->optionvalue);
2385         $error ||= $part_pkg->replace;
2386       }
2387       die $error if $error;
2388     }
2389   }
2390
2391   # remove custom flag from one-time charge packages that were accidentally
2392   # flagged as custom
2393   $search = FS::Cursor->new({
2394     'table'   => 'part_pkg',
2395     'hashref' => { 'freq'   => '0',
2396                    'custom' => 'Y',
2397                    'family_pkgpart' => { op => '!=', value => '' },
2398                  },
2399     'addl_from' => ' JOIN
2400   (select pkgpart from cust_pkg group by pkgpart having count(*) = 1)
2401     AS singular_pkg USING (pkgpart)',
2402   });
2403   my @fields = grep {     $_ ne 'pkgpart'
2404                       and $_ ne 'custom'
2405                       and $_ ne 'disabled' } FS::part_pkg->fields;
2406   PKGPART: while (my $part_pkg = $search->fetch) {
2407     # can't merge the package back into its parent (too late for that)
2408     # but we can remove the custom flag if it's not actually customized,
2409     # i.e. nothing has been changed.
2410
2411     my $family_pkgpart = $part_pkg->family_pkgpart;
2412     next PKGPART if $family_pkgpart == $part_pkg->pkgpart;
2413     my $parent_pkg = FS::part_pkg->by_key($family_pkgpart);
2414     foreach my $field (@fields) {
2415       if ($part_pkg->get($field) ne $parent_pkg->get($field)) {
2416         next PKGPART;
2417       }
2418     }
2419     # options have to be identical too
2420     # but links, FCC options, discount plans, and usage packages can't be
2421     # changed through the "modify charge" UI, so skip them
2422     my %newopt = $part_pkg->options;
2423     my %oldopt = $parent_pkg->options;
2424     OPTION: foreach my $option (keys %newopt) {
2425       if (delete $newopt{$option} ne delete $oldopt{$option}) {
2426         next PKGPART;
2427       }
2428     }
2429     if (keys(%newopt) or keys(%oldopt)) {
2430       next PKGPART;
2431     }
2432     # okay, now replace it
2433     warn "Removing custom flag from part_pkg#".$part_pkg->pkgpart."\n";
2434     $part_pkg->set('custom', '');
2435     my $error = $part_pkg->replace;
2436     die $error if $error;
2437   } # $search->fetch
2438
2439   return;
2440 }
2441
2442 =item curuser_pkgs_sql
2443
2444 Returns an SQL fragment for searching for packages the current user can
2445 use, either via part_pkg.agentnum directly, or via agent type (see
2446 L<FS::type_pkgs>).
2447
2448 =cut
2449
2450 sub curuser_pkgs_sql {
2451   my $class = shift;
2452
2453   $class->_pkgs_sql( $FS::CurrentUser::CurrentUser->agentnums );
2454
2455 }
2456
2457 =item agent_pkgs_sql AGENT | AGENTNUM, ...
2458
2459 Returns an SQL fragment for searching for packages the provided agent or agents
2460 can use, either via part_pkg.agentnum directly, or via agent type (see
2461 L<FS::type_pkgs>).
2462
2463 =cut
2464
2465 sub agent_pkgs_sql {
2466   my $class = shift;  #i'm a class method, not a sub (the question is... why??)
2467   my @agentnums = map { ref($_) ? $_->agentnum : $_ } @_;
2468
2469   $class->_pkgs_sql(@agentnums); #is this why
2470
2471 }
2472
2473 sub _pkgs_sql {
2474   my( $class, @agentnums ) = @_;
2475   my $agentnums = join(',', @agentnums);
2476
2477   "
2478     (
2479       ( agentnum IS NOT NULL AND agentnum IN ($agentnums) )
2480       OR ( agentnum IS NULL
2481            AND EXISTS ( SELECT 1
2482                           FROM type_pkgs
2483                             LEFT JOIN agent_type USING ( typenum )
2484                             LEFT JOIN agent AS typeagent USING ( typenum )
2485                           WHERE type_pkgs.pkgpart = part_pkg.pkgpart
2486                             AND typeagent.agentnum IN ($agentnums)
2487                       )
2488          )
2489     )
2490   ";
2491
2492 }
2493
2494 =item join_options_sql
2495
2496 Returns an SQL fragment for JOINing the part_pkg_option records for this
2497 package's setup_fee and recur_fee (as setup_option and recur_option,
2498 respectively).  Useful for optimization.
2499
2500 =cut
2501
2502 sub join_options_sql {
2503   #my $class = shift;
2504   "
2505     LEFT JOIN part_pkg_option AS setup_option
2506       ON (     part_pkg.pkgpart = setup_option.pkgpart
2507            AND setup_option.optionname = 'setup_fee' )
2508     LEFT JOIN part_pkg_option AS recur_option
2509       ON (     part_pkg.pkgpart = recur_option.pkgpart
2510            AND recur_option.optionname = 'recur_fee' )
2511   ";
2512 }
2513
2514 =back
2515
2516 =head1 SUBROUTINES
2517
2518 =over 4
2519
2520 =item plan_info
2521
2522 =cut
2523
2524 #false laziness w/part_export & cdr
2525 my %info;
2526 foreach my $INC ( @INC ) {
2527   warn "globbing $INC/FS/part_pkg/[a-z]*.pm\n" if $DEBUG;
2528   foreach my $file ( glob("$INC/FS/part_pkg/[a-z]*.pm") ) {
2529     warn "attempting to load plan info from $file\n" if $DEBUG;
2530     $file =~ /\/(\w+)\.pm$/ or do {
2531       warn "unrecognized file in $INC/FS/part_pkg/: $file\n";
2532       next;
2533     };
2534     my $mod = $1;
2535     my $info = eval "use FS::part_pkg::$mod; ".
2536                     "\\%FS::part_pkg::$mod\::info;";
2537     if ( $@ ) {
2538       die "error using FS::part_pkg::$mod (skipping): $@\n" if $@;
2539       next;
2540     }
2541     unless ( keys %$info ) {
2542       warn "no %info hash found in FS::part_pkg::$mod, skipping\n";
2543       next;
2544     }
2545     warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG;
2546     #if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
2547     #  warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG;
2548     #  next;
2549     #}
2550     $info{$mod} = $info;
2551     $info->{'weight'} ||= 0; # quiet warnings
2552   }
2553 }
2554
2555 # copy one level deep to allow replacement of fields and fieldorder
2556 tie %plans, 'Tie::IxHash',
2557   map  { my %infohash = %{ $info{$_} };
2558           $_ => \%infohash }
2559   sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} }
2560   keys %info;
2561
2562 # inheritance of plan options
2563 foreach my $name (keys(%info)) {
2564   if (exists($info{$name}->{'disabled'}) and $info{$name}->{'disabled'}) {
2565     warn "skipping disabled plan FS::part_pkg::$name" if $DEBUG;
2566     delete $plans{$name};
2567     next;
2568   }
2569   my $parents = $info{$name}->{'inherit_fields'} || [];
2570   my (%fields, %field_exists, @fieldorder);
2571   foreach my $parent ($name, @$parents) {
2572     if ( !exists($info{$parent}) ) {
2573       warn "$name tried to inherit from nonexistent '$parent'\n";
2574       next;
2575     }
2576     %fields = ( # avoid replacing existing fields
2577       %{ $info{$parent}->{'fields'} || {} },
2578       %fields
2579     );
2580     foreach (@{ $info{$parent}->{'fieldorder'} || [] }) {
2581       # avoid duplicates
2582       next if $field_exists{$_};
2583       $field_exists{$_} = 1;
2584       # allow inheritors to remove inherited fields from the fieldorder
2585       push @fieldorder, $_ if !exists($fields{$_}) or
2586                               !exists($fields{$_}->{'disabled'});
2587     }
2588   }
2589   $plans{$name}->{'fields'} = \%fields;
2590   $plans{$name}->{'fieldorder'} = \@fieldorder;
2591 }
2592
2593 sub plan_info {
2594   \%plans;
2595 }
2596
2597
2598 =back
2599
2600 =head1 NEW PLAN CLASSES
2601
2602 A module should be added in FS/FS/part_pkg/  Eventually, an example may be
2603 found in eg/plan_template.pm.  Until then, it is suggested that you use the
2604 other modules in FS/FS/part_pkg/ as a guide.
2605
2606 =head1 BUGS
2607
2608 The delete method is unimplemented.
2609
2610 setup and recur semantics are not yet defined (and are implemented in
2611 FS::cust_bill.  hmm.).  now they're deprecated and need to go.
2612
2613 plandata should go
2614
2615 part_pkg_taxrate is Pg specific
2616
2617 replace should be smarter about managing the related tables (options, pkg_svc)
2618
2619 =head1 SEE ALSO
2620
2621 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
2622 schema.html from the base documentation.
2623
2624 =cut
2625
2626 1;