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