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