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