FS/FS/part_pkg.pm

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