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('classnum',       'pkg_class', 'classnum')
 469     || $self->ut_foreign_keyn('addon_classnum', 'pkg_class', 'classnum')
 470     || $self->ut_foreign_keyn('taxproductnum',
 471                               'part_pkg_taxproduct',
 472                               'taxproductnum'
 473                              )
 474     || ( $setup_hack
 475            ? $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum' )
 476            : $self->ut_agentnum_acl('agentnum', \@null_agentnum_right)
 477        )
 478     || $self->SUPER::check
 479   ;
 480   return $error if $error;
 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 addon_pkg_class
 535
 536 Returns the add-on package class, as an FS::pkg_class object, or the empty
 537 string if there is no add-on package class.
 538
 539 =cut
 540
 541 sub addon_pkg_class {
 542   my $self = shift;
 543   if ( $self->addon_classnum ) {
 544     qsearchs('pkg_class', { 'classnum' => $self->addon_classnum } );
 545   } else {
 546     return '';
 547   }
 548 }
 549
 550 =item categoryname
 551
 552 Returns the package category name, or the empty string if there is no package
 553 category.
 554
 555 =cut
 556
 557 sub categoryname {
 558   my $self = shift;
 559   my $pkg_class = $self->pkg_class;
 560   $pkg_class
 561     ? $pkg_class->categoryname
 562     : '';
 563 }
 564
 565 =item classname
 566
 567 Returns the package class name, or the empty string if there is no package
 568 class.
 569
 570 =cut
 571
 572 sub classname {
 573   my $self = shift;
 574   my $pkg_class = $self->pkg_class;
 575   $pkg_class
 576     ? $pkg_class->classname
 577     : '';
 578 }
 579
 580 =item addon_classname
 581
 582 Returns the add-on package class name, or the empty string if there is no
 583 add-on package class.
 584
 585 =cut
 586
 587 sub addon_classname {
 588   my $self = shift;
 589   my $pkg_class = $self->addon_pkg_class;
 590   $pkg_class
 591     ? $pkg_class->classname
 592     : '';
 593 }
 594
 595 =item agent
 596
 597 Returns the associated agent for this event, if any, as an FS::agent object.
 598
 599 =cut
 600
 601 sub agent {
 602   my $self = shift;
 603   qsearchs('agent', { 'agentnum' => $self->agentnum } );
 604 }
 605
 606 =item pkg_svc [ HASHREF | OPTION => VALUE ]
 607
 608 Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
 609 definition (with non-zero quantity).
 610
 611 One option is available, I<disable_linked>.  If set true it will return the
 612 services for this package definition alone, omitting services from any add-on
 613 packages.
 614
 615 =cut
 616
 617 =item type_pkgs
 618
 619 Returns all FS::type_pkgs objects (see L<FS::type_pkgs>) for this package
 620 definition.
 621
 622 =cut
 623
 624 sub type_pkgs {
 625   my $self = shift;
 626   qsearch('type_pkgs', { 'pkgpart' => $self->pkgpart } );
 627 }
 628
 629 sub pkg_svc {
 630   my $self = shift;
 631
 632 #  #sort { $b->primary cmp $a->primary }
 633 #    grep { $_->quantity }
 634 #      qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
 635
 636   my $opt = ref($_[0]) ? $_[0] : { @_ };
 637   my %pkg_svc = map  { $_->svcpart => $_ }
 638                 grep { $_->quantity }
 639                 qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
 640
 641   unless ( $opt->{disable_linked} ) {
 642     foreach my $dst_pkg ( map $_->dst_pkg, $self->svc_part_pkg_link ) {
 643       my @pkg_svc = grep { $_->quantity }
 644                     qsearch( 'pkg_svc', { pkgpart=>$dst_pkg->pkgpart } );
 645       foreach my $pkg_svc ( @pkg_svc ) {
 646         if ( $pkg_svc{$pkg_svc->svcpart} ) {
 647           my $quantity = $pkg_svc{$pkg_svc->svcpart}->quantity;
 648           $pkg_svc{$pkg_svc->svcpart}->quantity($quantity + $pkg_svc->quantity);
 649         } else {
 650           $pkg_svc{$pkg_svc->svcpart} = $pkg_svc;
 651         }
 652       }
 653     }
 654   }
 655
 656   values(%pkg_svc);
 657
 658 }
 659
 660 =item svcpart [ SVCDB ]
 661
 662 Returns the svcpart of the primary service definition (see L<FS::part_svc>)
 663 associated with this package definition (see L<FS::pkg_svc>).  Returns
 664 false if there not a primary service definition or exactly one service
 665 definition with quantity 1, or if SVCDB is specified and does not match the
 666 svcdb of the service definition.  SVCDB can be specified as a scalar table
 667 name, such as 'svc_acct', or as an arrayref of possible table names.
 668
 669 =cut
 670
 671 sub svcpart {
 672   my $pkg_svc = shift->_primary_pkg_svc(@_);
 673   $pkg_svc ? $pkg_svc->svcpart : '';
 674 }
 675
 676 =item part_svc [ SVCDB ]
 677
 678 Like the B<svcpart> method, but returns the FS::part_svc object (see
 679 L<FS::part_svc>).
 680
 681 =cut
 682
 683 sub part_svc {
 684   my $pkg_svc = shift->_primary_pkg_svc(@_);
 685   $pkg_svc ? $pkg_svc->part_svc : '';
 686 }
 687
 688 sub _primary_pkg_svc {
 689   my $self = shift;
 690
 691   my $svcdb = scalar(@_) ? shift : [];
 692   $svcdb = ref($svcdb) ? $svcdb : [ $svcdb ];
 693   my %svcdb = map { $_=>1 } @$svcdb;
 694
 695   my @svcdb_pkg_svc =
 696     grep { !scalar(@$svcdb) || $svcdb{ $_->part_svc->svcdb } }
 697          $self->pkg_svc;
 698
 699   my @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc;
 700   @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc
 701     unless @pkg_svc;
 702   return '' if scalar(@pkg_svc) != 1;
 703   $pkg_svc[0];
 704 }
 705
 706 =item svcpart_unique_svcdb SVCDB
 707
 708 Returns the svcpart of a service definition (see L<FS::part_svc>) matching
 709 SVCDB associated with this package definition (see L<FS::pkg_svc>).  Returns
 710 false if there not a primary service definition for SVCDB or there are multiple
 711 service definitions for SVCDB.
 712
 713 =cut
 714
 715 sub svcpart_unique_svcdb {
 716   my( $self, $svcdb ) = @_;
 717   my @svcdb_pkg_svc = grep { ( $svcdb eq $_->part_svc->svcdb ) } $self->pkg_svc;
 718   return '' if scalar(@svcdb_pkg_svc) != 1;
 719   $svcdb_pkg_svc[0]->svcpart;
 720 }
 721
 722 =item payby
 723
 724 Returns a list of the acceptable payment types for this package.  Eventually
 725 this should come out of a database table and be editable, but currently has the
 726 following logic instead:
 727
 728 If the package is free, the single item B<BILL> is
 729 returned, otherwise, the single item B<CARD> is returned.
 730
 731 (CHEK?  LEC?  Probably shouldn't accept those by default, prone to abuse)
 732
 733 =cut
 734
 735 sub payby {
 736   my $self = shift;
 737   if ( $self->is_free ) {
 738     ( 'BILL' );
 739   } else {
 740     ( 'CARD' );
 741   }
 742 }
 743
 744 =item is_free
 745
 746 Returns true if this package is free.
 747
 748 =cut
 749
 750 sub is_free {
 751   my $self = shift;
 752   unless ( $self->plan ) {
 753     $self->setup =~ /^\s*0+(\.0*)?\s*$/
 754       && $self->recur =~ /^\s*0+(\.0*)?\s*$/;
 755   } elsif ( $self->can('is_free_options') ) {
 756     not grep { $_ !~ /^\s*0*(\.0*)?\s*$/ }
 757          map { $self->option($_) }
 758              $self->is_free_options;
 759   } else {
 760     warn "FS::part_pkg::is_free: FS::part_pkg::". $self->plan. " subclass ".
 761          "provides neither is_free_options nor is_free method; returning false";
 762     0;
 763   }
 764 }
 765
 766
 767 sub freqs_href {
 768   #method, class method or sub? #my $self = shift;
 769
 770   tie my %freq, 'Tie::IxHash',
 771     '0'    => '(no recurring fee)',
 772     '1h'   => 'hourly',
 773     '1d'   => 'daily',
 774     '2d'   => 'every two days',
 775     '3d'   => 'every three days',
 776     '1w'   => 'weekly',
 777     '2w'   => 'biweekly (every 2 weeks)',
 778     '1'    => 'monthly',
 779     '45d'  => 'every 45 days',
 780     '2'    => 'bimonthly (every 2 months)',
 781     '3'    => 'quarterly (every 3 months)',
 782     '4'    => 'every 4 months',
 783     '137d' => 'every 4 1/2 months (137 days)',
 784     '6'    => 'semiannually (every 6 months)',
 785     '12'   => 'annually',
 786     '13'   => 'every 13 months (annually +1 month)',
 787     '24'   => 'biannually (every 2 years)',
 788     '36'   => 'triannually (every 3 years)',
 789     '48'   => '(every 4 years)',
 790     '60'   => '(every 5 years)',
 791     '120'  => '(every 10 years)',
 792   ;
 793
 794   \%freq;
 795
 796 }
 797
 798 =item freq_pretty
 799
 800 Returns an english representation of the I<freq> field, such as "monthly",
 801 "weekly", "semi-annually", etc.
 802
 803 =cut
 804
 805 sub freq_pretty {
 806   my $self = shift;
 807   my $freq = $self->freq;
 808
 809   #my $freqs_href = $self->freqs_href;
 810   my $freqs_href = freqs_href();
 811
 812   if ( exists($freqs_href->{$freq}) ) {
 813     $freqs_href->{$freq};
 814   } else {
 815     my $interval = 'month';
 816     if ( $freq =~ /^(\d+)([hdw])$/ ) {
 817       my %interval = ( 'h' => 'hour', 'd'=>'day', 'w'=>'week' );
 818       $interval = $interval{$2};
 819     }
 820     if ( $1 == 1 ) {
 821       "every $interval";
 822     } else {
 823       "every $freq ${interval}s";
 824     }
 825   }
 826 }
 827
 828 =item add_freq TIMESTAMP
 829
 830 Adds the frequency of this package to the provided timestamp and returns
 831 the resulting timestamp, or -1 if the frequency of this package could not be
 832 parsed (shouldn't happen).
 833
 834 =cut
 835
 836 sub add_freq {
 837   my( $self, $date ) = @_;
 838   my $freq = $self->freq;
 839
 840   #change this bit to use Date::Manip? CAREFUL with timezones (see
 841   # mailing list archive)
 842   my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($date) )[0,1,2,3,4,5];
 843
 844   if ( $self->freq =~ /^\d+$/ ) {
 845     $mon += $self->freq;
 846     until ( $mon < 12 ) { $mon -= 12; $year++; }
 847   } elsif ( $self->freq =~ /^(\d+)w$/ ) {
 848     my $weeks = $1;
 849     $mday += $weeks * 7;
 850   } elsif ( $self->freq =~ /^(\d+)d$/ ) {
 851     my $days = $1;
 852     $mday += $days;
 853   } elsif ( $self->freq =~ /^(\d+)h$/ ) {
 854     my $hours = $1;
 855     $hour += $hours;
 856   } else {
 857     return -1;
 858   }
 859
 860   timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
 861 }
 862
 863 =item plandata
 864
 865 For backwards compatibility, returns the plandata field as well as all options
 866 from FS::part_pkg_option.
 867
 868 =cut
 869
 870 sub plandata {
 871   my $self = shift;
 872   carp "plandata is deprecated";
 873   if ( @_ ) {
 874     $self->SUPER::plandata(@_);
 875   } else {
 876     my $plandata = $self->get('plandata');
 877     my %options = $self->options;
 878     $plandata .= join('', map { "$_=$options{$_}\n" } keys %options );
 879     $plandata;
 880   }
 881 }
 882
 883 =item part_pkg_option
 884
 885 Returns all options as FS::part_pkg_option objects (see
 886 L<FS::part_pkg_option>).
 887
 888 =cut
 889
 890 sub part_pkg_option {
 891   my $self = shift;
 892   qsearch('part_pkg_option', { 'pkgpart' => $self->pkgpart } );
 893 }
 894
 895 =item options
 896
 897 Returns a list of option names and values suitable for assigning to a hash.
 898
 899 =cut
 900
 901 sub options {
 902   my $self = shift;
 903   map { $_->optionname => $_->optionvalue } $self->part_pkg_option;
 904 }
 905
 906 =item option OPTIONNAME
 907
 908 Returns the option value for the given name, or the empty string.
 909
 910 =cut
 911
 912 sub option {
 913   my( $self, $opt, $ornull ) = @_;
 914   my $part_pkg_option =
 915     qsearchs('part_pkg_option', {
 916       pkgpart    => $self->pkgpart,
 917       optionname => $opt,
 918   } );
 919   return $part_pkg_option->optionvalue if $part_pkg_option;
 920   my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); }
 921                      split("\n", $self->get('plandata') );
 922   return $plandata{$opt} if exists $plandata{$opt};
 923   cluck "WARNING: (pkgpart ". $self->pkgpart. ") Package def option $opt ".
 924         "not found in options or plandata!\n"
 925     unless $ornull;
 926   '';
 927 }
 928
 929 =item bill_part_pkg_link
 930
 931 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
 932
 933 =cut
 934
 935 sub bill_part_pkg_link {
 936   shift->_part_pkg_link('bill', @_);
 937 }
 938
 939 =item svc_part_pkg_link
 940
 941 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
 942
 943 =cut
 944
 945 sub svc_part_pkg_link {
 946   shift->_part_pkg_link('svc', @_);
 947 }
 948
 949 sub _part_pkg_link {
 950   my( $self, $type ) = @_;
 951   qsearch({ table    => 'part_pkg_link',
 952             hashref  => { 'src_pkgpart' => $self->pkgpart,
 953                           'link_type'   => $type,
 954                         },
 955             order_by => "ORDER BY hidden",
 956          });
 957 }
 958
 959 sub self_and_bill_linked {
 960   shift->_self_and_linked('bill', @_);
 961 }
 962
 963 sub _self_and_linked {
 964   my( $self, $type, $hidden ) = @_;
 965   $hidden ||= '';
 966
 967   my @result = ();
 968   foreach ( ( $self, map { $_->dst_pkg->_self_and_linked($type, $_->hidden) }
 969                      $self->_part_pkg_link($type) ) )
 970   {
 971     $_->hidden($hidden) if $hidden;
 972     push @result, $_;
 973   }
 974
 975   (@result);
 976 }
 977
 978 =item part_pkg_taxoverride [ CLASS ]
 979
 980 Returns all associated FS::part_pkg_taxoverride objects (see
 981 L<FS::part_pkg_taxoverride>).  Limits the returned set to those
 982 of class CLASS if defined.  Class may be one of 'setup', 'recur',
 983 the empty string (default), or a usage class number (see L<FS::usage_class>).
 984 When a class is specified, the empty string class (default) is returned
 985 if no more specific values exist.
 986
 987 =cut
 988
 989 sub part_pkg_taxoverride {
 990   my $self = shift;
 991   my $class = shift;
 992
 993   my $hashref = { 'pkgpart' => $self->pkgpart };
 994   $hashref->{'usage_class'} = $class if defined($class);
 995   my @overrides = qsearch('part_pkg_taxoverride', $hashref );
 996
 997   unless ( scalar(@overrides) || !defined($class) || !$class ){
 998     $hashref->{'usage_class'} = '';
 999     @overrides = qsearch('part_pkg_taxoverride', $hashref );
1000   }
1001
1002   @overrides;
1003 }
1004
1005 =item has_taxproduct
1006
1007 Returns true if this package has any taxproduct associated with it.
1008
1009 =cut
1010
1011 sub has_taxproduct {
1012   my $self = shift;
1013
1014   $self->taxproductnum ||
1015   scalar( grep { $_ =~/^usage_taxproductnum_/ && $self->option($_) }
1016           keys %{ {$self->options} }
1017   )
1018
1019 }
1020
1021
1022 =item taxproduct [ CLASS ]
1023
1024 Returns the associated tax product for this package definition (see
1025 L<FS::part_pkg_taxproduct>).  CLASS may be one of 'setup', 'recur' or
1026 the usage classnum (see L<FS::usage_class>).  Returns the default
1027 tax product for this record if the more specific CLASS value does
1028 not exist.
1029
1030 =cut
1031
1032 sub taxproduct {
1033   my $self = shift;
1034   my $class = shift;
1035
1036   my $part_pkg_taxproduct;
1037
1038   my $taxproductnum = $self->taxproductnum;
1039   if ($class) {
1040     my $class_taxproductnum = $self->option("usage_taxproductnum_$class", 1);
1041     $taxproductnum = $class_taxproductnum
1042       if $class_taxproductnum
1043   }
1044
1045   $part_pkg_taxproduct =
1046     qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1047
1048   unless ($part_pkg_taxproduct || $taxproductnum eq $self->taxproductnum ) {
1049     $taxproductnum = $self->taxproductnum;
1050     $part_pkg_taxproduct =
1051       qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1052   }
1053
1054   $part_pkg_taxproduct;
1055 }
1056
1057 =item taxproduct_description [ CLASS ]
1058
1059 Returns the description of the associated tax product for this package
1060 definition (see L<FS::part_pkg_taxproduct>).
1061
1062 =cut
1063
1064 sub taxproduct_description {
1065   my $self = shift;
1066   my $part_pkg_taxproduct = $self->taxproduct(@_);
1067   $part_pkg_taxproduct ? $part_pkg_taxproduct->description : '';
1068 }
1069
1070 =item part_pkg_taxrate DATA_PROVIDER, GEOCODE, [ CLASS ]
1071
1072 Returns the package to taxrate m2m records for this package in the location
1073 specified by GEOCODE (see L<FS::part_pkg_taxrate>) and usage class CLASS.
1074 CLASS may be one of 'setup', 'recur', or one of the usage classes numbers
1075 (see L<FS::usage_class>).
1076
1077 =cut
1078
1079 sub _expand_cch_taxproductnum {
1080   my $self = shift;
1081   my $class = shift;
1082   my $part_pkg_taxproduct = $self->taxproduct($class);
1083
1084   my ($a,$b,$c,$d) = ( $part_pkg_taxproduct
1085                          ? ( split ':', $part_pkg_taxproduct->taxproduct )
1086                          : ()
1087                      );
1088   $a = '' unless $a; $b = '' unless $b; $c = '' unless $c; $d = '' unless $d;
1089   my $extra_sql = "AND ( taxproduct = '$a:$b:$c:$d'
1090                       OR taxproduct = '$a:$b:$c:'
1091                       OR taxproduct = '$a:$b:".":$d'
1092                       OR taxproduct = '$a:$b:".":' )";
1093   map { $_->taxproductnum } qsearch( { 'table'     => 'part_pkg_taxproduct',
1094                                        'hashref'   => { 'data_vendor'=>'cch' },
1095                                        'extra_sql' => $extra_sql,
1096                                    } );
1097
1098 }
1099
1100 sub part_pkg_taxrate {
1101   my $self = shift;
1102   my ($data_vendor, $geocode, $class) = @_;
1103
1104   my $dbh = dbh;
1105   my $extra_sql = 'WHERE part_pkg_taxproduct.data_vendor = '.
1106                   dbh->quote($data_vendor);
1107
1108   # CCH oddness in m2m
1109   $extra_sql .= ' AND ('.
1110     join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
1111                  qw(10 5 2)
1112         ).
1113     ')';
1114   # much more CCH oddness in m2m -- this is kludgy
1115   my @tpnums = $self->_expand_cch_taxproductnum($class);
1116   if (scalar(@tpnums)) {
1117     $extra_sql .= ' AND ('.
1118                             join(' OR ', map{ "taxproductnum = $_" } @tpnums ).
1119                        ')';
1120   } else {
1121     $extra_sql .= ' AND ( 0 = 1 )';
1122   }
1123
1124   my $addl_from = 'LEFT JOIN part_pkg_taxproduct USING ( taxproductnum )';
1125   my $order_by = 'ORDER BY taxclassnum, length(geocode) desc, length(taxproduct) desc';
1126   my $select   = 'DISTINCT ON(taxclassnum) *, taxproduct';
1127
1128   # should qsearch preface columns with the table to facilitate joins?
1129   qsearch( { 'table'     => 'part_pkg_taxrate',
1130              'select'    => $select,
1131              'hashref'   => { # 'data_vendor'   => $data_vendor,
1132                               # 'taxproductnum' => $self->taxproductnum,
1133                             },
1134              'addl_from' => $addl_from,
1135              'extra_sql' => $extra_sql,
1136              'order_by'  => $order_by,
1137          } );
1138 }
1139
1140 =item _rebless
1141
1142 Reblesses the object into the FS::part_pkg::PLAN class (if available), where
1143 PLAN is the object's I<plan> field.  There should be better docs
1144 on how to create new price plans, but until then, see L</NEW PLAN CLASSES>.
1145
1146 =cut
1147
1148 sub _rebless {
1149   my $self = shift;
1150   my $plan = $self->plan;
1151   unless ( $plan ) {
1152     cluck "no price plan found for pkgpart ". $self->pkgpart. "\n"
1153       if $DEBUG;
1154     return $self;
1155   }
1156   return $self if ref($self) =~ /::$plan$/; #already blessed into plan subclass
1157   my $class = ref($self). "::$plan";
1158   warn "reblessing $self into $class" if $DEBUG;
1159   eval "use $class;";
1160   die $@ if $@;
1161   bless($self, $class) unless $@;
1162   $self;
1163 }
1164
1165 #fallbacks that eval the setup and recur fields, for backwards compat
1166
1167 sub calc_setup {
1168   my $self = shift;
1169   warn 'no price plan class for '. $self->plan. ", eval-ing setup\n";
1170   $self->_calc_eval('setup', @_);
1171 }
1172
1173 sub calc_recur {
1174   my $self = shift;
1175   warn 'no price plan class for '. $self->plan. ", eval-ing recur\n";
1176   $self->_calc_eval('recur', @_);
1177 }
1178
1179 use vars qw( $sdate @details );
1180 sub _calc_eval {
1181   #my( $self, $field, $cust_pkg ) = @_;
1182   my( $self, $field, $cust_pkg, $sdateref, $detailsref ) = @_;
1183   *sdate = $sdateref;
1184   *details = $detailsref;
1185   $self->$field() =~ /^(.*)$/
1186     or die "Illegal $field (pkgpart ". $self->pkgpart. '): '.
1187             $self->$field(). "\n";
1188   my $prog = $1;
1189   return 0 if $prog =~ /^\s*$/;
1190   my $value = eval $prog;
1191   die $@ if $@;
1192   $value;
1193 }
1194
1195 #fallback that return 0 for old legacy packages with no plan
1196
1197 sub calc_remain { 0; }
1198 sub calc_cancel { 0; }
1199 sub calc_units  { 0; }
1200
1201 #fallback for everything except bulk.pm
1202 sub hide_svc_detail { 0; }
1203
1204 =item format OPTION DATA
1205
1206 Returns data formatted according to the function 'format' described
1207 in the plan info.  Returns DATA if no such function exists.
1208
1209 =cut
1210
1211 sub format {
1212   my ($self, $option, $data) = (shift, shift, shift);
1213   if (exists($plans{$self->plan}->{fields}->{$option}{format})) {
1214     &{$plans{$self->plan}->{fields}->{$option}{format}}($data);
1215   }else{
1216     $data;
1217   }
1218 }
1219
1220 =item parse OPTION DATA
1221
1222 Returns data parsed according to the function 'parse' described
1223 in the plan info.  Returns DATA if no such function exists.
1224
1225 =cut
1226
1227 sub parse {
1228   my ($self, $option, $data) = (shift, shift, shift);
1229   if (exists($plans{$self->plan}->{fields}->{$option}{parse})) {
1230     &{$plans{$self->plan}->{fields}->{$option}{parse}}($data);
1231   }else{
1232     $data;
1233   }
1234 }
1235
1236 =back
1237
1238 =cut
1239
1240 =head1 CLASS METHODS
1241
1242 =over 4
1243
1244 =cut
1245
1246 # _upgrade_data
1247 #
1248 # Used by FS::Upgrade to migrate to a new database.
1249
1250 sub _upgrade_data { # class method
1251   my($class, %opts) = @_;
1252
1253   warn "[FS::part_pkg] upgrading $class\n" if $DEBUG;
1254
1255   my @part_pkg = qsearch({
1256     'table'     => 'part_pkg',
1257     'extra_sql' => "WHERE ". join(' OR ',
1258                      ( map "($_ IS NOT NULL AND $_ != '' )",
1259                            qw( plandata setup recur ) ),
1260                      'plan IS NULL', "plan = '' ",
1261                    ),
1262   });
1263
1264   foreach my $part_pkg (@part_pkg) {
1265
1266     unless ( $part_pkg->plan ) {
1267       $part_pkg->plan('flat');
1268     }
1269
1270     if ( length($part_pkg->option('setup_fee')) == 0
1271          && $part_pkg->setup =~ /^\s*([\d\.]+)\s*$/ ) {
1272
1273       my $opt = new FS::part_pkg_option {
1274         'pkgpart'     => $part_pkg->pkgpart,
1275         'optionname'  => 'setup_fee',
1276         'optionvalue' => $1,
1277       };
1278       my $error = $opt->insert;
1279       die $error if $error;
1280
1281
1282       #} else {
1283       #  die "Can't parse part_pkg.setup for fee; convert pkgnum ".
1284       #      $part_pkg->pkgnum. " manually: ". $part_pkg->setup. "\n";
1285     }
1286     $part_pkg->setup('');
1287
1288     if ( length($part_pkg->option('recur_fee')) == 0
1289          && $part_pkg->recur =~ /^\s*([\d\.]+)\s*$/ ) {
1290
1291         my $opt = new FS::part_pkg_option {
1292           'pkgpart'     => $part_pkg->pkgpart,
1293           'optionname'  => 'recur_fee',
1294           'optionvalue' => $1,
1295         };
1296         my $error = $opt->insert;
1297         die $error if $error;
1298
1299
1300       #} else {
1301       #  die "Can't parse part_pkg.setup for fee; convert pkgnum ".
1302       #      $part_pkg->pkgnum. " manually: ". $part_pkg->setup. "\n";
1303     }
1304     $part_pkg->recur('');
1305
1306     $part_pkg->replace; #this should take care of plandata, right?
1307
1308   }
1309
1310   # now upgrade to the explicit custom flag
1311
1312   @part_pkg = qsearch({
1313     'table'     => 'part_pkg',
1314     'hashref'   => { disabled => 'Y', custom => '' },
1315     'extra_sql' => "AND comment LIKE '(CUSTOM) %'",
1316   });
1317
1318   foreach my $part_pkg (@part_pkg) {
1319     my $new = new FS::part_pkg { $part_pkg->hash };
1320     $new->custom('Y');
1321     my $comment = $part_pkg->comment;
1322     $comment =~ s/^\(CUSTOM\) //;
1323     $comment = '(none)' unless $comment =~ /\S/;
1324     $new->comment($comment);
1325
1326     my $pkg_svc = { map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc };
1327     my $primary = $part_pkg->svcpart;
1328     my $options = { $part_pkg->options };
1329
1330     my $error = $new->replace( $part_pkg,
1331                                'pkg_svc'     => $pkg_svc,
1332                                'primary_svc' => $primary,
1333                                'options'     => $options,
1334                              );
1335     die $error if $error;
1336   }
1337
1338 }
1339
1340 =item curuser_pkgs_sql
1341
1342 Returns an SQL fragment for searching for packages the current user can
1343 use, either via part_pkg.agentnum directly, or via agent type (see
1344 L<FS::type_pkgs>).
1345
1346 =cut
1347
1348 sub curuser_pkgs_sql {
1349   my $class = shift;
1350
1351   $class->_pkgs_sql( $FS::CurrentUser::CurrentUser->agentnums );
1352
1353 }
1354
1355 =item agent_pkgs_sql AGENT | AGENTNUM, ...
1356
1357 Returns an SQL fragment for searching for packages the provided agent or agents
1358 can use, either via part_pkg.agentnum directly, or via agent type (see
1359 L<FS::type_pkgs>).
1360
1361 =cut
1362
1363 sub agent_pkgs_sql {
1364   my $class = shift;  #i'm a class method, not a sub (the question is... why??)
1365   my @agentnums = map { ref($_) ? $_->agentnum : $_ } @_;
1366
1367   $class->_pkgs_sql(@agentnums); #is this why
1368
1369 }
1370
1371 sub _pkgs_sql {
1372   my( $class, @agentnums ) = @_;
1373   my $agentnums = join(',', @agentnums);
1374
1375   "
1376     (
1377       agentnum IS NOT NULL
1378       OR
1379       0 < ( SELECT COUNT(*)
1380               FROM type_pkgs
1381                 LEFT JOIN agent_type USING ( typenum )
1382                 LEFT JOIN agent AS typeagent USING ( typenum )
1383               WHERE type_pkgs.pkgpart = part_pkg.pkgpart
1384                 AND typeagent.agentnum IN ($agentnums)
1385           )
1386     )
1387   ";
1388
1389 }
1390
1391 =back
1392
1393 =head1 SUBROUTINES
1394
1395 =over 4
1396
1397 =item plan_info
1398
1399 =cut
1400
1401 #false laziness w/part_export & cdr
1402 my %info;
1403 foreach my $INC ( @INC ) {
1404   warn "globbing $INC/FS/part_pkg/*.pm\n" if $DEBUG;
1405   foreach my $file ( glob("$INC/FS/part_pkg/*.pm") ) {
1406     warn "attempting to load plan info from $file\n" if $DEBUG;
1407     $file =~ /\/(\w+)\.pm$/ or do {
1408       warn "unrecognized file in $INC/FS/part_pkg/: $file\n";
1409       next;
1410     };
1411     my $mod = $1;
1412     my $info = eval "use FS::part_pkg::$mod; ".
1413                     "\\%FS::part_pkg::$mod\::info;";
1414     if ( $@ ) {
1415       die "error using FS::part_pkg::$mod (skipping): $@\n" if $@;
1416       next;
1417     }
1418     unless ( keys %$info ) {
1419       warn "no %info hash found in FS::part_pkg::$mod, skipping\n";
1420       next;
1421     }
1422     warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG;
1423     if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
1424       warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG;
1425       next;
1426     }
1427     $info{$mod} = $info;
1428   }
1429 }
1430
1431 tie %plans, 'Tie::IxHash',
1432   map  { $_ => $info{$_} }
1433   sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} }
1434   keys %info;
1435
1436 sub plan_info {
1437   \%plans;
1438 }
1439
1440
1441 =back
1442
1443 =head1 NEW PLAN CLASSES
1444
1445 A module should be added in FS/FS/part_pkg/  Eventually, an example may be
1446 found in eg/plan_template.pm.  Until then, it is suggested that you use the
1447 other modules in FS/FS/part_pkg/ as a guide.
1448
1449 =head1 BUGS
1450
1451 The delete method is unimplemented.
1452
1453 setup and recur semantics are not yet defined (and are implemented in
1454 FS::cust_bill.  hmm.).  now they're deprecated and need to go.
1455
1456 plandata should go
1457
1458 part_pkg_taxrate is Pg specific
1459
1460 replace should be smarter about managing the related tables (options, pkg_svc)
1461
1462 =head1 SEE ALSO
1463
1464 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
1465 schema.html from the base documentation.
1466
1467 =cut
1468
1469 1;
1470