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