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 the given locale is empty or no
 723 localized string is found, returns the base pkg field.
 724
 725 =cut
 726
 727 sub pkg_locale {
 728   my( $self, $locale ) = @_;
 729   return $self->pkg unless $locale;
 730   my $part_pkg_msgcat = $self->part_pkg_msgcat($locale) or return $self->pkg;
 731   $part_pkg_msgcat->pkg;
 732 }
 733
 734 =item part_pkg_msgcat LOCALE
 735
 736 Like pkg_locale, but returns the FS::part_pkg_msgcat object itself.
 737
 738 =cut
 739
 740 sub part_pkg_msgcat {
 741   my( $self, $locale ) = @_;
 742   qsearchs( 'part_pkg_msgcat', {
 743     pkgpart => $self->pkgpart,
 744     locale  => $locale,
 745   });
 746 }
 747
 748 =item pkg_comment [ OPTION => VALUE... ]
 749
 750 Returns an (internal) string representing this package.  Currently,
 751 "pkgpart: pkg - comment", is returned.  "pkg - comment" may be returned in the
 752 future, omitting pkgpart.  The comment will have '(CUSTOM) ' prepended if
 753 custom is Y.
 754
 755 If the option nopkgpart is true then the "pkgpart: ' is omitted.
 756
 757 =cut
 758
 759 sub pkg_comment {
 760   my $self = shift;
 761   my %opt = @_;
 762
 763   #$self->pkg. ' - '. $self->comment;
 764   #$self->pkg. ' ('. $self->comment. ')';
 765   my $pre = $opt{nopkgpart} ? '' : $self->pkgpart. ': ';
 766   $pre. $self->pkg. ' - '. $self->custom_comment;
 767 }
 768
 769 sub price_info { # safety, in case a part_pkg hasn't defined price_info
 770     '';
 771 }
 772
 773 sub custom_comment {
 774   my $self = shift;
 775   ( $self->custom ? '(CUSTOM) ' : '' ). $self->comment . ' ' . $self->price_info;
 776 }
 777
 778 =item pkg_class
 779
 780 Returns the package class, as an FS::pkg_class object, or the empty string
 781 if there is no package class.
 782
 783 =cut
 784
 785 sub pkg_class {
 786   my $self = shift;
 787   if ( $self->classnum ) {
 788     qsearchs('pkg_class', { 'classnum' => $self->classnum } );
 789   } else {
 790     return '';
 791   }
 792 }
 793
 794 =item addon_pkg_class
 795
 796 Returns the add-on package class, as an FS::pkg_class object, or the empty
 797 string if there is no add-on package class.
 798
 799 =cut
 800
 801 sub addon_pkg_class {
 802   my $self = shift;
 803   if ( $self->addon_classnum ) {
 804     qsearchs('pkg_class', { 'classnum' => $self->addon_classnum } );
 805   } else {
 806     return '';
 807   }
 808 }
 809
 810 =item categoryname
 811
 812 Returns the package category name, or the empty string if there is no package
 813 category.
 814
 815 =cut
 816
 817 sub categoryname {
 818   my $self = shift;
 819   my $pkg_class = $self->pkg_class;
 820   $pkg_class
 821     ? $pkg_class->categoryname
 822     : '';
 823 }
 824
 825 =item classname
 826
 827 Returns the package class name, or the empty string if there is no package
 828 class.
 829
 830 =cut
 831
 832 sub classname {
 833   my $self = shift;
 834   my $pkg_class = $self->pkg_class;
 835   $pkg_class
 836     ? $pkg_class->classname
 837     : '';
 838 }
 839
 840 =item addon_classname
 841
 842 Returns the add-on package class name, or the empty string if there is no
 843 add-on package class.
 844
 845 =cut
 846
 847 sub addon_classname {
 848   my $self = shift;
 849   my $pkg_class = $self->addon_pkg_class;
 850   $pkg_class
 851     ? $pkg_class->classname
 852     : '';
 853 }
 854
 855 =item agent
 856
 857 Returns the associated agent for this event, if any, as an FS::agent object.
 858
 859 =cut
 860
 861 sub agent {
 862   my $self = shift;
 863   qsearchs('agent', { 'agentnum' => $self->agentnum } );
 864 }
 865
 866 =item pkg_svc [ HASHREF | OPTION => VALUE ]
 867
 868 Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
 869 definition (with non-zero quantity).
 870
 871 One option is available, I<disable_linked>.  If set true it will return the
 872 services for this package definition alone, omitting services from any add-on
 873 packages.
 874
 875 =cut
 876
 877 =item type_pkgs
 878
 879 Returns all FS::type_pkgs objects (see L<FS::type_pkgs>) for this package
 880 definition.
 881
 882 =cut
 883
 884 sub type_pkgs {
 885   my $self = shift;
 886   qsearch('type_pkgs', { 'pkgpart' => $self->pkgpart } );
 887 }
 888
 889 sub pkg_svc {
 890   my $self = shift;
 891
 892 #  #sort { $b->primary cmp $a->primary }
 893 #    grep { $_->quantity }
 894 #      qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
 895
 896   my $opt = ref($_[0]) ? $_[0] : { @_ };
 897   my %pkg_svc = map  { $_->svcpart => $_ }
 898                 grep { $_->quantity }
 899                 qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
 900
 901   unless ( $opt->{disable_linked} ) {
 902     foreach my $dst_pkg ( map $_->dst_pkg, $self->svc_part_pkg_link ) {
 903       my @pkg_svc = grep { $_->quantity }
 904                     qsearch( 'pkg_svc', { pkgpart=>$dst_pkg->pkgpart } );
 905       foreach my $pkg_svc ( @pkg_svc ) {
 906         if ( $pkg_svc{$pkg_svc->svcpart} ) {
 907           my $quantity = $pkg_svc{$pkg_svc->svcpart}->quantity;
 908           $pkg_svc{$pkg_svc->svcpart}->quantity($quantity + $pkg_svc->quantity);
 909         } else {
 910           $pkg_svc{$pkg_svc->svcpart} = $pkg_svc;
 911         }
 912       }
 913     }
 914   }
 915
 916   values(%pkg_svc);
 917
 918 }
 919
 920 =item svcpart [ SVCDB ]
 921
 922 Returns the svcpart of the primary service definition (see L<FS::part_svc>)
 923 associated with this package definition (see L<FS::pkg_svc>).  Returns
 924 false if there not a primary service definition or exactly one service
 925 definition with quantity 1, or if SVCDB is specified and does not match the
 926 svcdb of the service definition.  SVCDB can be specified as a scalar table
 927 name, such as 'svc_acct', or as an arrayref of possible table names.
 928
 929 =cut
 930
 931 sub svcpart {
 932   my $pkg_svc = shift->_primary_pkg_svc(@_);
 933   $pkg_svc ? $pkg_svc->svcpart : '';
 934 }
 935
 936 =item part_svc [ SVCDB ]
 937
 938 Like the B<svcpart> method, but returns the FS::part_svc object (see
 939 L<FS::part_svc>).
 940
 941 =cut
 942
 943 sub part_svc {
 944   my $pkg_svc = shift->_primary_pkg_svc(@_);
 945   $pkg_svc ? $pkg_svc->part_svc : '';
 946 }
 947
 948 sub _primary_pkg_svc {
 949   my $self = shift;
 950
 951   my $svcdb = scalar(@_) ? shift : [];
 952   $svcdb = ref($svcdb) ? $svcdb : [ $svcdb ];
 953   my %svcdb = map { $_=>1 } @$svcdb;
 954
 955   my @svcdb_pkg_svc =
 956     grep { !scalar(@$svcdb) || $svcdb{ $_->part_svc->svcdb } }
 957          $self->pkg_svc;
 958
 959   my @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc;
 960   @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc
 961     unless @pkg_svc;
 962   return '' if scalar(@pkg_svc) != 1;
 963   $pkg_svc[0];
 964 }
 965
 966 =item svcpart_unique_svcdb SVCDB
 967
 968 Returns the svcpart of a service definition (see L<FS::part_svc>) matching
 969 SVCDB associated with this package definition (see L<FS::pkg_svc>).  Returns
 970 false if there not a primary service definition for SVCDB or there are multiple
 971 service definitions for SVCDB.
 972
 973 =cut
 974
 975 sub svcpart_unique_svcdb {
 976   my( $self, $svcdb ) = @_;
 977   my @svcdb_pkg_svc = grep { ( $svcdb eq $_->part_svc->svcdb ) } $self->pkg_svc;
 978   return '' if scalar(@svcdb_pkg_svc) != 1;
 979   $svcdb_pkg_svc[0]->svcpart;
 980 }
 981
 982 =item payby
 983
 984 Returns a list of the acceptable payment types for this package.  Eventually
 985 this should come out of a database table and be editable, but currently has the
 986 following logic instead:
 987
 988 If the package is free, the single item B<BILL> is
 989 returned, otherwise, the single item B<CARD> is returned.
 990
 991 (CHEK?  LEC?  Probably shouldn't accept those by default, prone to abuse)
 992
 993 =cut
 994
 995 sub payby {
 996   my $self = shift;
 997   if ( $self->is_free ) {
 998     ( 'BILL' );
 999   } else {
1000     ( 'CARD' );
1001   }
1002 }
1003
1004 =item is_free
1005
1006 Returns true if this package is free.
1007
1008 =cut
1009
1010 sub is_free {
1011   my $self = shift;
1012   if ( $self->can('is_free_options') ) {
1013     not grep { $_ !~ /^\s*0*(\.0*)?\s*$/ }
1014          map { $self->option($_) }
1015              $self->is_free_options;
1016   } else {
1017     warn "FS::part_pkg::is_free: FS::part_pkg::". $self->plan. " subclass ".
1018          "provides neither is_free_options nor is_free method; returning false";
1019     0;
1020   }
1021 }
1022
1023 sub can_discount { 0; }
1024
1025 sub can_start_date { 1; }
1026
1027 sub freqs_href {
1028   # moved to FS::Misc to make this accessible to other packages
1029   # at initialization
1030   FS::Misc::pkg_freqs();
1031 }
1032
1033 =item freq_pretty
1034
1035 Returns an english representation of the I<freq> field, such as "monthly",
1036 "weekly", "semi-annually", etc.
1037
1038 =cut
1039
1040 sub freq_pretty {
1041   my $self = shift;
1042   my $freq = $self->freq;
1043
1044   #my $freqs_href = $self->freqs_href;
1045   my $freqs_href = freqs_href();
1046
1047   if ( exists($freqs_href->{$freq}) ) {
1048     $freqs_href->{$freq};
1049   } else {
1050     my $interval = 'month';
1051     if ( $freq =~ /^(\d+)([hdw])$/ ) {
1052       my %interval = ( 'h' => 'hour', 'd'=>'day', 'w'=>'week' );
1053       $interval = $interval{$2};
1054     }
1055     if ( $1 == 1 ) {
1056       "every $interval";
1057     } else {
1058       "every $freq ${interval}s";
1059     }
1060   }
1061 }
1062
1063 =item add_freq TIMESTAMP [ FREQ ]
1064
1065 Adds a billing period of some frequency to the provided timestamp and
1066 returns the resulting timestamp, or -1 if the frequency could not be
1067 parsed (shouldn't happen).  By default, the frequency of this package
1068 will be used; to override this, pass a different frequency as a second
1069 argument.
1070
1071 =cut
1072
1073 sub add_freq {
1074   my( $self, $date, $freq ) = @_;
1075   $freq = $self->freq unless $freq;
1076
1077   #change this bit to use Date::Manip? CAREFUL with timezones (see
1078   # mailing list archive)
1079   my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($date) )[0,1,2,3,4,5];
1080
1081   if ( $freq =~ /^\d+$/ ) {
1082     $mon += $freq;
1083     until ( $mon < 12 ) { $mon -= 12; $year++; }
1084
1085     $mday = 28 if $mday > 28 && FS::Conf->new->exists('anniversary-rollback');
1086
1087   } elsif ( $freq =~ /^(\d+)w$/ ) {
1088     my $weeks = $1;
1089     $mday += $weeks * 7;
1090   } elsif ( $freq =~ /^(\d+)d$/ ) {
1091     my $days = $1;
1092     $mday += $days;
1093   } elsif ( $freq =~ /^(\d+)h$/ ) {
1094     my $hours = $1;
1095     $hour += $hours;
1096   } else {
1097     return -1;
1098   }
1099
1100   timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
1101 }
1102
1103 =item plandata
1104
1105 For backwards compatibility, returns the plandata field as well as all options
1106 from FS::part_pkg_option.
1107
1108 =cut
1109
1110 sub plandata {
1111   my $self = shift;
1112   carp "plandata is deprecated";
1113   if ( @_ ) {
1114     $self->SUPER::plandata(@_);
1115   } else {
1116     my $plandata = $self->get('plandata');
1117     my %options = $self->options;
1118     $plandata .= join('', map { "$_=$options{$_}\n" } keys %options );
1119     $plandata;
1120   }
1121 }
1122
1123 =item part_pkg_vendor
1124
1125 Returns all vendor/external package ids as FS::part_pkg_vendor objects (see
1126 L<FS::part_pkg_vendor>).
1127
1128 =cut
1129
1130 sub part_pkg_vendor {
1131   my $self = shift;
1132   qsearch('part_pkg_vendor', { 'pkgpart' => $self->pkgpart } );
1133 }
1134
1135 =item vendor_pkg_ids
1136
1137 Returns a list of vendor/external package ids by exportnum
1138
1139 =cut
1140
1141 sub vendor_pkg_ids {
1142   my $self = shift;
1143   map { $_->exportnum => $_->vendor_pkg_id } $self->part_pkg_vendor;
1144 }
1145
1146 =item part_pkg_option
1147
1148 Returns all options as FS::part_pkg_option objects (see
1149 L<FS::part_pkg_option>).
1150
1151 =cut
1152
1153 sub part_pkg_option {
1154   my $self = shift;
1155   qsearch('part_pkg_option', { 'pkgpart' => $self->pkgpart } );
1156 }
1157
1158 =item options
1159
1160 Returns a list of option names and values suitable for assigning to a hash.
1161
1162 =cut
1163
1164 sub options {
1165   my $self = shift;
1166   map { $_->optionname => $_->optionvalue } $self->part_pkg_option;
1167 }
1168
1169 =item option OPTIONNAME [ QUIET ]
1170
1171 Returns the option value for the given name, or the empty string.  If a true
1172 value is passed as the second argument, warnings about missing the option
1173 will be suppressed.
1174
1175 =cut
1176
1177 sub option {
1178   my( $self, $opt, $ornull ) = @_;
1179   my $part_pkg_option =
1180     qsearchs('part_pkg_option', {
1181       pkgpart    => $self->pkgpart,
1182       optionname => $opt,
1183   } );
1184   return $part_pkg_option->optionvalue if $part_pkg_option;
1185   my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); }
1186                      split("\n", $self->get('plandata') );
1187   return $plandata{$opt} if exists $plandata{$opt};
1188   cluck "WARNING: (pkgpart ". $self->pkgpart. ") Package def option $opt ".
1189         "not found in options or plandata!\n"
1190     unless $ornull;
1191   '';
1192 }
1193
1194 =item bill_part_pkg_link
1195
1196 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1197
1198 =cut
1199
1200 sub bill_part_pkg_link {
1201   shift->_part_pkg_link('bill', @_);
1202 }
1203
1204 =item svc_part_pkg_link
1205
1206 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1207
1208 =cut
1209
1210 sub svc_part_pkg_link {
1211   shift->_part_pkg_link('svc', @_);
1212 }
1213
1214 =item supp_part_pkg_link
1215
1216 Returns the associated part_pkg_link records of type 'supp' (supplemental
1217 packages).
1218
1219 =cut
1220
1221 sub supp_part_pkg_link {
1222   shift->_part_pkg_link('supp', @_);
1223 }
1224
1225 sub _part_pkg_link {
1226   my( $self, $type ) = @_;
1227   qsearch({ table    => 'part_pkg_link',
1228             hashref  => { 'src_pkgpart' => $self->pkgpart,
1229                           'link_type'   => $type,
1230                           #protection against infinite recursive links
1231                           'dst_pkgpart' => { op=>'!=', value=> $self->pkgpart },
1232                         },
1233             order_by => "ORDER BY hidden",
1234          });
1235 }
1236
1237 sub self_and_bill_linked {
1238   shift->_self_and_linked('bill', @_);
1239 }
1240
1241 sub self_and_svc_linked {
1242   shift->_self_and_linked('svc', @_);
1243 }
1244
1245 sub _self_and_linked {
1246   my( $self, $type, $hidden ) = @_;
1247   $hidden ||= '';
1248
1249   my @result = ();
1250   foreach ( ( $self, map { $_->dst_pkg->_self_and_linked($type, $_->hidden) }
1251                      $self->_part_pkg_link($type) ) )
1252   {
1253     $_->hidden($hidden) if $hidden;
1254     push @result, $_;
1255   }
1256
1257   (@result);
1258 }
1259
1260 =item part_pkg_taxoverride [ CLASS ]
1261
1262 Returns all associated FS::part_pkg_taxoverride objects (see
1263 L<FS::part_pkg_taxoverride>).  Limits the returned set to those
1264 of class CLASS if defined.  Class may be one of 'setup', 'recur',
1265 the empty string (default), or a usage class number (see L<FS::usage_class>).
1266 When a class is specified, the empty string class (default) is returned
1267 if no more specific values exist.
1268
1269 =cut
1270
1271 sub part_pkg_taxoverride {
1272   my $self = shift;
1273   my $class = shift;
1274
1275   my $hashref = { 'pkgpart' => $self->pkgpart };
1276   $hashref->{'usage_class'} = $class if defined($class);
1277   my @overrides = qsearch('part_pkg_taxoverride', $hashref );
1278
1279   unless ( scalar(@overrides) || !defined($class) || !$class ){
1280     $hashref->{'usage_class'} = '';
1281     @overrides = qsearch('part_pkg_taxoverride', $hashref );
1282   }
1283
1284   @overrides;
1285 }
1286
1287 =item has_taxproduct
1288
1289 Returns true if this package has any taxproduct associated with it.
1290
1291 =cut
1292
1293 sub has_taxproduct {
1294   my $self = shift;
1295
1296   $self->taxproductnum ||
1297   scalar( grep { $_ =~/^usage_taxproductnum_/ && $self->option($_) }
1298           keys %{ {$self->options} }
1299   )
1300
1301 }
1302
1303
1304 =item taxproduct [ CLASS ]
1305
1306 Returns the associated tax product for this package definition (see
1307 L<FS::part_pkg_taxproduct>).  CLASS may be one of 'setup', 'recur' or
1308 the usage classnum (see L<FS::usage_class>).  Returns the default
1309 tax product for this record if the more specific CLASS value does
1310 not exist.
1311
1312 =cut
1313
1314 sub taxproduct {
1315   my $self = shift;
1316   my $class = shift;
1317
1318   my $part_pkg_taxproduct;
1319
1320   my $taxproductnum = $self->taxproductnum;
1321   if ($class) {
1322     my $class_taxproductnum = $self->option("usage_taxproductnum_$class", 1);
1323     $taxproductnum = $class_taxproductnum
1324       if $class_taxproductnum
1325   }
1326
1327   $part_pkg_taxproduct =
1328     qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1329
1330   unless ($part_pkg_taxproduct || $taxproductnum eq $self->taxproductnum ) {
1331     $taxproductnum = $self->taxproductnum;
1332     $part_pkg_taxproduct =
1333       qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1334   }
1335
1336   $part_pkg_taxproduct;
1337 }
1338
1339 =item taxproduct_description [ CLASS ]
1340
1341 Returns the description of the associated tax product for this package
1342 definition (see L<FS::part_pkg_taxproduct>).
1343
1344 =cut
1345
1346 sub taxproduct_description {
1347   my $self = shift;
1348   my $part_pkg_taxproduct = $self->taxproduct(@_);
1349   $part_pkg_taxproduct ? $part_pkg_taxproduct->description : '';
1350 }
1351
1352 =item part_pkg_taxrate DATA_PROVIDER, GEOCODE, [ CLASS ]
1353
1354 Returns the package to taxrate m2m records for this package in the location
1355 specified by GEOCODE (see L<FS::part_pkg_taxrate>) and usage class CLASS.
1356 CLASS may be one of 'setup', 'recur', or one of the usage classes numbers
1357 (see L<FS::usage_class>).
1358
1359 =cut
1360
1361 sub _expand_cch_taxproductnum {
1362   my $self = shift;
1363   my $class = shift;
1364   my $part_pkg_taxproduct = $self->taxproduct($class);
1365
1366   my ($a,$b,$c,$d) = ( $part_pkg_taxproduct
1367                          ? ( split ':', $part_pkg_taxproduct->taxproduct )
1368                          : ()
1369                      );
1370   $a = '' unless $a; $b = '' unless $b; $c = '' unless $c; $d = '' unless $d;
1371   my $extra_sql = "AND ( taxproduct = '$a:$b:$c:$d'
1372                       OR taxproduct = '$a:$b:$c:'
1373                       OR taxproduct = '$a:$b:".":$d'
1374                       OR taxproduct = '$a:$b:".":' )";
1375   map { $_->taxproductnum } qsearch( { 'table'     => 'part_pkg_taxproduct',
1376                                        'hashref'   => { 'data_vendor'=>'cch' },
1377                                        'extra_sql' => $extra_sql,
1378                                    } );
1379
1380 }
1381
1382 sub part_pkg_taxrate {
1383   my $self = shift;
1384   my ($data_vendor, $geocode, $class) = @_;
1385
1386   my $dbh = dbh;
1387   my $extra_sql = 'WHERE part_pkg_taxproduct.data_vendor = '.
1388                   dbh->quote($data_vendor);
1389
1390   # CCH oddness in m2m
1391   $extra_sql .= ' AND ('.
1392     join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
1393                  qw(10 5 2)
1394         ).
1395     ')';
1396   # much more CCH oddness in m2m -- this is kludgy
1397   my @tpnums = $self->_expand_cch_taxproductnum($class);
1398   if (scalar(@tpnums)) {
1399     $extra_sql .= ' AND ('.
1400                             join(' OR ', map{ "taxproductnum = $_" } @tpnums ).
1401                        ')';
1402   } else {
1403     $extra_sql .= ' AND ( 0 = 1 )';
1404   }
1405
1406   my $addl_from = 'LEFT JOIN part_pkg_taxproduct USING ( taxproductnum )';
1407   my $order_by = 'ORDER BY taxclassnum, length(geocode) desc, length(taxproduct) desc';
1408   my $select   = 'DISTINCT ON(taxclassnum) *, taxproduct';
1409
1410   # should qsearch preface columns with the table to facilitate joins?
1411   qsearch( { 'table'     => 'part_pkg_taxrate',
1412              'select'    => $select,
1413              'hashref'   => { # 'data_vendor'   => $data_vendor,
1414                               # 'taxproductnum' => $self->taxproductnum,
1415                             },
1416              'addl_from' => $addl_from,
1417              'extra_sql' => $extra_sql,
1418              'order_by'  => $order_by,
1419          } );
1420 }
1421
1422 =item part_pkg_discount
1423
1424 Returns the package to discount m2m records (see L<FS::part_pkg_discount>)
1425 for this package.
1426
1427 =cut
1428
1429 sub part_pkg_discount {
1430   my $self = shift;
1431   qsearch('part_pkg_discount', { 'pkgpart' => $self->pkgpart });
1432 }
1433
1434 =item part_pkg_usage
1435
1436 Returns the voice usage pools (see L<FS::part_pkg_usage>) defined for
1437 this package.
1438
1439 =cut
1440
1441 sub part_pkg_usage {
1442   my $self = shift;
1443   qsearch('part_pkg_usage', { 'pkgpart' => $self->pkgpart });
1444 }
1445
1446 =item _rebless
1447
1448 Reblesses the object into the FS::part_pkg::PLAN class (if available), where
1449 PLAN is the object's I<plan> field.  There should be better docs
1450 on how to create new price plans, but until then, see L</NEW PLAN CLASSES>.
1451
1452 =cut
1453
1454 sub _rebless {
1455   my $self = shift;
1456   my $plan = $self->plan;
1457   unless ( $plan ) {
1458     cluck "no price plan found for pkgpart ". $self->pkgpart. "\n"
1459       if $DEBUG;
1460     return $self;
1461   }
1462   return $self if ref($self) =~ /::$plan$/; #already blessed into plan subclass
1463   my $class = ref($self). "::$plan";
1464   warn "reblessing $self into $class" if $DEBUG > 1;
1465   eval "use $class;";
1466   die $@ if $@;
1467   bless($self, $class) unless $@;
1468   $self;
1469 }
1470
1471 #fatal fallbacks
1472 sub calc_setup { die 'no calc_setup for '. shift->plan. "\n"; }
1473 sub calc_recur { die 'no calc_recur for '. shift->plan. "\n"; }
1474
1475 #fallback that return 0 for old legacy packages with no plan
1476 sub calc_remain { 0; }
1477 sub calc_units  { 0; }
1478
1479 #fallback for everything not based on flat.pm
1480 sub recur_temporality { 'upcoming'; }
1481 sub calc_cancel { 0; }
1482
1483 #fallback for everything except bulk.pm
1484 sub hide_svc_detail { 0; }
1485
1486 #fallback for packages that can't/won't summarize usage
1487 sub sum_usage { 0; }
1488
1489 =item recur_cost_permonth CUST_PKG
1490
1491 recur_cost divided by freq (only supported for monthly and longer frequencies)
1492
1493 =cut
1494
1495 sub recur_cost_permonth {
1496   my($self, $cust_pkg) = @_;
1497   return 0 unless $self->freq =~ /^\d+$/ && $self->freq > 0;
1498   sprintf('%.2f', $self->recur_cost / $self->freq );
1499 }
1500
1501 =item cust_bill_pkg_recur CUST_PKG
1502
1503 Actual recurring charge for the specified customer package from customer's most
1504 recent invoice
1505
1506 =cut
1507
1508 sub cust_bill_pkg_recur {
1509   my($self, $cust_pkg) = @_;
1510   my $cust_bill_pkg = qsearchs({
1511     'table'     => 'cust_bill_pkg',
1512     'addl_from' => 'LEFT JOIN cust_bill USING ( invnum )',
1513     'hashref'   => { 'pkgnum' => $cust_pkg->pkgnum,
1514                      'recur'  => { op=>'>', value=>'0' },
1515                    },
1516     'order_by'  => 'ORDER BY cust_bill._date     DESC,
1517                              cust_bill_pkg.sdate DESC
1518                      LIMIT 1
1519                    ',
1520   }) or return 0; #die "use cust_bill_pkg_recur credits with once_perinv condition";
1521   $cust_bill_pkg->recur;
1522 }
1523
1524 =item format OPTION DATA
1525
1526 Returns data formatted according to the function 'format' described
1527 in the plan info.  Returns DATA if no such function exists.
1528
1529 =cut
1530
1531 sub format {
1532   my ($self, $option, $data) = (shift, shift, shift);
1533   if (exists($plans{$self->plan}->{fields}->{$option}{format})) {
1534     &{$plans{$self->plan}->{fields}->{$option}{format}}($data);
1535   }else{
1536     $data;
1537   }
1538 }
1539
1540 =item parse OPTION DATA
1541
1542 Returns data parsed according to the function 'parse' described
1543 in the plan info.  Returns DATA if no such function exists.
1544
1545 =cut
1546
1547 sub parse {
1548   my ($self, $option, $data) = (shift, shift, shift);
1549   if (exists($plans{$self->plan}->{fields}->{$option}{parse})) {
1550     &{$plans{$self->plan}->{fields}->{$option}{parse}}($data);
1551   }else{
1552     $data;
1553   }
1554 }
1555
1556 =back
1557
1558 =cut
1559
1560 =head1 CLASS METHODS
1561
1562 =over 4
1563
1564 =cut
1565
1566 # _upgrade_data
1567 #
1568 # Used by FS::Upgrade to migrate to a new database.
1569
1570 sub _upgrade_data { # class method
1571   my($class, %opts) = @_;
1572
1573   warn "[FS::part_pkg] upgrading $class\n" if $DEBUG;
1574
1575   my @part_pkg = qsearch({
1576     'table'     => 'part_pkg',
1577     'extra_sql' => "WHERE ". join(' OR ',
1578                      'plan IS NULL', "plan = '' ",
1579                    ),
1580   });
1581
1582   foreach my $part_pkg (@part_pkg) {
1583
1584     unless ( $part_pkg->plan ) {
1585       $part_pkg->plan('flat');
1586     }
1587
1588     $part_pkg->replace;
1589
1590   }
1591
1592   # now upgrade to the explicit custom flag
1593
1594   @part_pkg = qsearch({
1595     'table'     => 'part_pkg',
1596     'hashref'   => { disabled => 'Y', custom => '' },
1597     'extra_sql' => "AND comment LIKE '(CUSTOM) %'",
1598   });
1599
1600   foreach my $part_pkg (@part_pkg) {
1601     my $new = new FS::part_pkg { $part_pkg->hash };
1602     $new->custom('Y');
1603     my $comment = $part_pkg->comment;
1604     $comment =~ s/^\(CUSTOM\) //;
1605     $comment = '(none)' unless $comment =~ /\S/;
1606     $new->comment($comment);
1607
1608     my $pkg_svc = { map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc };
1609     my $primary = $part_pkg->svcpart;
1610     my $options = { $part_pkg->options };
1611
1612     my $error = $new->replace( $part_pkg,
1613                                'pkg_svc'     => $pkg_svc,
1614                                'primary_svc' => $primary,
1615                                'options'     => $options,
1616                              );
1617     die $error if $error;
1618   }
1619
1620   # set family_pkgpart on any packages that don't have it
1621   @part_pkg = qsearch('part_pkg', { 'family_pkgpart' => '' });
1622   foreach my $part_pkg (@part_pkg) {
1623     $part_pkg->set('family_pkgpart' => $part_pkg->pkgpart);
1624     my $error = $part_pkg->SUPER::replace;
1625     die $error if $error;
1626   }
1627
1628   my @part_pkg_option = qsearch('part_pkg_option',
1629     { 'optionname'  => 'unused_credit',
1630       'optionvalue' => 1,
1631     });
1632   foreach my $old_opt (@part_pkg_option) {
1633     my $pkgpart = $old_opt->pkgpart;
1634     my $error = $old_opt->delete;
1635     die $error if $error;
1636
1637     foreach (qw(unused_credit_cancel unused_credit_change)) {
1638       my $new_opt = new FS::part_pkg_option {
1639         'pkgpart'     => $pkgpart,
1640         'optionname'  => $_,
1641         'optionvalue' => 1,
1642       };
1643       $error = $new_opt->insert;
1644       die $error if $error;
1645     }
1646   }
1647
1648   # migrate use_disposition_taqua and use_disposition to disposition_in
1649   @part_pkg_option = qsearch('part_pkg_option',
1650     { 'optionname'  => { op => 'LIKE',
1651                          value => 'use_disposition%',
1652                        },
1653       'optionvalue' => 1,
1654     });
1655   my %newopts = map { $_->pkgpart => $_ }
1656     qsearch('part_pkg_option',  { 'optionname'  => 'disposition_in', } );
1657   foreach my $old_opt (@part_pkg_option) {
1658         my $pkgpart = $old_opt->pkgpart;
1659         my $newval = $old_opt->optionname eq 'use_disposition_taqua' ? '100'
1660                                                                   : 'ANSWERED';
1661         my $error = $old_opt->delete;
1662         die $error if $error;
1663
1664         if ( exists($newopts{$pkgpart}) ) {
1665             my $opt = $newopts{$pkgpart};
1666             $opt->optionvalue($opt->optionvalue.",$newval");
1667             $error = $opt->replace;
1668             die $error if $error;
1669         } else {
1670             my $new_opt = new FS::part_pkg_option {
1671                 'pkgpart'     => $pkgpart,
1672                 'optionname'  => 'disposition_in',
1673                 'optionvalue' => $newval,
1674               };
1675               $error = $new_opt->insert;
1676               die $error if $error;
1677               $newopts{$pkgpart} = $new_opt;
1678         }
1679   }
1680
1681   # set any package with FCC voice lines to the "VoIP with broadband" category
1682   # for backward compatibility
1683   #
1684   # recover from a bad upgrade bug
1685   my $upgrade = 'part_pkg_fcc_voip_class_FIX';
1686   if (!FS::upgrade_journal->is_done($upgrade)) {
1687     my $bad_upgrade = qsearchs('upgrade_journal',
1688       { upgrade => 'part_pkg_fcc_voip_class' }
1689     );
1690     if ( $bad_upgrade ) {
1691       my $where = 'WHERE history_date <= '.$bad_upgrade->_date.
1692                   ' AND  history_date >  '.($bad_upgrade->_date - 3600);
1693       my @h_part_pkg_option = map { FS::part_pkg_option->new($_->hashref) }
1694         qsearch({
1695           'select'    => '*',
1696           'table'     => 'h_part_pkg_option',
1697           'hashref'   => {},
1698           'extra_sql' => "$where AND history_action = 'delete'",
1699           'order_by'  => 'ORDER BY history_date ASC',
1700         });
1701       my @h_pkg_svc = map { FS::pkg_svc->new($_->hashref) }
1702         qsearch({
1703           'select'    => '*',
1704           'table'     => 'h_pkg_svc',
1705           'hashref'   => {},
1706           'extra_sql' => "$where AND history_action = 'replace_old'",
1707           'order_by'  => 'ORDER BY history_date ASC',
1708         });
1709       my %opt;
1710       foreach my $deleted (@h_part_pkg_option, @h_pkg_svc) {
1711         my $pkgpart ||= $deleted->pkgpart;
1712         $opt{$pkgpart} ||= {
1713           options => {},
1714           pkg_svc => {},
1715           primary_svc => '',
1716           hidden_svc => {},
1717         };
1718         if ( $deleted->isa('FS::part_pkg_option') ) {
1719           $opt{$pkgpart}{options}{ $deleted->optionname } = $deleted->optionvalue;
1720         } else { # pkg_svc
1721           my $svcpart = $deleted->svcpart;
1722           $opt{$pkgpart}{pkg_svc}{$svcpart} = $deleted->quantity;
1723           $opt{$pkgpart}{hidden_svc}{$svcpart} ||= $deleted->hidden;
1724           $opt{$pkgpart}{primary_svc} = $svcpart if $deleted->primary_svc;
1725         }
1726       }
1727       foreach my $pkgpart (keys %opt) {
1728         my $part_pkg = FS::part_pkg->by_key($pkgpart);
1729         my $error = $part_pkg->replace( $part_pkg->replace_old, $opt{$pkgpart} );
1730         if ( $error ) {
1731           die "error recovering damaged pkgpart $pkgpart:\n$error\n";
1732         }
1733       }
1734     } # $bad_upgrade exists
1735     else { # do the original upgrade, but correctly this time
1736       @part_pkg = qsearch('part_pkg', {
1737           fcc_ds0s        => { op => '>', value => 0 },
1738           fcc_voip_class  => ''
1739       });
1740       foreach my $part_pkg (@part_pkg) {
1741         $part_pkg->set(fcc_voip_class => 2);
1742         my @pkg_svc = $part_pkg->pkg_svc;
1743         my %quantity = map {$_->svcpart, $_->quantity} @pkg_svc;
1744         my %hidden   = map {$_->svcpart, $_->hidden  } @pkg_svc;
1745         my $error = $part_pkg->replace(
1746           $part_pkg->replace_old,
1747           options     => { $part_pkg->options },
1748           pkg_svc     => \%quantity,
1749           hidden_svc  => \%hidden,
1750           primary_svc => ($part_pkg->svcpart || ''),
1751         );
1752         die $error if $error;
1753       }
1754     }
1755     FS::upgrade_journal->set_done($upgrade);
1756   }
1757
1758 }
1759
1760 =item curuser_pkgs_sql
1761
1762 Returns an SQL fragment for searching for packages the current user can
1763 use, either via part_pkg.agentnum directly, or via agent type (see
1764 L<FS::type_pkgs>).
1765
1766 =cut
1767
1768 sub curuser_pkgs_sql {
1769   my $class = shift;
1770
1771   $class->_pkgs_sql( $FS::CurrentUser::CurrentUser->agentnums );
1772
1773 }
1774
1775 =item agent_pkgs_sql AGENT | AGENTNUM, ...
1776
1777 Returns an SQL fragment for searching for packages the provided agent or agents
1778 can use, either via part_pkg.agentnum directly, or via agent type (see
1779 L<FS::type_pkgs>).
1780
1781 =cut
1782
1783 sub agent_pkgs_sql {
1784   my $class = shift;  #i'm a class method, not a sub (the question is... why??)
1785   my @agentnums = map { ref($_) ? $_->agentnum : $_ } @_;
1786
1787   $class->_pkgs_sql(@agentnums); #is this why
1788
1789 }
1790
1791 sub _pkgs_sql {
1792   my( $class, @agentnums ) = @_;
1793   my $agentnums = join(',', @agentnums);
1794
1795   "
1796     (
1797       ( agentnum IS NOT NULL AND agentnum IN ($agentnums) )
1798       OR ( agentnum IS NULL
1799            AND EXISTS ( SELECT 1
1800                           FROM type_pkgs
1801                             LEFT JOIN agent_type USING ( typenum )
1802                             LEFT JOIN agent AS typeagent USING ( typenum )
1803                           WHERE type_pkgs.pkgpart = part_pkg.pkgpart
1804                             AND typeagent.agentnum IN ($agentnums)
1805                       )
1806          )
1807     )
1808   ";
1809
1810 }
1811
1812 =back
1813
1814 =head1 SUBROUTINES
1815
1816 =over 4
1817
1818 =item plan_info
1819
1820 =cut
1821
1822 #false laziness w/part_export & cdr
1823 my %info;
1824 foreach my $INC ( @INC ) {
1825   warn "globbing $INC/FS/part_pkg/*.pm\n" if $DEBUG;
1826   foreach my $file ( glob("$INC/FS/part_pkg/*.pm") ) {
1827     warn "attempting to load plan info from $file\n" if $DEBUG;
1828     $file =~ /\/(\w+)\.pm$/ or do {
1829       warn "unrecognized file in $INC/FS/part_pkg/: $file\n";
1830       next;
1831     };
1832     my $mod = $1;
1833     my $info = eval "use FS::part_pkg::$mod; ".
1834                     "\\%FS::part_pkg::$mod\::info;";
1835     if ( $@ ) {
1836       die "error using FS::part_pkg::$mod (skipping): $@\n" if $@;
1837       next;
1838     }
1839     unless ( keys %$info ) {
1840       warn "no %info hash found in FS::part_pkg::$mod, skipping\n";
1841       next;
1842     }
1843     warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG;
1844     #if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
1845     #  warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG;
1846     #  next;
1847     #}
1848     $info{$mod} = $info;
1849     $info->{'weight'} ||= 0; # quiet warnings
1850   }
1851 }
1852
1853 # copy one level deep to allow replacement of fields and fieldorder
1854 tie %plans, 'Tie::IxHash',
1855   map  { my %infohash = %{ $info{$_} };
1856           $_ => \%infohash }
1857   sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} }
1858   keys %info;
1859
1860 # inheritance of plan options
1861 foreach my $name (keys(%info)) {
1862   if (exists($info{$name}->{'disabled'}) and $info{$name}->{'disabled'}) {
1863     warn "skipping disabled plan FS::part_pkg::$name" if $DEBUG;
1864     delete $plans{$name};
1865     next;
1866   }
1867   my $parents = $info{$name}->{'inherit_fields'} || [];
1868   my (%fields, %field_exists, @fieldorder);
1869   foreach my $parent ($name, @$parents) {
1870     if ( !exists($info{$parent}) ) {
1871       warn "$name tried to inherit from nonexistent '$parent'\n";
1872       next;
1873     }
1874     %fields = ( # avoid replacing existing fields
1875       %{ $info{$parent}->{'fields'} || {} },
1876       %fields
1877     );
1878     foreach (@{ $info{$parent}->{'fieldorder'} || [] }) {
1879       # avoid duplicates
1880       next if $field_exists{$_};
1881       $field_exists{$_} = 1;
1882       # allow inheritors to remove inherited fields from the fieldorder
1883       push @fieldorder, $_ if !exists($fields{$_}) or
1884                               !exists($fields{$_}->{'disabled'});
1885     }
1886   }
1887   $plans{$name}->{'fields'} = \%fields;
1888   $plans{$name}->{'fieldorder'} = \@fieldorder;
1889 }
1890
1891 sub plan_info {
1892   \%plans;
1893 }
1894
1895
1896 =back
1897
1898 =head1 NEW PLAN CLASSES
1899
1900 A module should be added in FS/FS/part_pkg/  Eventually, an example may be
1901 found in eg/plan_template.pm.  Until then, it is suggested that you use the
1902 other modules in FS/FS/part_pkg/ as a guide.
1903
1904 =head1 BUGS
1905
1906 The delete method is unimplemented.
1907
1908 setup and recur semantics are not yet defined (and are implemented in
1909 FS::cust_bill.  hmm.).  now they're deprecated and need to go.
1910
1911 plandata should go
1912
1913 part_pkg_taxrate is Pg specific
1914
1915 replace should be smarter about managing the related tables (options, pkg_svc)
1916
1917 =head1 SEE ALSO
1918
1919 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
1920 schema.html from the base documentation.
1921
1922 =cut
1923
1924 1;
1925