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   } elsif ( $freq =~ /^(\d+)w$/ ) {
1085     my $weeks = $1;
1086     $mday += $weeks * 7;
1087   } elsif ( $freq =~ /^(\d+)d$/ ) {
1088     my $days = $1;
1089     $mday += $days;
1090   } elsif ( $freq =~ /^(\d+)h$/ ) {
1091     my $hours = $1;
1092     $hour += $hours;
1093   } else {
1094     return -1;
1095   }
1096
1097   timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
1098 }
1099
1100 =item plandata
1101
1102 For backwards compatibility, returns the plandata field as well as all options
1103 from FS::part_pkg_option.
1104
1105 =cut
1106
1107 sub plandata {
1108   my $self = shift;
1109   carp "plandata is deprecated";
1110   if ( @_ ) {
1111     $self->SUPER::plandata(@_);
1112   } else {
1113     my $plandata = $self->get('plandata');
1114     my %options = $self->options;
1115     $plandata .= join('', map { "$_=$options{$_}\n" } keys %options );
1116     $plandata;
1117   }
1118 }
1119
1120 =item part_pkg_vendor
1121
1122 Returns all vendor/external package ids as FS::part_pkg_vendor objects (see
1123 L<FS::part_pkg_vendor>).
1124
1125 =cut
1126
1127 sub part_pkg_vendor {
1128   my $self = shift;
1129   qsearch('part_pkg_vendor', { 'pkgpart' => $self->pkgpart } );
1130 }
1131
1132 =item vendor_pkg_ids
1133
1134 Returns a list of vendor/external package ids by exportnum
1135
1136 =cut
1137
1138 sub vendor_pkg_ids {
1139   my $self = shift;
1140   map { $_->exportnum => $_->vendor_pkg_id } $self->part_pkg_vendor;
1141 }
1142
1143 =item part_pkg_option
1144
1145 Returns all options as FS::part_pkg_option objects (see
1146 L<FS::part_pkg_option>).
1147
1148 =cut
1149
1150 sub part_pkg_option {
1151   my $self = shift;
1152   qsearch('part_pkg_option', { 'pkgpart' => $self->pkgpart } );
1153 }
1154
1155 =item options
1156
1157 Returns a list of option names and values suitable for assigning to a hash.
1158
1159 =cut
1160
1161 sub options {
1162   my $self = shift;
1163   map { $_->optionname => $_->optionvalue } $self->part_pkg_option;
1164 }
1165
1166 =item option OPTIONNAME [ QUIET ]
1167
1168 Returns the option value for the given name, or the empty string.  If a true
1169 value is passed as the second argument, warnings about missing the option
1170 will be suppressed.
1171
1172 =cut
1173
1174 sub option {
1175   my( $self, $opt, $ornull ) = @_;
1176   my $part_pkg_option =
1177     qsearchs('part_pkg_option', {
1178       pkgpart    => $self->pkgpart,
1179       optionname => $opt,
1180   } );
1181   return $part_pkg_option->optionvalue if $part_pkg_option;
1182   my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); }
1183                      split("\n", $self->get('plandata') );
1184   return $plandata{$opt} if exists $plandata{$opt};
1185   cluck "WARNING: (pkgpart ". $self->pkgpart. ") Package def option $opt ".
1186         "not found in options or plandata!\n"
1187     unless $ornull;
1188   '';
1189 }
1190
1191 =item bill_part_pkg_link
1192
1193 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1194
1195 =cut
1196
1197 sub bill_part_pkg_link {
1198   shift->_part_pkg_link('bill', @_);
1199 }
1200
1201 =item svc_part_pkg_link
1202
1203 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1204
1205 =cut
1206
1207 sub svc_part_pkg_link {
1208   shift->_part_pkg_link('svc', @_);
1209 }
1210
1211 =item supp_part_pkg_link
1212
1213 Returns the associated part_pkg_link records of type 'supp' (supplemental
1214 packages).
1215
1216 =cut
1217
1218 sub supp_part_pkg_link {
1219   shift->_part_pkg_link('supp', @_);
1220 }
1221
1222 sub _part_pkg_link {
1223   my( $self, $type ) = @_;
1224   qsearch({ table    => 'part_pkg_link',
1225             hashref  => { 'src_pkgpart' => $self->pkgpart,
1226                           'link_type'   => $type,
1227                           #protection against infinite recursive links
1228                           'dst_pkgpart' => { op=>'!=', value=> $self->pkgpart },
1229                         },
1230             order_by => "ORDER BY hidden",
1231          });
1232 }
1233
1234 sub self_and_bill_linked {
1235   shift->_self_and_linked('bill', @_);
1236 }
1237
1238 sub self_and_svc_linked {
1239   shift->_self_and_linked('svc', @_);
1240 }
1241
1242 sub _self_and_linked {
1243   my( $self, $type, $hidden ) = @_;
1244   $hidden ||= '';
1245
1246   my @result = ();
1247   foreach ( ( $self, map { $_->dst_pkg->_self_and_linked($type, $_->hidden) }
1248                      $self->_part_pkg_link($type) ) )
1249   {
1250     $_->hidden($hidden) if $hidden;
1251     push @result, $_;
1252   }
1253
1254   (@result);
1255 }
1256
1257 =item part_pkg_taxoverride [ CLASS ]
1258
1259 Returns all associated FS::part_pkg_taxoverride objects (see
1260 L<FS::part_pkg_taxoverride>).  Limits the returned set to those
1261 of class CLASS if defined.  Class may be one of 'setup', 'recur',
1262 the empty string (default), or a usage class number (see L<FS::usage_class>).
1263 When a class is specified, the empty string class (default) is returned
1264 if no more specific values exist.
1265
1266 =cut
1267
1268 sub part_pkg_taxoverride {
1269   my $self = shift;
1270   my $class = shift;
1271
1272   my $hashref = { 'pkgpart' => $self->pkgpart };
1273   $hashref->{'usage_class'} = $class if defined($class);
1274   my @overrides = qsearch('part_pkg_taxoverride', $hashref );
1275
1276   unless ( scalar(@overrides) || !defined($class) || !$class ){
1277     $hashref->{'usage_class'} = '';
1278     @overrides = qsearch('part_pkg_taxoverride', $hashref );
1279   }
1280
1281   @overrides;
1282 }
1283
1284 =item has_taxproduct
1285
1286 Returns true if this package has any taxproduct associated with it.
1287
1288 =cut
1289
1290 sub has_taxproduct {
1291   my $self = shift;
1292
1293   $self->taxproductnum ||
1294   scalar( grep { $_ =~/^usage_taxproductnum_/ && $self->option($_) }
1295           keys %{ {$self->options} }
1296   )
1297
1298 }
1299
1300
1301 =item taxproduct [ CLASS ]
1302
1303 Returns the associated tax product for this package definition (see
1304 L<FS::part_pkg_taxproduct>).  CLASS may be one of 'setup', 'recur' or
1305 the usage classnum (see L<FS::usage_class>).  Returns the default
1306 tax product for this record if the more specific CLASS value does
1307 not exist.
1308
1309 =cut
1310
1311 sub taxproduct {
1312   my $self = shift;
1313   my $class = shift;
1314
1315   my $part_pkg_taxproduct;
1316
1317   my $taxproductnum = $self->taxproductnum;
1318   if ($class) {
1319     my $class_taxproductnum = $self->option("usage_taxproductnum_$class", 1);
1320     $taxproductnum = $class_taxproductnum
1321       if $class_taxproductnum
1322   }
1323
1324   $part_pkg_taxproduct =
1325     qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1326
1327   unless ($part_pkg_taxproduct || $taxproductnum eq $self->taxproductnum ) {
1328     $taxproductnum = $self->taxproductnum;
1329     $part_pkg_taxproduct =
1330       qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1331   }
1332
1333   $part_pkg_taxproduct;
1334 }
1335
1336 =item taxproduct_description [ CLASS ]
1337
1338 Returns the description of the associated tax product for this package
1339 definition (see L<FS::part_pkg_taxproduct>).
1340
1341 =cut
1342
1343 sub taxproduct_description {
1344   my $self = shift;
1345   my $part_pkg_taxproduct = $self->taxproduct(@_);
1346   $part_pkg_taxproduct ? $part_pkg_taxproduct->description : '';
1347 }
1348
1349 =item part_pkg_taxrate DATA_PROVIDER, GEOCODE, [ CLASS ]
1350
1351 Returns the package to taxrate m2m records for this package in the location
1352 specified by GEOCODE (see L<FS::part_pkg_taxrate>) and usage class CLASS.
1353 CLASS may be one of 'setup', 'recur', or one of the usage classes numbers
1354 (see L<FS::usage_class>).
1355
1356 =cut
1357
1358 sub _expand_cch_taxproductnum {
1359   my $self = shift;
1360   my $class = shift;
1361   my $part_pkg_taxproduct = $self->taxproduct($class);
1362
1363   my ($a,$b,$c,$d) = ( $part_pkg_taxproduct
1364                          ? ( split ':', $part_pkg_taxproduct->taxproduct )
1365                          : ()
1366                      );
1367   $a = '' unless $a; $b = '' unless $b; $c = '' unless $c; $d = '' unless $d;
1368   my $extra_sql = "AND ( taxproduct = '$a:$b:$c:$d'
1369                       OR taxproduct = '$a:$b:$c:'
1370                       OR taxproduct = '$a:$b:".":$d'
1371                       OR taxproduct = '$a:$b:".":' )";
1372   map { $_->taxproductnum } qsearch( { 'table'     => 'part_pkg_taxproduct',
1373                                        'hashref'   => { 'data_vendor'=>'cch' },
1374                                        'extra_sql' => $extra_sql,
1375                                    } );
1376
1377 }
1378
1379 sub part_pkg_taxrate {
1380   my $self = shift;
1381   my ($data_vendor, $geocode, $class) = @_;
1382
1383   my $dbh = dbh;
1384   my $extra_sql = 'WHERE part_pkg_taxproduct.data_vendor = '.
1385                   dbh->quote($data_vendor);
1386
1387   # CCH oddness in m2m
1388   $extra_sql .= ' AND ('.
1389     join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
1390                  qw(10 5 2)
1391         ).
1392     ')';
1393   # much more CCH oddness in m2m -- this is kludgy
1394   my @tpnums = $self->_expand_cch_taxproductnum($class);
1395   if (scalar(@tpnums)) {
1396     $extra_sql .= ' AND ('.
1397                             join(' OR ', map{ "taxproductnum = $_" } @tpnums ).
1398                        ')';
1399   } else {
1400     $extra_sql .= ' AND ( 0 = 1 )';
1401   }
1402
1403   my $addl_from = 'LEFT JOIN part_pkg_taxproduct USING ( taxproductnum )';
1404   my $order_by = 'ORDER BY taxclassnum, length(geocode) desc, length(taxproduct) desc';
1405   my $select   = 'DISTINCT ON(taxclassnum) *, taxproduct';
1406
1407   # should qsearch preface columns with the table to facilitate joins?
1408   qsearch( { 'table'     => 'part_pkg_taxrate',
1409              'select'    => $select,
1410              'hashref'   => { # 'data_vendor'   => $data_vendor,
1411                               # 'taxproductnum' => $self->taxproductnum,
1412                             },
1413              'addl_from' => $addl_from,
1414              'extra_sql' => $extra_sql,
1415              'order_by'  => $order_by,
1416          } );
1417 }
1418
1419 =item part_pkg_discount
1420
1421 Returns the package to discount m2m records (see L<FS::part_pkg_discount>)
1422 for this package.
1423
1424 =cut
1425
1426 sub part_pkg_discount {
1427   my $self = shift;
1428   qsearch('part_pkg_discount', { 'pkgpart' => $self->pkgpart });
1429 }
1430
1431 =item part_pkg_usage
1432
1433 Returns the voice usage pools (see L<FS::part_pkg_usage>) defined for
1434 this package.
1435
1436 =cut
1437
1438 sub part_pkg_usage {
1439   my $self = shift;
1440   qsearch('part_pkg_usage', { 'pkgpart' => $self->pkgpart });
1441 }
1442
1443 =item _rebless
1444
1445 Reblesses the object into the FS::part_pkg::PLAN class (if available), where
1446 PLAN is the object's I<plan> field.  There should be better docs
1447 on how to create new price plans, but until then, see L</NEW PLAN CLASSES>.
1448
1449 =cut
1450
1451 sub _rebless {
1452   my $self = shift;
1453   my $plan = $self->plan;
1454   unless ( $plan ) {
1455     cluck "no price plan found for pkgpart ". $self->pkgpart. "\n"
1456       if $DEBUG;
1457     return $self;
1458   }
1459   return $self if ref($self) =~ /::$plan$/; #already blessed into plan subclass
1460   my $class = ref($self). "::$plan";
1461   warn "reblessing $self into $class" if $DEBUG > 1;
1462   eval "use $class;";
1463   die $@ if $@;
1464   bless($self, $class) unless $@;
1465   $self;
1466 }
1467
1468 #fatal fallbacks
1469 sub calc_setup { die 'no calc_setup for '. shift->plan. "\n"; }
1470 sub calc_recur { die 'no calc_recur for '. shift->plan. "\n"; }
1471
1472 #fallback that return 0 for old legacy packages with no plan
1473 sub calc_remain { 0; }
1474 sub calc_units  { 0; }
1475
1476 #fallback for everything not based on flat.pm
1477 sub recur_temporality { 'upcoming'; }
1478 sub calc_cancel { 0; }
1479
1480 #fallback for everything except bulk.pm
1481 sub hide_svc_detail { 0; }
1482
1483 #fallback for packages that can't/won't summarize usage
1484 sub sum_usage { 0; }
1485
1486 =item recur_cost_permonth CUST_PKG
1487
1488 recur_cost divided by freq (only supported for monthly and longer frequencies)
1489
1490 =cut
1491
1492 sub recur_cost_permonth {
1493   my($self, $cust_pkg) = @_;
1494   return 0 unless $self->freq =~ /^\d+$/ && $self->freq > 0;
1495   sprintf('%.2f', $self->recur_cost / $self->freq );
1496 }
1497
1498 =item cust_bill_pkg_recur CUST_PKG
1499
1500 Actual recurring charge for the specified customer package from customer's most
1501 recent invoice
1502
1503 =cut
1504
1505 sub cust_bill_pkg_recur {
1506   my($self, $cust_pkg) = @_;
1507   my $cust_bill_pkg = qsearchs({
1508     'table'     => 'cust_bill_pkg',
1509     'addl_from' => 'LEFT JOIN cust_bill USING ( invnum )',
1510     'hashref'   => { 'pkgnum' => $cust_pkg->pkgnum,
1511                      'recur'  => { op=>'>', value=>'0' },
1512                    },
1513     'order_by'  => 'ORDER BY cust_bill._date     DESC,
1514                              cust_bill_pkg.sdate DESC
1515                      LIMIT 1
1516                    ',
1517   }) or return 0; #die "use cust_bill_pkg_recur credits with once_perinv condition";
1518   $cust_bill_pkg->recur;
1519 }
1520
1521 =item format OPTION DATA
1522
1523 Returns data formatted according to the function 'format' described
1524 in the plan info.  Returns DATA if no such function exists.
1525
1526 =cut
1527
1528 sub format {
1529   my ($self, $option, $data) = (shift, shift, shift);
1530   if (exists($plans{$self->plan}->{fields}->{$option}{format})) {
1531     &{$plans{$self->plan}->{fields}->{$option}{format}}($data);
1532   }else{
1533     $data;
1534   }
1535 }
1536
1537 =item parse OPTION DATA
1538
1539 Returns data parsed according to the function 'parse' described
1540 in the plan info.  Returns DATA if no such function exists.
1541
1542 =cut
1543
1544 sub parse {
1545   my ($self, $option, $data) = (shift, shift, shift);
1546   if (exists($plans{$self->plan}->{fields}->{$option}{parse})) {
1547     &{$plans{$self->plan}->{fields}->{$option}{parse}}($data);
1548   }else{
1549     $data;
1550   }
1551 }
1552
1553 =back
1554
1555 =cut
1556
1557 =head1 CLASS METHODS
1558
1559 =over 4
1560
1561 =cut
1562
1563 # _upgrade_data
1564 #
1565 # Used by FS::Upgrade to migrate to a new database.
1566
1567 sub _upgrade_data { # class method
1568   my($class, %opts) = @_;
1569
1570   warn "[FS::part_pkg] upgrading $class\n" if $DEBUG;
1571
1572   my @part_pkg = qsearch({
1573     'table'     => 'part_pkg',
1574     'extra_sql' => "WHERE ". join(' OR ',
1575                      'plan IS NULL', "plan = '' ",
1576                    ),
1577   });
1578
1579   foreach my $part_pkg (@part_pkg) {
1580
1581     unless ( $part_pkg->plan ) {
1582       $part_pkg->plan('flat');
1583     }
1584
1585     $part_pkg->replace;
1586
1587   }
1588
1589   # now upgrade to the explicit custom flag
1590
1591   @part_pkg = qsearch({
1592     'table'     => 'part_pkg',
1593     'hashref'   => { disabled => 'Y', custom => '' },
1594     'extra_sql' => "AND comment LIKE '(CUSTOM) %'",
1595   });
1596
1597   foreach my $part_pkg (@part_pkg) {
1598     my $new = new FS::part_pkg { $part_pkg->hash };
1599     $new->custom('Y');
1600     my $comment = $part_pkg->comment;
1601     $comment =~ s/^\(CUSTOM\) //;
1602     $comment = '(none)' unless $comment =~ /\S/;
1603     $new->comment($comment);
1604
1605     my $pkg_svc = { map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc };
1606     my $primary = $part_pkg->svcpart;
1607     my $options = { $part_pkg->options };
1608
1609     my $error = $new->replace( $part_pkg,
1610                                'pkg_svc'     => $pkg_svc,
1611                                'primary_svc' => $primary,
1612                                'options'     => $options,
1613                              );
1614     die $error if $error;
1615   }
1616
1617   # set family_pkgpart on any packages that don't have it
1618   @part_pkg = qsearch('part_pkg', { 'family_pkgpart' => '' });
1619   foreach my $part_pkg (@part_pkg) {
1620     $part_pkg->set('family_pkgpart' => $part_pkg->pkgpart);
1621     my $error = $part_pkg->SUPER::replace;
1622     die $error if $error;
1623   }
1624
1625   my @part_pkg_option = qsearch('part_pkg_option',
1626     { 'optionname'  => 'unused_credit',
1627       'optionvalue' => 1,
1628     });
1629   foreach my $old_opt (@part_pkg_option) {
1630     my $pkgpart = $old_opt->pkgpart;
1631     my $error = $old_opt->delete;
1632     die $error if $error;
1633
1634     foreach (qw(unused_credit_cancel unused_credit_change)) {
1635       my $new_opt = new FS::part_pkg_option {
1636         'pkgpart'     => $pkgpart,
1637         'optionname'  => $_,
1638         'optionvalue' => 1,
1639       };
1640       $error = $new_opt->insert;
1641       die $error if $error;
1642     }
1643   }
1644
1645   # migrate use_disposition_taqua and use_disposition to disposition_in
1646   @part_pkg_option = qsearch('part_pkg_option',
1647     { 'optionname'  => { op => 'LIKE',
1648                          value => 'use_disposition%',
1649                        },
1650       'optionvalue' => 1,
1651     });
1652   my %newopts = map { $_->pkgpart => $_ }
1653     qsearch('part_pkg_option',  { 'optionname'  => 'disposition_in', } );
1654   foreach my $old_opt (@part_pkg_option) {
1655         my $pkgpart = $old_opt->pkgpart;
1656         my $newval = $old_opt->optionname eq 'use_disposition_taqua' ? '100'
1657                                                                   : 'ANSWERED';
1658         my $error = $old_opt->delete;
1659         die $error if $error;
1660
1661         if ( exists($newopts{$pkgpart}) ) {
1662             my $opt = $newopts{$pkgpart};
1663             $opt->optionvalue($opt->optionvalue.",$newval");
1664             $error = $opt->replace;
1665             die $error if $error;
1666         } else {
1667             my $new_opt = new FS::part_pkg_option {
1668                 'pkgpart'     => $pkgpart,
1669                 'optionname'  => 'disposition_in',
1670                 'optionvalue' => $newval,
1671               };
1672               $error = $new_opt->insert;
1673               die $error if $error;
1674               $newopts{$pkgpart} = $new_opt;
1675         }
1676   }
1677
1678   # set any package with FCC voice lines to the "VoIP with broadband" category
1679   # for backward compatibility
1680   #
1681   # recover from a bad upgrade bug
1682   my $upgrade = 'part_pkg_fcc_voip_class_FIX';
1683   if (!FS::upgrade_journal->is_done($upgrade)) {
1684     my $bad_upgrade = qsearchs('upgrade_journal',
1685       { upgrade => 'part_pkg_fcc_voip_class' }
1686     );
1687     if ( $bad_upgrade ) {
1688       my $where = 'WHERE history_date <= '.$bad_upgrade->_date.
1689                   ' AND  history_date >  '.($bad_upgrade->_date - 3600);
1690       my @h_part_pkg_option = map { FS::part_pkg_option->new($_->hashref) }
1691         qsearch({
1692           'select'    => '*',
1693           'table'     => 'h_part_pkg_option',
1694           'hashref'   => {},
1695           'extra_sql' => "$where AND history_action = 'delete'",
1696           'order_by'  => 'ORDER BY history_date ASC',
1697         });
1698       my @h_pkg_svc = map { FS::pkg_svc->new($_->hashref) }
1699         qsearch({
1700           'select'    => '*',
1701           'table'     => 'h_pkg_svc',
1702           'hashref'   => {},
1703           'extra_sql' => "$where AND history_action = 'replace_old'",
1704           'order_by'  => 'ORDER BY history_date ASC',
1705         });
1706       my %opt;
1707       foreach my $deleted (@h_part_pkg_option, @h_pkg_svc) {
1708         my $pkgpart ||= $deleted->pkgpart;
1709         $opt{$pkgpart} ||= {
1710           options => {},
1711           pkg_svc => {},
1712           primary_svc => '',
1713           hidden_svc => {},
1714         };
1715         if ( $deleted->isa('FS::part_pkg_option') ) {
1716           $opt{$pkgpart}{options}{ $deleted->optionname } = $deleted->optionvalue;
1717         } else { # pkg_svc
1718           my $svcpart = $deleted->svcpart;
1719           $opt{$pkgpart}{pkg_svc}{$svcpart} = $deleted->quantity;
1720           $opt{$pkgpart}{hidden_svc}{$svcpart} ||= $deleted->hidden;
1721           $opt{$pkgpart}{primary_svc} = $svcpart if $deleted->primary_svc;
1722         }
1723       }
1724       foreach my $pkgpart (keys %opt) {
1725         my $part_pkg = FS::part_pkg->by_key($pkgpart);
1726         my $error = $part_pkg->replace( $part_pkg->replace_old, $opt{$pkgpart} );
1727         if ( $error ) {
1728           die "error recovering damaged pkgpart $pkgpart:\n$error\n";
1729         }
1730       }
1731     } # $bad_upgrade exists
1732     else { # do the original upgrade, but correctly this time
1733       @part_pkg = qsearch('part_pkg', {
1734           fcc_ds0s        => { op => '>', value => 0 },
1735           fcc_voip_class  => ''
1736       });
1737       foreach my $part_pkg (@part_pkg) {
1738         $part_pkg->set(fcc_voip_class => 2);
1739         my @pkg_svc = $part_pkg->pkg_svc;
1740         my %quantity = map {$_->svcpart, $_->quantity} @pkg_svc;
1741         my %hidden   = map {$_->svcpart, $_->hidden  } @pkg_svc;
1742         my $error = $part_pkg->replace(
1743           $part_pkg->replace_old,
1744           options     => { $part_pkg->options },
1745           pkg_svc     => \%quantity,
1746           hidden_svc  => \%hidden,
1747           primary_svc => ($part_pkg->svcpart || ''),
1748         );
1749         die $error if $error;
1750       }
1751     }
1752     FS::upgrade_journal->set_done($upgrade);
1753   }
1754
1755 }
1756
1757 =item curuser_pkgs_sql
1758
1759 Returns an SQL fragment for searching for packages the current user can
1760 use, either via part_pkg.agentnum directly, or via agent type (see
1761 L<FS::type_pkgs>).
1762
1763 =cut
1764
1765 sub curuser_pkgs_sql {
1766   my $class = shift;
1767
1768   $class->_pkgs_sql( $FS::CurrentUser::CurrentUser->agentnums );
1769
1770 }
1771
1772 =item agent_pkgs_sql AGENT | AGENTNUM, ...
1773
1774 Returns an SQL fragment for searching for packages the provided agent or agents
1775 can use, either via part_pkg.agentnum directly, or via agent type (see
1776 L<FS::type_pkgs>).
1777
1778 =cut
1779
1780 sub agent_pkgs_sql {
1781   my $class = shift;  #i'm a class method, not a sub (the question is... why??)
1782   my @agentnums = map { ref($_) ? $_->agentnum : $_ } @_;
1783
1784   $class->_pkgs_sql(@agentnums); #is this why
1785
1786 }
1787
1788 sub _pkgs_sql {
1789   my( $class, @agentnums ) = @_;
1790   my $agentnums = join(',', @agentnums);
1791
1792   "
1793     (
1794       ( agentnum IS NOT NULL AND agentnum IN ($agentnums) )
1795       OR ( agentnum IS NULL
1796            AND EXISTS ( SELECT 1
1797                           FROM type_pkgs
1798                             LEFT JOIN agent_type USING ( typenum )
1799                             LEFT JOIN agent AS typeagent USING ( typenum )
1800                           WHERE type_pkgs.pkgpart = part_pkg.pkgpart
1801                             AND typeagent.agentnum IN ($agentnums)
1802                       )
1803          )
1804     )
1805   ";
1806
1807 }
1808
1809 =back
1810
1811 =head1 SUBROUTINES
1812
1813 =over 4
1814
1815 =item plan_info
1816
1817 =cut
1818
1819 #false laziness w/part_export & cdr
1820 my %info;
1821 foreach my $INC ( @INC ) {
1822   warn "globbing $INC/FS/part_pkg/*.pm\n" if $DEBUG;
1823   foreach my $file ( glob("$INC/FS/part_pkg/*.pm") ) {
1824     warn "attempting to load plan info from $file\n" if $DEBUG;
1825     $file =~ /\/(\w+)\.pm$/ or do {
1826       warn "unrecognized file in $INC/FS/part_pkg/: $file\n";
1827       next;
1828     };
1829     my $mod = $1;
1830     my $info = eval "use FS::part_pkg::$mod; ".
1831                     "\\%FS::part_pkg::$mod\::info;";
1832     if ( $@ ) {
1833       die "error using FS::part_pkg::$mod (skipping): $@\n" if $@;
1834       next;
1835     }
1836     unless ( keys %$info ) {
1837       warn "no %info hash found in FS::part_pkg::$mod, skipping\n";
1838       next;
1839     }
1840     warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG;
1841     #if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
1842     #  warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG;
1843     #  next;
1844     #}
1845     $info{$mod} = $info;
1846     $info->{'weight'} ||= 0; # quiet warnings
1847   }
1848 }
1849
1850 # copy one level deep to allow replacement of fields and fieldorder
1851 tie %plans, 'Tie::IxHash',
1852   map  { my %infohash = %{ $info{$_} };
1853           $_ => \%infohash }
1854   sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} }
1855   keys %info;
1856
1857 # inheritance of plan options
1858 foreach my $name (keys(%info)) {
1859   if (exists($info{$name}->{'disabled'}) and $info{$name}->{'disabled'}) {
1860     warn "skipping disabled plan FS::part_pkg::$name" if $DEBUG;
1861     delete $plans{$name};
1862     next;
1863   }
1864   my $parents = $info{$name}->{'inherit_fields'} || [];
1865   my (%fields, %field_exists, @fieldorder);
1866   foreach my $parent ($name, @$parents) {
1867     if ( !exists($info{$parent}) ) {
1868       warn "$name tried to inherit from nonexistent '$parent'\n";
1869       next;
1870     }
1871     %fields = ( # avoid replacing existing fields
1872       %{ $info{$parent}->{'fields'} || {} },
1873       %fields
1874     );
1875     foreach (@{ $info{$parent}->{'fieldorder'} || [] }) {
1876       # avoid duplicates
1877       next if $field_exists{$_};
1878       $field_exists{$_} = 1;
1879       # allow inheritors to remove inherited fields from the fieldorder
1880       push @fieldorder, $_ if !exists($fields{$_}) or
1881                               !exists($fields{$_}->{'disabled'});
1882     }
1883   }
1884   $plans{$name}->{'fields'} = \%fields;
1885   $plans{$name}->{'fieldorder'} = \@fieldorder;
1886 }
1887
1888 sub plan_info {
1889   \%plans;
1890 }
1891
1892
1893 =back
1894
1895 =head1 NEW PLAN CLASSES
1896
1897 A module should be added in FS/FS/part_pkg/  Eventually, an example may be
1898 found in eg/plan_template.pm.  Until then, it is suggested that you use the
1899 other modules in FS/FS/part_pkg/ as a guide.
1900
1901 =head1 BUGS
1902
1903 The delete method is unimplemented.
1904
1905 setup and recur semantics are not yet defined (and are implemented in
1906 FS::cust_bill.  hmm.).  now they're deprecated and need to go.
1907
1908 plandata should go
1909
1910 part_pkg_taxrate is Pg specific
1911
1912 replace should be smarter about managing the related tables (options, pkg_svc)
1913
1914 =head1 SEE ALSO
1915
1916 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
1917 schema.html from the base documentation.
1918
1919 =cut
1920
1921 1;
1922