FS/FS/part_pkg.pm

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