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