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