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