FS/FS/part_pkg.pm

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