optimize Reports->Customers->List Customers, RT#20173
[freeside.git] / FS / FS / part_pkg.pm
1 package FS::part_pkg;
2 use base qw( FS::part_pkg::API
3              FS::m2m_Common FS::o2m_Common FS::option_Common
4            );
5
6 use strict;
7 use vars qw( %plans $DEBUG $setup_hack $skip_pkg_svc_hack
8              $cache_enabled %cache_link %cache_pkg_svc
9            );
10 use Carp qw(carp cluck confess);
11 use Scalar::Util qw( blessed );
12 use DateTime;
13 use Time::Local qw( timelocal timelocal_nocheck ); # eventually replace with DateTime
14 use Tie::IxHash;
15 use FS::Conf;
16 use FS::Record qw( qsearch qsearchs dbh dbdef );
17 use FS::Cursor; # for upgrade
18 use FS::pkg_svc;
19 use FS::part_svc;
20 use FS::cust_pkg;
21 use FS::agent_type;
22 use FS::type_pkgs;
23 use FS::part_pkg_option;
24 use FS::part_pkg_fcc_option;
25 use FS::pkg_class;
26 use FS::agent;
27 use FS::part_pkg_msgcat;
28 use FS::part_pkg_taxrate;
29 use FS::part_pkg_taxoverride;
30 use FS::part_pkg_taxproduct;
31 use FS::part_pkg_link;
32 use FS::part_pkg_discount;
33 use FS::part_pkg_vendor;
34 use FS::part_pkg_currency;
35 use FS::part_svc_link;
36
37 $DEBUG = 0;
38
39 $setup_hack = 0;
40 $skip_pkg_svc_hack = 0;
41
42 $cache_enabled = 0;
43 %cache_link = ();
44 %cache_pkg_svc = ();
45
46 =head1 NAME
47
48 FS::part_pkg - Object methods for part_pkg objects
49
50 =head1 SYNOPSIS
51
52   use FS::part_pkg;
53
54   $record = new FS::part_pkg \%hash
55   $record = new FS::part_pkg { 'column' => 'value' };
56
57   $custom_record = $template_record->clone;
58
59   $error = $record->insert;
60
61   $error = $new_record->replace($old_record);
62
63   $error = $record->delete;
64
65   $error = $record->check;
66
67   @pkg_svc = $record->pkg_svc;
68
69   $svcnum = $record->svcpart;
70   $svcnum = $record->svcpart( 'svc_acct' );
71
72 =head1 DESCRIPTION
73
74 An FS::part_pkg object represents a package definition.  FS::part_pkg
75 inherits from FS::Record.  The following fields are currently supported:
76
77 =over 4
78
79 =item pkgpart - primary key (assigned automatically for new package definitions)
80
81 =item pkg - Text name of this package definition (customer-viewable)
82
83 =item comment - Text name of this package definition (non-customer-viewable)
84
85 =item classnum - Optional package class (see L<FS::pkg_class>)
86
87 =item promo_code - Promotional code
88
89 =item setup - Setup fee expression (deprecated)
90
91 =item freq - Frequency of recurring fee
92
93 =item recur - Recurring fee expression (deprecated)
94
95 =item setuptax - Setup fee tax exempt flag, empty or `Y'
96
97 =item recurtax - Recurring fee tax exempt flag, empty or `Y'
98
99 =item taxclass - Tax class 
100
101 =item plan - Price plan
102
103 =item plandata - Price plan data (deprecated - see L<FS::part_pkg_option> instead)
104
105 =item disabled - Disabled flag, empty or `Y'
106
107 =item custom - Custom flag, empty or `Y'
108
109 =item setup_cost - for cost tracking
110
111 =item recur_cost - for cost tracking
112
113 =item pay_weight - Weight (relative to credit_weight and other package definitions) that controls payment application to specific line items.
114
115 =item credit_weight - Weight (relative to other package definitions) that controls credit application to specific line items.
116
117 =item agentnum - Optional agentnum (see L<FS::agent>)
118
119 =item fcc_ds0s - Optional DS0 equivalency number for FCC form 477
120
121 =item fcc_voip_class - Which column of FCC form 477 part II.B this package 
122 belongs in.
123
124 =item successor - Foreign key for the part_pkg that replaced this record.
125 If this record is not obsolete, will be null.
126
127 =item family_pkgpart - Foreign key for the part_pkg that was the earliest
128 ancestor of this record.  If this record is not a successor to another 
129 part_pkg, will be equal to pkgpart.
130
131 =item delay_start - Number of days to delay package start, by default
132
133 =item start_on_hold - 'Y' to suspend this package immediately when it is 
134 ordered. The package will not start billing or have a setup fee charged 
135 until it is manually unsuspended.
136
137 =item change_to_pkgpart - When this package is ordered, schedule a future 
138 package change. The 'expire_months' field will determine when the package
139 change occurs.
140
141 =item expire_months - Number of months until this package expires (or changes
142 to another package).
143
144 =item adjourn_months - Number of months until this package becomes suspended.
145
146 =item contract_end_months - Number of months until the package's contract 
147 ends.
148
149 =back
150
151 =head1 METHODS
152
153 =over 4 
154
155 =item new HASHREF
156
157 Creates a new package definition.  To add the package definition to
158 the database, see L<"insert">.
159
160 =cut
161
162 sub table { 'part_pkg'; }
163
164 =item clone
165
166 An alternate constructor.  Creates a new package definition by duplicating
167 an existing definition.  A new pkgpart is assigned and the custom flag is
168 set to Y.  To add the package definition to the database, see L<"insert">.
169
170 =cut
171
172 sub clone {
173   my $self = shift;
174   my $class = ref($self);
175   my %hash = $self->hash;
176   $hash{'pkgpart'} = '';
177   $hash{'custom'} = 'Y';
178   #new FS::part_pkg ( \%hash ); # ?
179   new $class ( \%hash ); # ?
180 }
181
182 =item insert [ , OPTION => VALUE ... ]
183
184 Adds this package definition to the database.  If there is an error,
185 returns the error, otherwise returns false.
186
187 Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg>, 
188 I<custnum_ref> and I<options>.
189
190 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
191 values, appropriate FS::pkg_svc records will be inserted.  I<hidden_svc> can 
192 be set to a hashref of svcparts and flag values ('Y' or '') to set the 
193 'hidden' field in these records, and I<provision_hold> can be set similarly
194 for the 'provision_hold' field in these records.
195
196 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
197 FS::pkg_svc record will be updated.
198
199 If I<cust_pkg> is set to a pkgnum of a FS::cust_pkg record (or the FS::cust_pkg
200 record itself), the object will be updated to point to this package definition.
201
202 In conjunction with I<cust_pkg>, if I<custnum_ref> is set to a scalar reference,
203 the scalar will be updated with the custnum value from the cust_pkg record.
204
205 If I<tax_overrides> is set to a hashref with usage classes as keys and comma
206 separated tax class numbers as values, appropriate FS::part_pkg_taxoverride
207 records will be inserted.
208
209 If I<options> is set to a hashref of options, appropriate FS::part_pkg_option
210 records will be inserted.
211
212 If I<part_pkg_currency> is set to a hashref of options (with the keys as
213 option_CURRENCY), appropriate FS::part_pkg::currency records will be inserted.
214
215 =cut
216
217 sub insert {
218   my $self = shift;
219   my %options = @_;
220   warn "FS::part_pkg::insert called on $self with options ".
221        join(', ', map "$_=>$options{$_}", keys %options)
222     if $DEBUG;
223
224   local $SIG{HUP} = 'IGNORE';
225   local $SIG{INT} = 'IGNORE';
226   local $SIG{QUIT} = 'IGNORE';
227   local $SIG{TERM} = 'IGNORE';
228   local $SIG{TSTP} = 'IGNORE';
229   local $SIG{PIPE} = 'IGNORE';
230
231   my $oldAutoCommit = $FS::UID::AutoCommit;
232   local $FS::UID::AutoCommit = 0;
233   my $dbh = dbh;
234
235   warn "  inserting part_pkg record" if $DEBUG;
236   my $error = $self->SUPER::insert( $options{options} );
237   if ( $error ) {
238     $dbh->rollback if $oldAutoCommit;
239     return $error;
240   }
241
242   # set family_pkgpart
243   if ( $self->get('family_pkgpart') eq '' ) {
244     $self->set('family_pkgpart' => $self->pkgpart);
245     $error = $self->SUPER::replace;
246     if ( $error ) {
247       $dbh->rollback if $oldAutoCommit;
248       return $error;
249     }
250   }
251
252   warn "  inserting part_pkg_taxoverride records" if $DEBUG;
253   my %overrides = %{ $options{'tax_overrides'} || {} };
254   foreach my $usage_class ( keys %overrides ) {
255     my $override =
256       ( exists($overrides{$usage_class}) && defined($overrides{$usage_class}) )
257         ? $overrides{$usage_class}
258         : '';
259     my @overrides = (grep "$_", split(',', $override) );
260     my $error = $self->process_m2m (
261                   'link_table'   => 'part_pkg_taxoverride',
262                   'target_table' => 'tax_class',
263                   'hashref'      => { 'usage_class' => $usage_class },
264                   'params'       => \@overrides,
265                 );
266     if ( $error ) {
267       $dbh->rollback if $oldAutoCommit;
268       return $error;
269     }
270   }
271
272   warn "  inserting part_pkg_currency records" if $DEBUG;
273   my %part_pkg_currency = %{ $options{'part_pkg_currency'} || {} };
274   foreach my $key ( keys %part_pkg_currency ) {
275     $key =~ /^(.+)_([A-Z]{3})$/ or next;
276     my( $optionname, $currency ) = ( $1, $2 );
277     if ( $part_pkg_currency{$key} =~ /^\s*$/ ) {
278       if ( $self->option($optionname) == 0 ) {
279         $part_pkg_currency{$key} = '0';
280       } else {
281         $dbh->rollback if $oldAutoCommit;
282         ( my $thing = $optionname ) =~ s/_/ /g;
283         return ucfirst($thing). " $currency is required";
284       }
285     }
286     my $part_pkg_currency = new FS::part_pkg_currency {
287       'pkgpart'     => $self->pkgpart,
288       'optionname'  => $optionname,
289       'currency'    => $currency,
290       'optionvalue' => $part_pkg_currency{$key},
291     };
292     my $error = $part_pkg_currency->insert;
293     if ( $error ) {
294       $dbh->rollback if $oldAutoCommit;
295       return $error;
296     }
297   }
298
299   unless ( $skip_pkg_svc_hack ) {
300
301     warn "  inserting pkg_svc records" if $DEBUG;
302     my $pkg_svc = $options{'pkg_svc'} || {};
303     my $hidden_svc = $options{'hidden_svc'} || {};
304     my $provision_hold = $options{'provision_hold'} || {};
305     foreach my $part_svc ( qsearch('part_svc', {} ) ) {
306       my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
307       my $primary_svc =
308         ( $options{'primary_svc'} && $options{'primary_svc'}==$part_svc->svcpart )
309           ? 'Y'
310           : '';
311
312       my $pkg_svc = new FS::pkg_svc( {
313         'pkgpart'     => $self->pkgpart,
314         'svcpart'     => $part_svc->svcpart,
315         'quantity'    => $quantity, 
316         'primary_svc' => $primary_svc,
317         'hidden'      => $hidden_svc->{$part_svc->svcpart},
318         'provision_hold' => $provision_hold->{$part_svc->svcpart},
319       } );
320       my $error = $pkg_svc->insert;
321       if ( $error ) {
322         $dbh->rollback if $oldAutoCommit;
323         return $error;
324       }
325     }
326
327     my $error = $self->check_pkg_svc(%options);
328     if ( $error ) {
329       $dbh->rollback if $oldAutoCommit;
330       return $error;
331     }
332
333   }
334
335   if ( $options{'cust_pkg'} ) {
336     warn "  updating cust_pkg record " if $DEBUG;
337     my $old_cust_pkg =
338       ref($options{'cust_pkg'})
339         ? $options{'cust_pkg'}
340         : qsearchs('cust_pkg', { pkgnum => $options{'cust_pkg'} } );
341     ${ $options{'custnum_ref'} } = $old_cust_pkg->custnum
342       if $options{'custnum_ref'};
343     my %hash = $old_cust_pkg->hash;
344     $hash{'pkgpart'} = $self->pkgpart,
345     my $new_cust_pkg = new FS::cust_pkg \%hash;
346     local($FS::cust_pkg::disable_agentcheck) = 1;
347     my $error = $new_cust_pkg->replace($old_cust_pkg);
348     if ( $error ) {
349       $dbh->rollback if $oldAutoCommit;
350       return "Error modifying cust_pkg record: $error";
351     }
352   }
353
354   if ( $options{'part_pkg_vendor'} ) {
355       while ( my ($exportnum, $vendor_pkg_id) =
356                 each %{ $options{part_pkg_vendor} }
357             )
358       {
359             my $ppv = new FS::part_pkg_vendor( {
360                     'pkgpart' => $self->pkgpart,
361                     'exportnum' => $exportnum,
362                     'vendor_pkg_id' => $vendor_pkg_id, 
363                 } );
364             my $error = $ppv->insert;
365             if ( $error ) {
366               $dbh->rollback if $oldAutoCommit;
367               return "Error inserting part_pkg_vendor record: $error";
368             }
369       }
370   }
371
372   if ( $options{fcc_options} ) {
373     warn "  updating fcc options " if $DEBUG;
374     $self->set_fcc_options( $options{fcc_options} );
375   }
376
377   warn "  committing transaction" if $DEBUG and $oldAutoCommit;
378   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
379
380   '';
381 }
382
383 =item delete
384
385 Currently unimplemented.
386
387 =cut
388
389 sub delete {
390   return "Can't (yet?) delete package definitions.";
391 # check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
392 }
393
394 =item replace OLD_RECORD [ , OPTION => VALUE ... ]
395
396 Replaces OLD_RECORD with this one in the database.  If there is an error,
397 returns the error, otherwise returns false.
398
399 Currently available options are: I<pkg_svc>, I<hidden_svc>, I<primary_svc>,
400 I<bulk_skip>, I<provision_hold> and I<options>
401
402 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
403 values, the appropriate FS::pkg_svc records will be replaced.  I<hidden_svc>
404 can be set to a hashref of svcparts and flag values ('Y' or '') to set the 
405 'hidden' field in these records.  I<bulk_skip> and I<provision_hold> can be set 
406 to a hashref of svcparts and flag values ('Y' or '') to set the respective field 
407 in those records.
408
409 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
410 FS::pkg_svc record will be updated.
411
412 If I<options> is set to a hashref, the appropriate FS::part_pkg_option records
413 will be replaced.
414
415 If I<part_pkg_currency> is set to a hashref of options (with the keys as
416 option_CURRENCY), appropriate FS::part_pkg::currency records will be replaced.
417
418 =cut
419
420 sub replace {
421   my $new = shift;
422
423   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
424               ? shift
425               : $new->replace_old;
426
427   my $options = 
428     ( ref($_[0]) eq 'HASH' )
429       ? shift
430       : { @_ };
431
432   $options->{options} = { $old->options } unless defined($options->{options});
433
434   warn "FS::part_pkg::replace called on $new to replace $old with options".
435        join(', ', map "$_ => ". $options->{$_}, keys %$options)
436     if $DEBUG;
437
438   local $SIG{HUP} = 'IGNORE';
439   local $SIG{INT} = 'IGNORE';
440   local $SIG{QUIT} = 'IGNORE';
441   local $SIG{TERM} = 'IGNORE';
442   local $SIG{TSTP} = 'IGNORE';
443   local $SIG{PIPE} = 'IGNORE';
444
445   my $oldAutoCommit = $FS::UID::AutoCommit;
446   local $FS::UID::AutoCommit = 0;
447   my $dbh = dbh;
448   
449   my $conf = new FS::Conf;
450   if ( $conf->exists('part_pkg-lineage') ) {
451     if ( grep { $options->{options}->{$_} ne $old->option($_, 1) }
452           qw(setup_fee recur_fee) #others? config?
453         ) { 
454     
455       warn "  superseding package" if $DEBUG;
456
457       my $error = $new->supersede($old, %$options);
458       if ( $error ) {
459         $dbh->rollback if $oldAutoCommit;
460         return $error;
461       }
462       else {
463         warn "  committing transaction" if $DEBUG and $oldAutoCommit;
464         $dbh->commit if $oldAutoCommit;
465         return $error;
466       }
467     }
468     #else nothing
469   }
470
471   #plandata shit stays in replace for upgrades until after 2.0 (or edit
472   #_upgrade_data)
473   warn "  saving legacy plandata" if $DEBUG;
474   my $plandata = $new->get('plandata');
475   $new->set('plandata', '');
476
477   warn "  deleting old part_pkg_option records" if $DEBUG;
478   foreach my $part_pkg_option ( $old->part_pkg_option ) {
479     my $error = $part_pkg_option->delete;
480     if ( $error ) {
481       $dbh->rollback if $oldAutoCommit;
482       return $error;
483     }
484   }
485
486   warn "  replacing part_pkg record" if $DEBUG;
487   my $error = $new->SUPER::replace($old, $options->{options} );
488   if ( $error ) {
489     $dbh->rollback if $oldAutoCommit;
490     return $error;
491   }
492
493   warn "  inserting part_pkg_option records for plandata: $plandata|" if $DEBUG;
494   foreach my $part_pkg_option ( 
495     map { /^(\w+)=(.*)$/ or do { $dbh->rollback if $oldAutoCommit;
496                                  return "illegal plandata: $plandata";
497                                };
498           new FS::part_pkg_option {
499             'pkgpart'     => $new->pkgpart,
500             'optionname'  => $1,
501             'optionvalue' => $2,
502           };
503         }
504     split("\n", $plandata)
505   ) {
506     my $error = $part_pkg_option->insert;
507     if ( $error ) {
508       $dbh->rollback if $oldAutoCommit;
509       return $error;
510     }
511   }
512
513   #trivial nit: not the most efficient to delete and reinsert
514   warn "  deleting old part_pkg_currency records" if $DEBUG;
515   foreach my $part_pkg_currency ( $old->part_pkg_currency ) {
516     my $error = $part_pkg_currency->delete;
517     if ( $error ) {
518       $dbh->rollback if $oldAutoCommit;
519       return "error deleting part_pkg_currency record: $error";
520     }
521   }
522
523   warn "  inserting new part_pkg_currency records" if $DEBUG;
524   my %part_pkg_currency = %{ $options->{'part_pkg_currency'} || {} };
525   foreach my $key ( keys %part_pkg_currency ) {
526     $key =~ /^(.+)_([A-Z]{3})$/ or next;
527     my $part_pkg_currency = new FS::part_pkg_currency {
528       'pkgpart'     => $new->pkgpart,
529       'optionname'  => $1,
530       'currency'    => $2,
531       'optionvalue' => $part_pkg_currency{$key},
532     };
533     my $error = $part_pkg_currency->insert;
534     if ( $error ) {
535       $dbh->rollback if $oldAutoCommit;
536       return "error inserting part_pkg_currency record: $error";
537     }
538   }
539
540
541   warn "  replacing pkg_svc records" if $DEBUG;
542   my $pkg_svc = $options->{'pkg_svc'};
543   my $hidden_svc = $options->{'hidden_svc'} || {};
544   my $bulk_skip  = $options->{'bulk_skip'} || {};
545   my $provision_hold = $options->{'provision_hold'} || {};
546   if ( $pkg_svc ) { # if it wasn't passed, don't change existing pkg_svcs
547
548     foreach my $part_svc ( qsearch('part_svc', {} ) ) {
549       my $quantity  = $pkg_svc->{$part_svc->svcpart} || 0;
550       my $hidden    = $hidden_svc->{$part_svc->svcpart} || '';
551       my $bulk_skip = $bulk_skip->{$part_svc->svcpart} || '';
552       my $provision_hold = $provision_hold->{$part_svc->svcpart} || '';
553       my $primary_svc =
554         ( defined($options->{'primary_svc'}) && $options->{'primary_svc'}
555           && $options->{'primary_svc'} == $part_svc->svcpart
556         )
557           ? 'Y'
558           : '';
559
560       my $old_pkg_svc = qsearchs('pkg_svc', {
561           'pkgpart' => $old->pkgpart,
562           'svcpart' => $part_svc->svcpart,
563         }
564       );
565       my $old_quantity = 0;
566       my $old_primary_svc = '';
567       my $old_hidden = '';
568       my $old_bulk_skip = '';
569       my $old_provision_hold = '';
570       if ( $old_pkg_svc ) {
571         $old_quantity = $old_pkg_svc->quantity;
572         $old_primary_svc = $old_pkg_svc->primary_svc 
573           if $old_pkg_svc->dbdef_table->column('primary_svc'); # is this needed?
574         $old_hidden = $old_pkg_svc->hidden;
575         $old_bulk_skip = $old_pkg_svc->old_bulk_skip; # should this just be bulk_skip?
576         $old_provision_hold = $old_pkg_svc->provision_hold;
577       }
578    
579       next unless $old_quantity    != $quantity
580                || $old_primary_svc ne $primary_svc
581                || $old_hidden      ne $hidden
582                || $old_bulk_skip   ne $bulk_skip
583                || $old_provision_hold ne $provision_hold;
584     
585       my $new_pkg_svc = new FS::pkg_svc( {
586         'pkgsvcnum'   => ( $old_pkg_svc ? $old_pkg_svc->pkgsvcnum : '' ),
587         'pkgpart'     => $new->pkgpart,
588         'svcpart'     => $part_svc->svcpart,
589         'quantity'    => $quantity, 
590         'primary_svc' => $primary_svc,
591         'hidden'      => $hidden,
592         'bulk_skip'   => $bulk_skip,
593         'provision_hold' => $provision_hold,
594       } );
595       my $error = $old_pkg_svc
596                     ? $new_pkg_svc->replace($old_pkg_svc)
597                     : $new_pkg_svc->insert;
598       if ( $error ) {
599         $dbh->rollback if $oldAutoCommit;
600         return $error;
601       }
602     } #foreach $part_svc
603
604     my $error = $new->check_pkg_svc(%$options);
605     if ( $error ) {
606       $dbh->rollback if $oldAutoCommit;
607       return $error;
608     }
609
610   } #if $options->{pkg_svc}
611   
612   my @part_pkg_vendor = $old->part_pkg_vendor;
613   my @current_exportnum = ();
614   if ( $options->{'part_pkg_vendor'} ) {
615       my($exportnum,$vendor_pkg_id);
616       while ( ($exportnum,$vendor_pkg_id) 
617                                 = each %{$options->{'part_pkg_vendor'}} ) {
618           my $noinsert = 0;
619           foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
620             if($exportnum == $part_pkg_vendor->exportnum
621                 && $vendor_pkg_id ne $part_pkg_vendor->vendor_pkg_id) {
622                 $part_pkg_vendor->vendor_pkg_id($vendor_pkg_id);
623                 my $error = $part_pkg_vendor->replace;
624                 if ( $error ) {
625                   $dbh->rollback if $oldAutoCommit;
626                   return "Error replacing part_pkg_vendor record: $error";
627                 }
628                 $noinsert = 1;
629                 last;
630             }
631             elsif($exportnum == $part_pkg_vendor->exportnum
632                 && $vendor_pkg_id eq $part_pkg_vendor->vendor_pkg_id) {
633                 $noinsert = 1;
634                 last;
635             }
636           }
637           unless ( $noinsert ) {
638             my $ppv = new FS::part_pkg_vendor( {
639                     'pkgpart' => $new->pkgpart,
640                     'exportnum' => $exportnum,
641                     'vendor_pkg_id' => $vendor_pkg_id, 
642                 } );
643             my $error = $ppv->insert;
644             if ( $error ) {
645               $dbh->rollback if $oldAutoCommit;
646               return "Error inserting part_pkg_vendor record: $error";
647             }
648           }
649           push @current_exportnum, $exportnum;
650       }
651   }
652   foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
653       unless ( grep($_ eq $part_pkg_vendor->exportnum, @current_exportnum) ) {
654         my $error = $part_pkg_vendor->delete;
655         if ( $error ) {
656           $dbh->rollback if $oldAutoCommit;
657           return "Error deleting part_pkg_vendor record: $error";
658         }
659       }
660   }
661   
662   # propagate changes to certain core fields
663   if ( $conf->exists('part_pkg-lineage') ) {
664     warn "  propagating changes to family" if $DEBUG;
665     my $error = $new->propagate($old);
666     if ( $error ) {
667       $dbh->rollback if $oldAutoCommit;
668       return $error;
669     }
670   }
671
672   if ( $options->{fcc_options} ) {
673     warn "  updating fcc options " if $DEBUG;
674     $new->set_fcc_options( $options->{fcc_options} );
675   }
676
677   warn "  committing transaction" if $DEBUG and $oldAutoCommit;
678   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
679   '';
680 }
681
682 =item check
683
684 Checks all fields to make sure this is a valid package definition.  If
685 there is an error, returns the error, otherwise returns false.  Called by the
686 insert and replace methods.
687
688 =cut
689
690 sub check {
691   my $self = shift;
692   warn "FS::part_pkg::check called on $self" if $DEBUG;
693
694   for (qw(setup recur plandata)) {
695     #$self->set($_=>0) if $self->get($_) =~ /^\s*$/; }
696     return "Use of $_ field is deprecated; set a plan and options: ".
697            $self->get($_)
698       if length($self->get($_));
699     $self->set($_, '');
700   }
701
702   if ( $self->dbdef_table->column('freq')->type =~ /(int)/i ) {
703     my $error = $self->ut_number('freq');
704     return $error if $error;
705   } else {
706     $self->freq =~ /^(\d+[hdw]?)$/
707       or return "Illegal or empty freq: ". $self->freq;
708     $self->freq($1);
709   }
710
711   my @null_agentnum_right = ( 'Edit global package definitions' );
712   push @null_agentnum_right, 'One-time charge'
713     if $self->freq =~ /^0/;
714   push @null_agentnum_right, 'Customize customer package'
715     if $self->disabled eq 'Y'; #good enough
716
717   my $error = $self->ut_numbern('pkgpart')
718     || $self->ut_text('pkg')
719     || $self->ut_textn('comment')
720     || $self->ut_textn('promo_code')
721     || $self->ut_alphan('plan')
722     || $self->ut_flag('setuptax')
723     || $self->ut_flag('recurtax')
724     || $self->ut_textn('taxclass')
725     || $self->ut_flag('disabled')
726     || $self->ut_flag('custom')
727     || $self->ut_flag('no_auto')
728     || $self->ut_flag('recur_show_zero')
729     || $self->ut_flag('setup_show_zero')
730     || $self->ut_flag('start_on_hold')
731     #|| $self->ut_moneyn('setup_cost')
732     #|| $self->ut_moneyn('recur_cost')
733     || $self->ut_floatn('setup_cost')
734     || $self->ut_floatn('recur_cost')
735     || $self->ut_floatn('pay_weight')
736     || $self->ut_floatn('credit_weight')
737     || $self->ut_numbern('taxproductnum')
738     || $self->ut_foreign_keyn('classnum',       'pkg_class', 'classnum')
739     || $self->ut_foreign_keyn('addon_classnum', 'pkg_class', 'classnum')
740     || $self->ut_foreign_keyn('taxproductnum',
741                               'part_pkg_taxproduct',
742                               'taxproductnum'
743                              )
744     || ( $setup_hack
745            ? $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum' )
746            : $self->ut_agentnum_acl('agentnum', \@null_agentnum_right)
747        )
748     || $self->ut_numbern('fcc_ds0s')
749     || $self->ut_numbern('fcc_voip_class')
750     || $self->ut_numbern('delay_start')
751     || $self->ut_foreign_keyn('successor', 'part_pkg', 'pkgpart')
752     || $self->ut_foreign_keyn('family_pkgpart', 'part_pkg', 'pkgpart')
753     || $self->ut_numbern('expire_months')
754     || $self->ut_numbern('adjourn_months')
755     || $self->ut_numbern('contract_end_months')
756     || $self->ut_numbern('change_to_pkgpart')
757     || $self->ut_foreign_keyn('change_to_pkgpart', 'part_pkg', 'pkgpart')
758     || $self->ut_alphan('agent_pkgpartid')
759     || $self->SUPER::check
760   ;
761   return $error if $error;
762
763   return 'Unknown plan '. $self->plan
764     unless exists($plans{$self->plan});
765
766   my $conf = new FS::Conf;
767   return 'Taxclass is required'
768     if ! $self->taxclass && $conf->exists('require_taxclasses');
769
770   '';
771 }
772
773 =item check_pkg_svc
774
775 Checks pkg_svc records as a whole (for part_svc_link dependencies).
776
777 If there is an error, returns the error, otherwise returns false.
778
779 =cut
780
781 sub check_pkg_svc {
782   my( $self, %opt ) = @_;
783
784   my $agentnum = $self->agentnum;
785
786   my %pkg_svc = map { $_->svcpart => $_ } $self->pkg_svc;
787
788   foreach my $svcpart ( keys %pkg_svc ) {
789
790     foreach my $part_svc_link ( $self->part_svc_link(
791                                   'src_svcpart' => $svcpart,
792                                   'link_type'   => 'part_pkg_restrict',
793                                 )
794     ) {
795
796       return $part_svc_link->dst_svc. ' must be included with '.
797              $part_svc_link->src_svc
798         unless $pkg_svc{ $part_svc_link->dst_svcpart };
799     }
800
801   }
802
803   return '' if $opt{part_pkg_restrict_soft_override};
804
805   foreach my $svcpart ( keys %pkg_svc ) {
806
807     foreach my $part_svc_link ( $self->part_svc_link(
808                                   'src_svcpart' => $svcpart,
809                                   'link_type'   => 'part_pkg_restrict_soft',
810                                 )
811     ) {
812       return $part_svc_link->dst_svc. ' is suggested with '.
813              $part_svc_link->src_svc
814         unless $pkg_svc{ $part_svc_link->dst_svcpart };
815     }
816
817   }
818
819   '';
820 }
821
822 =item part_svc_link OPTION => VALUE ...
823
824 Returns the service dependencies (see L<FS::part_svc_link>) for the given
825 search options, taking into account this package definition's agent.
826
827 Available options are any field in part_svc_link.  Typically used options are
828 src_svcpart and link_type.
829
830 =cut
831
832 sub part_svc_link {
833   FS::part_svc_link->by_agentnum( shift->agentnum, @_ );
834 }
835
836 =item supersede OLD [, OPTION => VALUE ... ]
837
838 Inserts this package as a successor to the package OLD.  All options are as
839 for C<insert>.  After inserting, disables OLD and sets the new package as its
840 successor.
841
842 =cut
843
844 sub supersede {
845   my ($new, $old, %options) = @_;
846   my $error;
847
848   $new->set('pkgpart' => '');
849   $new->set('family_pkgpart' => $old->family_pkgpart);
850   warn "    inserting successor package\n" if $DEBUG;
851   $error = $new->insert(%options);
852   return $error if $error;
853  
854   warn "    disabling superseded package\n" if $DEBUG; 
855   $old->set('successor' => $new->pkgpart);
856   $old->set('disabled' => 'Y');
857   $error = $old->SUPER::replace; # don't change its options/pkg_svc records
858   return $error if $error;
859
860   warn "  propagating changes to family" if $DEBUG;
861   $new->propagate($old);
862 }
863
864 =item propagate OLD
865
866 If any of certain fields have changed from OLD to this package, then,
867 for all packages in the same lineage as this one, sets those fields 
868 to their values in this package.
869
870 =cut
871
872 my @propagate_fields = (
873   qw( pkg classnum setup_cost recur_cost taxclass
874   setuptax recurtax pay_weight credit_weight
875   )
876 );
877
878 sub propagate {
879   my $new = shift;
880   my $old = shift;
881   my %fields = (
882     map { $_ => $new->get($_) }
883     grep { $new->get($_) ne $old->get($_) }
884     @propagate_fields
885   );
886
887   my @part_pkg = qsearch('part_pkg', { 
888       'family_pkgpart' => $new->family_pkgpart 
889   });
890   my @error;
891   foreach my $part_pkg ( @part_pkg ) {
892     my $pkgpart = $part_pkg->pkgpart;
893     next if $pkgpart == $new->pkgpart; # don't modify $new
894     warn "    propagating to pkgpart $pkgpart\n" if $DEBUG;
895     foreach ( keys %fields ) {
896       $part_pkg->set($_, $fields{$_});
897     }
898     # SUPER::replace to avoid changing non-core fields
899     my $error = $part_pkg->SUPER::replace;
900     push @error, "pkgpart $pkgpart: $error"
901       if $error;
902   }
903   join("\n", @error);
904 }
905
906 =item set_fcc_options HASHREF
907
908 Sets the FCC options on this package definition to the values specified
909 in HASHREF.
910
911 =cut
912
913 sub set_fcc_options {
914   my $self = shift;
915   my $pkgpart = $self->pkgpart;
916   my $options;
917   if (ref $_[0]) {
918     $options = shift;
919   } else {
920     $options = { @_ };
921   }
922
923   my %existing_num = map { $_->fccoptionname => $_->num }
924                      qsearch('part_pkg_fcc_option', { pkgpart => $pkgpart });
925
926   local $FS::Record::nowarn_identical = 1;
927   # set up params for process_o2m
928   my $i = 0;
929   my $params = {};
930   foreach my $name (keys %$options ) {
931     $params->{ "num$i" } = $existing_num{$name} || '';
932     $params->{ "num$i".'_fccoptionname' } = $name;
933     $params->{ "num$i".'_optionvalue'   } = $options->{$name};
934     $i++;
935   }
936
937   $self->process_o2m(
938     table   => 'part_pkg_fcc_option',
939     fields  => [qw( fccoptionname optionvalue )],
940     params  => $params,
941   );
942 }
943
944 =item pkg_locale LOCALE
945
946 Returns a customer-viewable string representing this package for the given
947 locale, from the part_pkg_msgcat table.  If the given locale is empty or no
948 localized string is found, returns the base pkg field.
949
950 =cut
951
952 sub pkg_locale {
953   my( $self, $locale ) = @_;
954   return $self->pkg unless $locale;
955   my $part_pkg_msgcat = $self->part_pkg_msgcat($locale) or return $self->pkg;
956   $part_pkg_msgcat->pkg;
957 }
958
959 =item part_pkg_msgcat LOCALE
960
961 Like pkg_locale, but returns the FS::part_pkg_msgcat object itself.
962
963 =cut
964
965 sub part_pkg_msgcat {
966   my( $self, $locale ) = @_;
967   qsearchs( 'part_pkg_msgcat', {
968     pkgpart => $self->pkgpart,
969     locale  => $locale,
970   });
971 }
972
973 =item pkg_comment [ OPTION => VALUE... ]
974
975 Returns an (internal) string representing this package.  Currently,
976 "pkgpart: pkg - comment", is returned.  "pkg - comment" may be returned in the
977 future, omitting pkgpart.  The comment will have '(CUSTOM) ' prepended if
978 custom is Y.
979
980 If the option nopkgpart is true then the "pkgpart: ' is omitted.
981
982 =cut
983
984 sub pkg_comment {
985   my $self = shift;
986   my %opt = @_;
987
988   #$self->pkg. ' - '. $self->comment;
989   #$self->pkg. ' ('. $self->comment. ')';
990   my $pre = $opt{nopkgpart} ? '' : $self->pkgpart. ': ';
991   my $custom_comment = $self->custom_comment(%opt);
992   $pre. $self->pkg. ( $custom_comment ? " - $custom_comment" : '' );
993 }
994
995 #without price info (so without hitting the DB again)
996 sub pkg_comment_only {
997   my $self = shift;
998   my %opt = @_;
999
1000   my $pre = $opt{nopkgpart} ? '' : $self->pkgpart. ': ';
1001   my $comment = $self->comment;
1002   $pre. $self->pkg. ( $comment ? " - $comment" : '' );
1003 }
1004
1005 sub price_info { # safety, in case a part_pkg hasn't defined price_info
1006     '';
1007 }
1008
1009 sub custom_comment {
1010   my $self = shift;
1011   my $price_info = $self->price_info(@_);
1012   ( $self->custom ? '(CUSTOM) ' : '' ).
1013     $self->comment.
1014     ( ($self->custom || $self->comment) ? ' - ' : '' ).
1015     ($price_info || 'No charge');
1016 }
1017
1018 sub pkg_price_info {
1019   my $self = shift;
1020   $self->pkg. ' - '. ($self->price_info || 'No charge');
1021 }
1022
1023 =item pkg_class
1024
1025 Returns the package class, as an FS::pkg_class object, or the empty string
1026 if there is no package class.
1027
1028 =item addon_pkg_class
1029
1030 Returns the add-on package class, as an FS::pkg_class object, or the empty
1031 string if there is no add-on package class.
1032
1033 =cut
1034
1035 sub addon_pkg_class {
1036   my $self = shift;
1037   if ( $self->addon_classnum ) {
1038     qsearchs('pkg_class', { 'classnum' => $self->addon_classnum } );
1039   } else {
1040     return '';
1041   }
1042 }
1043
1044 =item categoryname 
1045
1046 Returns the package category name, or the empty string if there is no package
1047 category.
1048
1049 =cut
1050
1051 sub categoryname {
1052   my $self = shift;
1053   my $pkg_class = $self->pkg_class;
1054   $pkg_class
1055     ? $pkg_class->categoryname
1056     : '';
1057 }
1058
1059 =item classname 
1060
1061 Returns the package class name, or the empty string if there is no package
1062 class.
1063
1064 =cut
1065
1066 sub classname {
1067   my $self = shift;
1068   my $pkg_class = $self->pkg_class;
1069   $pkg_class
1070     ? $pkg_class->classname
1071     : '';
1072 }
1073
1074 =item addon_classname 
1075
1076 Returns the add-on package class name, or the empty string if there is no
1077 add-on package class.
1078
1079 =cut
1080
1081 sub addon_classname {
1082   my $self = shift;
1083   my $pkg_class = $self->addon_pkg_class;
1084   $pkg_class
1085     ? $pkg_class->classname
1086     : '';
1087 }
1088
1089 =item agent 
1090
1091 Returns the associated agent for this event, if any, as an FS::agent object.
1092
1093 =item pkg_svc [ HASHREF | OPTION => VALUE ]
1094
1095 Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
1096 definition (with non-zero quantity).
1097
1098 One option is available, I<disable_linked>.  If set true it will return the
1099 services for this package definition alone, omitting services from any add-on
1100 packages.
1101
1102 =cut
1103
1104 =item type_pkgs
1105
1106 Returns all FS::type_pkgs objects (see L<FS::type_pkgs>) for this package
1107 definition.
1108
1109 =cut
1110
1111 sub pkg_svc {
1112   my $self = shift;
1113
1114   return @{ $cache_pkg_svc{$self->pkgpart} }
1115     if $cache_enabled && $cache_pkg_svc{$self->pkgpart};
1116
1117 #  #sort { $b->primary cmp $a->primary } 
1118 #    grep { $_->quantity }
1119 #      qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
1120
1121   my $opt = ref($_[0]) ? $_[0] : { @_ };
1122   my %pkg_svc = map  { $_->svcpart => $_ }
1123                 grep { $_->quantity }
1124                 qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
1125
1126   unless ( $opt->{disable_linked} ) {
1127     foreach my $dst_pkg ( map $_->dst_pkg, $self->svc_part_pkg_link ) {
1128       my @pkg_svc = grep { $_->quantity }
1129                     qsearch( 'pkg_svc', { pkgpart=>$dst_pkg->pkgpart } );
1130       foreach my $pkg_svc ( @pkg_svc ) {
1131         if ( $pkg_svc{$pkg_svc->svcpart} ) {
1132           my $quantity = $pkg_svc{$pkg_svc->svcpart}->quantity;
1133           $pkg_svc{$pkg_svc->svcpart}->quantity($quantity + $pkg_svc->quantity);
1134         } else {
1135           $pkg_svc{$pkg_svc->svcpart} = $pkg_svc;
1136         }
1137       }
1138     }
1139   }
1140
1141   my @pkg_svc = values(%pkg_svc);
1142
1143   $cache_pkg_svc{$self->pkgpart} = \@pkg_svc if $cache_enabled;
1144
1145   @pkg_svc;
1146
1147 }
1148
1149 =item svcpart [ SVCDB ]
1150
1151 Returns the svcpart of the primary service definition (see L<FS::part_svc>)
1152 associated with this package definition (see L<FS::pkg_svc>).  Returns
1153 false if there not a primary service definition or exactly one service
1154 definition with quantity 1, or if SVCDB is specified and does not match the
1155 svcdb of the service definition.  SVCDB can be specified as a scalar table
1156 name, such as 'svc_acct', or as an arrayref of possible table names.
1157
1158 =cut
1159
1160 sub svcpart {
1161   my $pkg_svc = shift->_primary_pkg_svc(@_);
1162   $pkg_svc ? $pkg_svc->svcpart : '';
1163 }
1164
1165 =item part_svc [ SVCDB ]
1166
1167 Like the B<svcpart> method, but returns the FS::part_svc object (see
1168 L<FS::part_svc>).
1169
1170 =cut
1171
1172 sub part_svc {
1173   my $pkg_svc = shift->_primary_pkg_svc(@_);
1174   $pkg_svc ? $pkg_svc->part_svc : '';
1175 }
1176
1177 sub _primary_pkg_svc {
1178   my $self = shift;
1179
1180   my $svcdb = scalar(@_) ? shift : [];
1181   $svcdb = ref($svcdb) ? $svcdb : [ $svcdb ];
1182   my %svcdb = map { $_=>1 } @$svcdb;
1183
1184   my @svcdb_pkg_svc =
1185     grep { !scalar(@$svcdb) || $svcdb{ $_->part_svc->svcdb } }
1186          $self->pkg_svc;
1187
1188   my @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc;
1189   @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc
1190     unless @pkg_svc;
1191   return '' if scalar(@pkg_svc) != 1;
1192   $pkg_svc[0];
1193 }
1194
1195 =item svcpart_unique_svcdb SVCDB
1196
1197 Returns the svcpart of a service definition (see L<FS::part_svc>) matching
1198 SVCDB associated with this package definition (see L<FS::pkg_svc>).  Returns
1199 false if there not a primary service definition for SVCDB or there are multiple
1200 service definitions for SVCDB.
1201
1202 =cut
1203
1204 sub svcpart_unique_svcdb {
1205   my( $self, $svcdb ) = @_;
1206   my @svcdb_pkg_svc = grep { ( $svcdb eq $_->part_svc->svcdb ) } $self->pkg_svc;
1207   return '' if scalar(@svcdb_pkg_svc) != 1;
1208   $svcdb_pkg_svc[0]->svcpart;
1209 }
1210
1211 =item payby
1212
1213 Returns a list of the acceptable payment types for this package.  Eventually
1214 this should come out of a database table and be editable, but currently has the
1215 following logic instead:
1216
1217 If the package is free, the single item B<BILL> is
1218 returned, otherwise, the single item B<CARD> is returned.
1219
1220 (CHEK?  LEC?  Probably shouldn't accept those by default, prone to abuse)
1221
1222 =cut
1223
1224 sub payby {
1225   my $self = shift;
1226   if ( $self->is_free ) {
1227     ( 'BILL' );
1228   } else {
1229     ( 'CARD' );
1230   }
1231 }
1232
1233 =item is_free
1234
1235 Returns true if this package is free.  
1236
1237 =cut
1238
1239 sub is_free {
1240   my $self = shift;
1241   if ( $self->can('is_free_options') ) {
1242     not grep { $_ !~ /^\s*0*(\.0*)?\s*$/ }
1243          map { $self->option($_) } 
1244              $self->is_free_options;
1245   } else {
1246     warn "FS::part_pkg::is_free: FS::part_pkg::". $self->plan. " subclass ".
1247          "provides neither is_free_options nor is_free method; returning false";
1248     0;
1249   }
1250 }
1251
1252 # whether the plan allows discounts to be applied to this package
1253 sub can_discount { 0; }
1254  
1255 # whether the plan allows changing the start date
1256 sub can_start_date {
1257   my $self = shift;
1258   $self->start_on_hold ? 0 : 1;
1259 }
1260
1261 # whether the plan supports part_pkg_usageprice add-ons (a specific kind of
1262 #  pre-selectable usage pricing, there's others this doesn't refer to)
1263 sub can_usageprice { 0; }
1264   
1265 # the delay start date if present
1266 sub delay_start_date {
1267   my $self = shift;
1268
1269   my $delay = $self->delay_start or return '';
1270
1271   # avoid timelocal silliness  
1272   my $dt = DateTime->today(time_zone => 'local');
1273   $dt->add(days => $delay);
1274   $dt->epoch;
1275 }
1276
1277 sub can_currency_exchange { 0; }
1278
1279 sub freqs_href {
1280   # moved to FS::Misc to make this accessible to other packages
1281   # at initialization
1282   FS::Misc::pkg_freqs();
1283 }
1284
1285 =item freq_pretty
1286
1287 Returns an english representation of the I<freq> field, such as "monthly",
1288 "weekly", "semi-annually", etc.
1289
1290 =cut
1291
1292 sub freq_pretty {
1293   my $self = shift;
1294   my $freq = $self->freq;
1295
1296   #my $freqs_href = $self->freqs_href;
1297   my $freqs_href = freqs_href();
1298
1299   if ( exists($freqs_href->{$freq}) ) {
1300     $freqs_href->{$freq};
1301   } else {
1302     my $interval = 'month';
1303     if ( $freq =~ /^(\d+)([hdw])$/ ) {
1304       my %interval = ( 'h' => 'hour', 'd'=>'day', 'w'=>'week' );
1305       $interval = $interval{$2};
1306     }
1307     if ( $1 == 1 ) {
1308       "every $interval";
1309     } else {
1310       "every $freq ${interval}s";
1311     }
1312   }
1313 }
1314
1315 =item add_freq TIMESTAMP [ FREQ ]
1316
1317 Adds a billing period of some frequency to the provided timestamp and 
1318 returns the resulting timestamp, or -1 if the frequency could not be 
1319 parsed (shouldn't happen).  By default, the frequency of this package 
1320 will be used; to override this, pass a different frequency as a second 
1321 argument.
1322
1323 =cut
1324
1325 sub add_freq {
1326   my( $self, $date, $freq ) = @_;
1327   $freq = $self->freq unless $freq;
1328
1329   #change this bit to use Date::Manip? CAREFUL with timezones (see
1330   # mailing list archive)
1331   my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($date) )[0,1,2,3,4,5];
1332
1333   if ( $freq =~ /^\d+$/ ) {
1334     $mon += $freq;
1335     until ( $mon < 12 ) { $mon -= 12; $year++; }
1336
1337     $mday = 28 if $mday > 28 && FS::Conf->new->exists('anniversary-rollback');
1338
1339   } elsif ( $freq =~ /^(\d+)w$/ ) {
1340     my $weeks = $1;
1341     $mday += $weeks * 7;
1342   } elsif ( $freq =~ /^(\d+)d$/ ) {
1343     my $days = $1;
1344     $mday += $days;
1345   } elsif ( $freq =~ /^(\d+)h$/ ) {
1346     my $hours = $1;
1347     $hour += $hours;
1348   } else {
1349     return -1;
1350   }
1351
1352   timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
1353 }
1354
1355 =item plandata
1356
1357 For backwards compatibility, returns the plandata field as well as all options
1358 from FS::part_pkg_option.
1359
1360 =cut
1361
1362 sub plandata {
1363   my $self = shift;
1364   carp "plandata is deprecated";
1365   if ( @_ ) {
1366     $self->SUPER::plandata(@_);
1367   } else {
1368     my $plandata = $self->get('plandata');
1369     my %options = $self->options;
1370     $plandata .= join('', map { "$_=$options{$_}\n" } keys %options );
1371     $plandata;
1372   }
1373 }
1374
1375 =item part_pkg_vendor
1376
1377 Returns all vendor/external package ids as FS::part_pkg_vendor objects (see
1378 L<FS::part_pkg_vendor>).
1379
1380 =item vendor_pkg_ids
1381
1382 Returns a list of vendor/external package ids by exportnum
1383
1384 =cut
1385
1386 sub vendor_pkg_ids {
1387   my $self = shift;
1388   map { $_->exportnum => $_->vendor_pkg_id } $self->part_pkg_vendor;
1389 }
1390
1391 =item part_pkg_option
1392
1393 Returns all options as FS::part_pkg_option objects (see
1394 L<FS::part_pkg_option>).
1395
1396 =item options 
1397
1398 Returns a list of option names and values suitable for assigning to a hash.
1399
1400 =cut
1401
1402 sub options {
1403   my $self = shift;
1404   map { $_->optionname => $_->optionvalue } $self->part_pkg_option;
1405 }
1406
1407 =item option OPTIONNAME [ QUIET ]
1408
1409 Returns the option value for the given name, or the empty string.  If a true
1410 value is passed as the second argument, warnings about missing the option
1411 will be suppressed.
1412
1413 =cut
1414
1415 sub option {
1416   my( $self, $opt, $ornull ) = @_;
1417
1418   #cache: was pulled up in the original part_pkg query
1419   if ( $opt =~ /^(setup|recur)_fee$/ && defined($self->hashref->{"_$opt"}) ) {
1420     return $self->hashref->{"_$opt"};
1421   }
1422
1423   cluck "$self -> option: searching for $opt" if $DEBUG;
1424   my $part_pkg_option =
1425     qsearchs('part_pkg_option', {
1426       pkgpart    => $self->pkgpart,
1427       optionname => $opt,
1428   } );
1429   return $part_pkg_option->optionvalue if $part_pkg_option;
1430
1431   my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); }
1432                      split("\n", $self->get('plandata') );
1433   return $plandata{$opt} if exists $plandata{$opt};
1434
1435   # check whether the option is defined in plan info (if so, don't warn)
1436   if (exists $plans{ $self->plan }->{fields}->{$opt}) {
1437     return '';
1438   }
1439   cluck "WARNING: (pkgpart ". $self->pkgpart. ") Package def option $opt ".
1440         "not found in options or plandata!\n"
1441     unless $ornull;
1442
1443   '';
1444 }
1445
1446 =item part_pkg_currency [ CURRENCY ]
1447
1448 Returns all currency options as FS::part_pkg_currency objects (see
1449 L<FS::part_pkg_currency>), or, if a currency is specified, only return the
1450 objects for that currency.
1451
1452 =cut
1453
1454 sub part_pkg_currency {
1455   my $self = shift;
1456   my %hash = ( 'pkgpart' => $self->pkgpart );
1457   $hash{'currency'} = shift if @_;
1458   qsearch('part_pkg_currency', \%hash );
1459 }
1460
1461 =item part_pkg_currency_options CURRENCY
1462
1463 Returns a list of option names and values from FS::part_pkg_currency for the
1464 specified currency.
1465
1466 =cut
1467
1468 sub part_pkg_currency_options {
1469   my $self = shift;
1470   map { $_->optionname => $_->optionvalue } $self->part_pkg_currency(shift);
1471 }
1472
1473 =item part_pkg_currency_option CURRENCY OPTIONNAME
1474
1475 Returns the option value for the given name and currency.
1476
1477 =cut
1478
1479 sub part_pkg_currency_option {
1480   my( $self, $currency, $optionname ) = @_; 
1481   my $part_pkg_currency =
1482     qsearchs('part_pkg_currency', { 'pkgpart'    => $self->pkgpart,
1483                                     'currency'   => $currency,
1484                                     'optionname' => $optionname,
1485                                   }
1486             )#;
1487   #fatal if not found?  that works for our use cases from
1488   #part_pkg/currency_fixed, but isn't how we would typically/expect the method
1489   #to behave.  have to catch it there if we change it here...
1490     or die "Unknown price for ". $self->pkg_comment. " in $currency\n";
1491
1492   $part_pkg_currency->optionvalue;
1493 }
1494
1495 =item fcc_option OPTIONNAME
1496
1497 Returns the FCC 477 report option value for the given name, or the empty 
1498 string.
1499
1500 =cut
1501
1502 sub fcc_option {
1503   my ($self, $name) = @_;
1504   my $part_pkg_fcc_option =
1505     qsearchs('part_pkg_fcc_option', {
1506         pkgpart => $self->pkgpart,
1507         fccoptionname => $name,
1508     });
1509   $part_pkg_fcc_option ? $part_pkg_fcc_option->optionvalue : '';
1510 }
1511
1512 =item fcc_options
1513
1514 Returns all FCC 477 report options for this package, as a hash-like list.
1515
1516 =cut
1517
1518 sub fcc_options {
1519   my $self = shift;
1520   map { $_->fccoptionname => $_->optionvalue }
1521     qsearch('part_pkg_fcc_option', { pkgpart => $self->pkgpart });
1522 }
1523
1524 =item bill_part_pkg_link
1525
1526 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1527
1528 =cut
1529
1530 sub bill_part_pkg_link {
1531   shift->_part_pkg_link('bill', @_);
1532 }
1533
1534 =item svc_part_pkg_link
1535
1536 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1537
1538 =cut
1539
1540 sub svc_part_pkg_link {
1541   shift->_part_pkg_link('svc', @_);
1542 }
1543
1544 =item supp_part_pkg_link
1545
1546 Returns the associated part_pkg_link records of type 'supp' (supplemental
1547 packages).
1548
1549 =cut
1550
1551 sub supp_part_pkg_link {
1552   shift->_part_pkg_link('supp', @_);
1553 }
1554
1555 sub _part_pkg_link {
1556   my( $self, $type ) = @_;
1557
1558   return @{ $cache_link{$type}->{$self->pkgpart} }
1559     if $cache_enabled && $cache_link{$type}->{$self->pkgpart};
1560
1561   cluck $type.'_part_pkg_link called' if $DEBUG;
1562
1563   my @ppl = 
1564     qsearch({ table    => 'part_pkg_link',
1565               hashref  => { src_pkgpart => $self->pkgpart,
1566                             link_type   => $type,
1567                             #protection against infinite recursive links
1568                             dst_pkgpart => { op=>'!=', value=> $self->pkgpart },
1569                           },
1570               order_by => "ORDER BY hidden",
1571            });
1572
1573   $cache_link{$type}->{$self->pkgpart} = \@ppl if $cache_enabled;
1574
1575   return @ppl;
1576 }
1577
1578 sub self_and_bill_linked {
1579   shift->_self_and_linked('bill', @_);
1580 }
1581
1582 sub self_and_svc_linked {
1583   shift->_self_and_linked('svc', @_);
1584 }
1585
1586 sub _self_and_linked {
1587   my( $self, $type, $hidden ) = @_;
1588   $hidden ||= '';
1589
1590   my @result = ();
1591   foreach ( ( $self, map { $_->dst_pkg->_self_and_linked($type, $_->hidden) }
1592                      $self->_part_pkg_link($type) ) )
1593   {
1594     $_->hidden($hidden) if $hidden;
1595     push @result, $_;
1596   }
1597
1598   (@result);
1599 }
1600
1601 =item part_pkg_taxoverride [ CLASS ]
1602
1603 Returns all associated FS::part_pkg_taxoverride objects (see
1604 L<FS::part_pkg_taxoverride>).  Limits the returned set to those
1605 of class CLASS if defined.  Class may be one of 'setup', 'recur',
1606 the empty string (default), or a usage class number (see L<FS::usage_class>).
1607 When a class is specified, the empty string class (default) is returned
1608 if no more specific values exist.
1609
1610 =cut
1611
1612 sub part_pkg_taxoverride {
1613   my $self = shift;
1614   my $class = shift;
1615
1616   my $hashref = { 'pkgpart' => $self->pkgpart };
1617   $hashref->{'usage_class'} = $class if defined($class);
1618   my @overrides = qsearch('part_pkg_taxoverride', $hashref );
1619
1620   unless ( scalar(@overrides) || !defined($class) || !$class ){
1621     $hashref->{'usage_class'} = '';
1622     @overrides = qsearch('part_pkg_taxoverride', $hashref );
1623   }
1624
1625   @overrides;
1626 }
1627
1628 =item has_taxproduct
1629
1630 Returns true if this package has any taxproduct associated with it.  
1631
1632 =cut
1633
1634 sub has_taxproduct {
1635   my $self = shift;
1636
1637   $self->taxproductnum ||
1638   scalar( grep { $_ =~/^usage_taxproductnum_/ && $self->option($_) } 
1639           keys %{ {$self->options} }
1640   )
1641
1642 }
1643
1644
1645 =item taxproduct [ CLASS ]
1646
1647 Returns the associated tax product for this package definition (see
1648 L<FS::part_pkg_taxproduct>).  CLASS may be one of 'setup', 'recur' or
1649 the usage classnum (see L<FS::usage_class>).  Returns the default
1650 tax product for this record if the more specific CLASS value does
1651 not exist.
1652
1653 =cut
1654
1655 sub taxproduct {
1656   my $self = shift;
1657   my $class = shift;
1658
1659   my $part_pkg_taxproduct;
1660
1661   my $taxproductnum = $self->taxproductnum;
1662   if ($class) { 
1663     my $class_taxproductnum = $self->option("usage_taxproductnum_$class", 1);
1664     $taxproductnum = $class_taxproductnum
1665       if $class_taxproductnum
1666   }
1667   
1668   $part_pkg_taxproduct =
1669     qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1670
1671   unless ($part_pkg_taxproduct || $taxproductnum eq $self->taxproductnum ) {
1672     $taxproductnum = $self->taxproductnum;
1673     $part_pkg_taxproduct =
1674       qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1675   }
1676
1677   $part_pkg_taxproduct;
1678 }
1679
1680 =item taxproduct_description [ CLASS ]
1681
1682 Returns the description of the associated tax product for this package
1683 definition (see L<FS::part_pkg_taxproduct>).
1684
1685 =cut
1686
1687 sub taxproduct_description {
1688   my $self = shift;
1689   my $part_pkg_taxproduct = $self->taxproduct(@_);
1690   $part_pkg_taxproduct ? $part_pkg_taxproduct->description : '';
1691 }
1692
1693
1694 =item tax_rates DATA_PROVIDER, GEOCODE, [ CLASS ]
1695
1696 Returns the tax table entries (L<FS::tax_rate> objects) that apply to this
1697 package in the location specified by GEOCODE, for usage class CLASS (one of
1698 'setup', 'recur', null, or a C<usage_class> number).
1699
1700 =cut
1701
1702 sub tax_rates {
1703   my $self = shift;
1704   my ($vendor, $geocode, $class) = @_;
1705   # if this part_pkg is overridden into a specific taxclass, get that class
1706   my @taxclassnums = map { $_->taxclassnum } 
1707                      $self->part_pkg_taxoverride($class);
1708   # otherwise, get its tax product category
1709   if (!@taxclassnums) {
1710     my $part_pkg_taxproduct = $self->taxproduct($class);
1711     # If this isn't defined, then the class has no taxproduct designation,
1712     # so return no tax rates.
1713     return () if !$part_pkg_taxproduct;
1714
1715     # convert the taxproduct to the tax classes that might apply to it in 
1716     # $geocode
1717     @taxclassnums = map { $_->taxclassnum }
1718                     grep { $_->taxable eq 'Y' } # why do we need this?
1719                     $part_pkg_taxproduct->part_pkg_taxrate($geocode);
1720   }
1721   return unless @taxclassnums;
1722
1723   # then look up the actual tax_rate entries
1724   warn "Found taxclassnum values of ". join(',', @taxclassnums) ."\n"
1725       if $DEBUG;
1726   my $extra_sql = "AND taxclassnum IN (". join(',', @taxclassnums) . ")";
1727   my @taxes = qsearch({ 'table'     => 'tax_rate',
1728                         'hashref'   => { 'geocode'     => $geocode,
1729                                          'data_vendor' => $vendor,
1730                                          'disabled'    => '' },
1731                         'extra_sql' => $extra_sql,
1732                       });
1733   warn "Found taxes ". join(',', map {$_->taxnum} @taxes) ."\n"
1734       if $DEBUG;
1735
1736   return @taxes;
1737 }
1738
1739 =item part_pkg_discount
1740
1741 Returns the package to discount m2m records (see L<FS::part_pkg_discount>)
1742 for this package.
1743
1744 =item part_pkg_usage
1745
1746 Returns the voice usage pools (see L<FS::part_pkg_usage>) defined for 
1747 this package.
1748
1749 =item change_to_pkg
1750
1751 Returns the automatic transfer target for this package, or an empty string
1752 if there isn't one.
1753
1754 =cut
1755
1756 sub change_to_pkg {
1757   my $self = shift;
1758   my $pkgpart = $self->change_to_pkgpart or return '';
1759   FS::part_pkg->by_key($pkgpart);
1760 }
1761
1762 =item _rebless
1763
1764 Reblesses the object into the FS::part_pkg::PLAN class (if available), where
1765 PLAN is the object's I<plan> field.  There should be better docs
1766 on how to create new price plans, but until then, see L</NEW PLAN CLASSES>.
1767
1768 =cut
1769
1770 sub _rebless {
1771   my $self = shift;
1772   my $plan = $self->plan;
1773   unless ( $plan ) {
1774     cluck "no price plan found for pkgpart ". $self->pkgpart. "\n"
1775       if $DEBUG;
1776     return $self;
1777   }
1778   return $self if ref($self) =~ /::$plan$/; #already blessed into plan subclass
1779   my $class = ref($self). "::$plan";
1780   warn "reblessing $self into $class" if $DEBUG > 1;
1781   eval "use $class;";
1782   die $@ if $@;
1783   bless($self, $class) unless $@;
1784   $self;
1785 }
1786
1787 =item calc_setup CUST_PKG START_DATE DETAILS_ARRAYREF OPTIONS_HASHREF
1788
1789 =item calc_recur CUST_PKG START_DATE DETAILS_ARRAYREF OPTIONS_HASHREF
1790
1791 Calculates and returns the setup or recurring fees, respectively, for this
1792 package.  Implementation is in the FS::part_pkg:* module specific to this price
1793 plan.
1794
1795 Adds invoicing details to the passed-in DETAILS_ARRAYREF
1796
1797 Options are passed as a hashref.  Available options:
1798
1799 =over 4
1800
1801 =item freq_override
1802
1803 Frequency override (for calc_recur)
1804
1805 =item discounts
1806
1807 This option is filled in by the method rather than controlling its operation.
1808 It is an arrayref.  Applicable discounts will be added to the arrayref, as
1809 L<FS::cust_bill_pkg_discount|FS::cust_bill_pkg_discount records>.
1810
1811 =item real_pkgpart
1812
1813 For package add-ons, is the base L<FS::part_pkg|package definition>, otherwise
1814 no different than pkgpart.
1815
1816 =item precommit_hooks
1817
1818 This option is filled in by the method rather than controlling its operation.
1819 It is an arrayref.  Anonymous coderefs will be added to the arrayref.  They
1820 need to be called before completing the billing operation.  For calc_recur
1821 only.
1822
1823 =item increment_next_bill
1824
1825 Increment the next bill date (boolean, for calc_recur).  Typically true except
1826 for particular situations.
1827
1828 =item setup_fee
1829
1830 This option is filled in by the method rather than controlling its operation.
1831 It indicates a deferred setup fee that is billed at calc_recur time (see price
1832 plan option prorate_defer_bill).
1833
1834 =back
1835
1836 Note: Don't calculate prices when not actually billing the package.  For that,
1837 see the L</base_setup|base_setup> and L</base_recur|base_recur> methods.
1838
1839 =cut
1840
1841 #fatal fallbacks
1842 sub calc_setup { die 'no calc_setup for '. shift->plan. "\n"; }
1843 sub calc_recur { die 'no calc_recur for '. shift->plan. "\n"; }
1844
1845 =item calc_remain CUST_PKG [ OPTION => VALUE ... ]
1846
1847 Calculates and returns the remaining value to be credited upon package
1848 suspension, change, or cancellation, if enabled.
1849
1850 Options are passed as a list of keys and values.  Available options:
1851
1852 =over 4
1853
1854 =item time
1855
1856 Override for the current time
1857
1858 =item cust_credit_source_bill_pkg
1859
1860 This option is filled in by the method rather than controlling its operation.
1861 It is an arrayref.
1862 L<FS::cust_credit_source_bill_pkg|FS::cust_credit_source_bill_pkg> records will
1863 be added to the arrayref indicating the specific line items and amounts which
1864 are the source of this remaining credit.
1865
1866 =back
1867
1868 Note: Don't calculate prices when not actually suspending or cancelling the
1869 package.
1870
1871 =cut
1872
1873 #fallback that returns 0 for old legacy packages with no plan
1874 sub calc_remain { 0; }
1875
1876 =item calc_units CUST_PKG
1877
1878 This returns the number of provisioned svc_phone records, or, of the package
1879 count_available_phones option is set, the number available to be provisoined
1880 in the package.
1881
1882 =cut
1883
1884 #fallback that returns 0 for old legacy packages with no plan
1885 sub calc_units  { 0; }
1886
1887 #fallback for everything not based on flat.pm
1888 sub recur_temporality { 'upcoming'; }
1889
1890 =item calc_cancel START_DATE DETAILS_ARRAYREF OPTIONS_HASHREF
1891
1892 Runs any necessary billing on cancellation: another recurring cycle for
1893 recur_temporailty 'preceding' pacakges with the bill_recur_on_cancel option
1894 set (calc_recur), or, any outstanding usage for pacakges with the
1895 bill_usage_on_cancel option set (calc_usage).
1896
1897 =cut
1898
1899 #fallback for everything not based on flat.pm, doesn't do this yet (which is
1900 #okay, nothing of ours not based on flat.pm does usage-on-cancel billing
1901 sub calc_cancel { 0; }
1902
1903 #fallback for everything except bulk.pm
1904 sub hide_svc_detail { 0; }
1905
1906 #fallback for packages that can't/won't summarize usage
1907 sub sum_usage { 0; }
1908
1909 =item recur_cost_permonth CUST_PKG
1910
1911 recur_cost divided by freq (only supported for monthly and longer frequencies)
1912
1913 =cut
1914
1915 sub recur_cost_permonth {
1916   my($self, $cust_pkg) = @_;
1917   return 0 unless $self->freq =~ /^\d+$/ && $self->freq > 0;
1918   sprintf('%.2f', ($self->recur_cost || 0) / $self->freq );
1919 }
1920
1921 =item cust_bill_pkg_recur CUST_PKG
1922
1923 Actual recurring charge for the specified customer package from customer's most
1924 recent invoice
1925
1926 =cut
1927
1928 sub cust_bill_pkg_recur {
1929   my($self, $cust_pkg) = @_;
1930   my $cust_bill_pkg = qsearchs({
1931     'table'     => 'cust_bill_pkg',
1932     'addl_from' => 'LEFT JOIN cust_bill USING ( invnum )',
1933     'hashref'   => { 'pkgnum' => $cust_pkg->pkgnum,
1934                      'recur'  => { op=>'>', value=>'0' },
1935                    },
1936     'order_by'  => 'ORDER BY cust_bill._date     DESC,
1937                              cust_bill_pkg.sdate DESC
1938                      LIMIT 1
1939                    ',
1940   }) or return 0; #die "use cust_bill_pkg_recur credits with once_perinv condition";
1941   $cust_bill_pkg->recur;
1942 }
1943
1944 =item unit_setup CUST_PKG
1945
1946 Returns the setup fee for one unit of the package.
1947
1948 =cut
1949
1950 sub unit_setup {
1951   my ($self, $cust_pkg) = @_;
1952   $self->option('setup_fee') || 0;
1953 }
1954
1955 =item setup_margin
1956
1957 unit_setup minus setup_cost
1958
1959 =cut
1960
1961 sub setup_margin {
1962   my $self = shift;
1963   $self->unit_setup(@_) - ($self->setup_cost || 0);
1964 }
1965
1966 =item recur_margin_permonth
1967
1968 base_recur_permonth minus recur_cost_permonth
1969
1970 =cut
1971
1972 sub recur_margin_permonth {
1973   my $self = shift;
1974   $self->base_recur_permonth(@_) - $self->recur_cost_permonth(@_);
1975 }
1976
1977 =item format OPTION DATA
1978
1979 Returns data formatted according to the function 'format' described
1980 in the plan info.  Returns DATA if no such function exists.
1981
1982 =cut
1983
1984 sub format {
1985   my ($self, $option, $data) = (shift, shift, shift);
1986   if (exists($plans{$self->plan}->{fields}->{$option}{format})) {
1987     &{$plans{$self->plan}->{fields}->{$option}{format}}($data);
1988   }else{
1989     $data;
1990   }
1991 }
1992
1993 =item parse OPTION DATA
1994
1995 Returns data parsed according to the function 'parse' described
1996 in the plan info.  Returns DATA if no such function exists.
1997
1998 =cut
1999
2000 sub parse {
2001   my ($self, $option, $data) = (shift, shift, shift);
2002   if (exists($plans{$self->plan}->{fields}->{$option}{parse})) {
2003     &{$plans{$self->plan}->{fields}->{$option}{parse}}($data);
2004   }else{
2005     $data;
2006   }
2007 }
2008
2009 =back
2010
2011 =cut
2012
2013 =head1 CLASS METHODS
2014
2015 =over 4
2016
2017 =cut
2018
2019 # _upgrade_data
2020 #
2021 # Used by FS::Upgrade to migrate to a new database.
2022
2023 sub _upgrade_data { # class method
2024    my($class, %opts) = @_;
2025
2026   warn "[FS::part_pkg] upgrading $class\n" if $DEBUG;
2027
2028   my @part_pkg = qsearch({
2029     'table'     => 'part_pkg',
2030     'extra_sql' => "WHERE ". join(' OR ',
2031                      'plan IS NULL', "plan = '' ",
2032                    ),
2033   });
2034
2035   foreach my $part_pkg (@part_pkg) {
2036
2037     unless ( $part_pkg->plan ) {
2038       $part_pkg->plan('flat');
2039     }
2040
2041     $part_pkg->replace;
2042
2043   }
2044
2045   # Convert RADIUS accounting usage metrics from megabytes to gigabytes
2046   # (FS RT#28105)
2047   my $upgrade = 'part_pkg_gigabyte_usage';
2048   if (!FS::upgrade_journal->is_done($upgrade)) {
2049     foreach my $part_pkg (qsearch('part_pkg',
2050                                   { plan => 'sqlradacct_hour' })
2051                          ){
2052
2053       my $pkgpart = $part_pkg->pkgpart;
2054
2055       foreach my $opt (qsearch('part_pkg_option',
2056                                { 'optionname'  => { op => 'LIKE',
2057                                                     value => 'recur_included_%',
2058                                                   },
2059                                  pkgpart => $pkgpart,
2060                                })){
2061
2062         next if $opt->optionname eq 'recur_included_hours'; # unfortunately named field
2063         next if $opt->optionvalue == 0;
2064
2065         $opt->optionvalue($opt->optionvalue / 1024);
2066
2067         my $error = $opt->replace;
2068         die $error if $error;
2069       }
2070
2071       foreach my $opt (qsearch('part_pkg_option',
2072                                { 'optionname'  => { op => 'LIKE',
2073                                                     value => 'recur_%_charge',
2074                                                   },
2075                                  pkgpart => $pkgpart,
2076                                })){
2077         $opt->optionvalue($opt->optionvalue * 1024);
2078
2079         my $error = $opt->replace;
2080         die $error if $error;
2081       }
2082
2083     }
2084     FS::upgrade_journal->set_done($upgrade);
2085   }
2086
2087   # the rest can be done asynchronously
2088 }
2089
2090 sub queueable_upgrade {
2091   # now upgrade to the explicit custom flag
2092
2093   my $search = FS::Cursor->new({
2094     'table'     => 'part_pkg',
2095     'hashref'   => { disabled => 'Y', custom => '' },
2096     'extra_sql' => "AND comment LIKE '(CUSTOM) %'",
2097   });
2098   my $dbh = dbh;
2099
2100   while (my $part_pkg = $search->fetch) {
2101     my $new = new FS::part_pkg { $part_pkg->hash };
2102     $new->custom('Y');
2103     my $comment = $part_pkg->comment;
2104     $comment =~ s/^\(CUSTOM\) //;
2105     $comment = '(none)' unless $comment =~ /\S/;
2106     $new->comment($comment);
2107
2108     my $pkg_svc = { map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc };
2109     my $primary = $part_pkg->svcpart;
2110     my $options = { $part_pkg->options };
2111
2112     my $error = $new->replace( $part_pkg,
2113                                'pkg_svc'     => $pkg_svc,
2114                                'primary_svc' => $primary,
2115                                'options'     => $options,
2116                              );
2117     if ($error) {
2118       warn "pkgpart#".$part_pkg->pkgpart.": $error\n";
2119       $dbh->rollback;
2120     } else {
2121       $dbh->commit;
2122     }
2123   }
2124
2125   # set family_pkgpart on any packages that don't have it
2126   $search = FS::Cursor->new('part_pkg', { 'family_pkgpart' => '' });
2127   while (my $part_pkg = $search->fetch) {
2128     $part_pkg->set('family_pkgpart' => $part_pkg->pkgpart);
2129     my $error = $part_pkg->SUPER::replace;
2130     if ($error) {
2131       warn "pkgpart#".$part_pkg->pkgpart.": $error\n";
2132       $dbh->rollback;
2133     } else {
2134       $dbh->commit;
2135     }
2136   }
2137
2138   my @part_pkg_option = qsearch('part_pkg_option',
2139     { 'optionname'  => 'unused_credit',
2140       'optionvalue' => 1,
2141     });
2142   foreach my $old_opt (@part_pkg_option) {
2143     my $pkgpart = $old_opt->pkgpart;
2144     my $error = $old_opt->delete;
2145     die $error if $error;
2146
2147     foreach (qw(unused_credit_cancel unused_credit_change)) {
2148       my $new_opt = new FS::part_pkg_option {
2149         'pkgpart'     => $pkgpart,
2150         'optionname'  => $_,
2151         'optionvalue' => 1,
2152       };
2153       $error = $new_opt->insert;
2154       die $error if $error;
2155     }
2156   }
2157
2158   # migrate use_disposition_taqua and use_disposition to disposition_in
2159   @part_pkg_option = qsearch('part_pkg_option',
2160     { 'optionname'  => { op => 'LIKE',
2161                          value => 'use_disposition%',
2162                        },
2163       'optionvalue' => 1,
2164     });
2165   my %newopts = map { $_->pkgpart => $_ } 
2166     qsearch('part_pkg_option',  { 'optionname'  => 'disposition_in', } );
2167   foreach my $old_opt (@part_pkg_option) {
2168         my $pkgpart = $old_opt->pkgpart;
2169         my $newval = $old_opt->optionname eq 'use_disposition_taqua' ? '100' 
2170                                                                   : 'ANSWERED';
2171         my $error = $old_opt->delete;
2172         die $error if $error;
2173
2174         if ( exists($newopts{$pkgpart}) ) {
2175             my $opt = $newopts{$pkgpart};
2176             $opt->optionvalue($opt->optionvalue.",$newval");
2177             $error = $opt->replace;
2178             die $error if $error;
2179         } else {
2180             my $new_opt = new FS::part_pkg_option {
2181                 'pkgpart'     => $pkgpart,
2182                 'optionname'  => 'disposition_in',
2183                 'optionvalue' => $newval,
2184               };
2185               $error = $new_opt->insert;
2186               die $error if $error;
2187               $newopts{$pkgpart} = $new_opt;
2188         }
2189   }
2190
2191   # set any package with FCC voice lines to the "VoIP with broadband" category
2192   # for backward compatibility
2193   #
2194   # recover from a bad upgrade bug
2195   my $upgrade = 'part_pkg_fcc_voip_class_FIX';
2196   if (!FS::upgrade_journal->is_done($upgrade)) {
2197     my $bad_upgrade = qsearchs('upgrade_journal', 
2198       { upgrade => 'part_pkg_fcc_voip_class' }
2199     );
2200     if ( $bad_upgrade ) {
2201       my $where = 'WHERE history_date <= '.$bad_upgrade->_date.
2202                   ' AND  history_date >  '.($bad_upgrade->_date - 3600);
2203       my @h_part_pkg_option = map { FS::part_pkg_option->new($_->hashref) }
2204         qsearch({
2205           'select'    => '*',
2206           'table'     => 'h_part_pkg_option',
2207           'hashref'   => {},
2208           'extra_sql' => "$where AND history_action = 'delete'",
2209           'order_by'  => 'ORDER BY history_date ASC',
2210         });
2211       my @h_pkg_svc = map { FS::pkg_svc->new($_->hashref) }
2212         qsearch({
2213           'select'    => '*',
2214           'table'     => 'h_pkg_svc',
2215           'hashref'   => {},
2216           'extra_sql' => "$where AND history_action = 'replace_old'",
2217           'order_by'  => 'ORDER BY history_date ASC',
2218         });
2219       my %opt;
2220       foreach my $deleted (@h_part_pkg_option, @h_pkg_svc) {
2221         my $pkgpart ||= $deleted->pkgpart;
2222         $opt{$pkgpart} ||= {
2223           options => {},
2224           pkg_svc => {},
2225           primary_svc => '',
2226           hidden_svc => {},
2227         };
2228         if ( $deleted->isa('FS::part_pkg_option') ) {
2229           $opt{$pkgpart}{options}{ $deleted->optionname } = $deleted->optionvalue;
2230         } else { # pkg_svc
2231           my $svcpart = $deleted->svcpart;
2232           $opt{$pkgpart}{pkg_svc}{$svcpart} = $deleted->quantity;
2233           $opt{$pkgpart}{hidden_svc}{$svcpart} ||= $deleted->hidden;
2234           $opt{$pkgpart}{primary_svc} = $svcpart if $deleted->primary_svc;
2235         }
2236       }
2237       foreach my $pkgpart (keys %opt) {
2238         my $part_pkg = FS::part_pkg->by_key($pkgpart);
2239         my $error = $part_pkg->replace( $part_pkg->replace_old, $opt{$pkgpart} );
2240         if ( $error ) {
2241           die "error recovering damaged pkgpart $pkgpart:\n$error\n";
2242         }
2243       }
2244     } # $bad_upgrade exists
2245     else { # do the original upgrade, but correctly this time
2246       my @part_pkg = qsearch('part_pkg', {
2247           fcc_ds0s        => { op => '>', value => 0 },
2248           fcc_voip_class  => ''
2249       });
2250       foreach my $part_pkg (@part_pkg) {
2251         $part_pkg->set(fcc_voip_class => 2);
2252         my @pkg_svc = $part_pkg->pkg_svc;
2253         my %quantity = map {$_->svcpart, $_->quantity} @pkg_svc;
2254         my %hidden   = map {$_->svcpart, $_->hidden  } @pkg_svc;
2255         my $error = $part_pkg->replace(
2256           $part_pkg->replace_old,
2257           options     => { $part_pkg->options },
2258           pkg_svc     => \%quantity,
2259           hidden_svc  => \%hidden,
2260           primary_svc => ($part_pkg->svcpart || ''),
2261         );
2262         die $error if $error;
2263       }
2264     }
2265     FS::upgrade_journal->set_done($upgrade);
2266   }
2267
2268   # migrate adjourn_months, expire_months, and contract_end_months to 
2269   # real fields
2270   foreach my $field (qw(adjourn_months expire_months contract_end_months)) {
2271     foreach my $option (qsearch('part_pkg_option', { optionname => $field })) {
2272       my $part_pkg = $option->part_pkg;
2273       my $error = $option->delete;
2274       if ( $option->optionvalue and $part_pkg->get($field) eq '' ) {
2275         $part_pkg->set($field, $option->optionvalue);
2276         $error ||= $part_pkg->replace;
2277       }
2278       die $error if $error;
2279     }
2280   }
2281 }
2282
2283 =item curuser_pkgs_sql
2284
2285 Returns an SQL fragment for searching for packages the current user can
2286 use, either via part_pkg.agentnum directly, or via agent type (see
2287 L<FS::type_pkgs>).
2288
2289 =cut
2290
2291 sub curuser_pkgs_sql {
2292   my $class = shift;
2293
2294   $class->_pkgs_sql( $FS::CurrentUser::CurrentUser->agentnums );
2295
2296 }
2297
2298 =item agent_pkgs_sql AGENT | AGENTNUM, ...
2299
2300 Returns an SQL fragment for searching for packages the provided agent or agents
2301 can use, either via part_pkg.agentnum directly, or via agent type (see
2302 L<FS::type_pkgs>).
2303
2304 =cut
2305
2306 sub agent_pkgs_sql {
2307   my $class = shift;  #i'm a class method, not a sub (the question is... why??)
2308   my @agentnums = map { ref($_) ? $_->agentnum : $_ } @_;
2309
2310   $class->_pkgs_sql(@agentnums); #is this why
2311
2312 }
2313
2314 sub _pkgs_sql {
2315   my( $class, @agentnums ) = @_;
2316   my $agentnums = join(',', @agentnums);
2317
2318   "
2319     (
2320       ( agentnum IS NOT NULL AND agentnum IN ($agentnums) )
2321       OR ( agentnum IS NULL
2322            AND EXISTS ( SELECT 1
2323                           FROM type_pkgs
2324                             LEFT JOIN agent_type USING ( typenum )
2325                             LEFT JOIN agent AS typeagent USING ( typenum )
2326                           WHERE type_pkgs.pkgpart = part_pkg.pkgpart
2327                             AND typeagent.agentnum IN ($agentnums)
2328                       )
2329          )
2330     )
2331   ";
2332
2333 }
2334
2335 =back
2336
2337 =head1 SUBROUTINES
2338
2339 =over 4
2340
2341 =item plan_info
2342
2343 =cut
2344
2345 #false laziness w/part_export & cdr
2346 my %info;
2347 foreach my $INC ( @INC ) {
2348   warn "globbing $INC/FS/part_pkg/[a-z]*.pm\n" if $DEBUG;
2349   foreach my $file ( glob("$INC/FS/part_pkg/[a-z]*.pm") ) {
2350     warn "attempting to load plan info from $file\n" if $DEBUG;
2351     $file =~ /\/(\w+)\.pm$/ or do {
2352       warn "unrecognized file in $INC/FS/part_pkg/: $file\n";
2353       next;
2354     };
2355     my $mod = $1;
2356     my $info = eval "use FS::part_pkg::$mod; ".
2357                     "\\%FS::part_pkg::$mod\::info;";
2358     if ( $@ ) {
2359       die "error using FS::part_pkg::$mod (skipping): $@\n" if $@;
2360       next;
2361     }
2362     unless ( keys %$info ) {
2363       warn "no %info hash found in FS::part_pkg::$mod, skipping\n";
2364       next;
2365     }
2366     warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG;
2367     #if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
2368     #  warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG;
2369     #  next;
2370     #}
2371     $info{$mod} = $info;
2372     $info->{'weight'} ||= 0; # quiet warnings
2373   }
2374 }
2375
2376 # copy one level deep to allow replacement of fields and fieldorder
2377 tie %plans, 'Tie::IxHash',
2378   map  { my %infohash = %{ $info{$_} }; 
2379           $_ => \%infohash }
2380   sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} }
2381   keys %info;
2382
2383 # inheritance of plan options
2384 foreach my $name (keys(%info)) {
2385   if (exists($info{$name}->{'disabled'}) and $info{$name}->{'disabled'}) {
2386     warn "skipping disabled plan FS::part_pkg::$name" if $DEBUG;
2387     delete $plans{$name};
2388     next;
2389   }
2390   my $parents = $info{$name}->{'inherit_fields'} || [];
2391   my (%fields, %field_exists, @fieldorder);
2392   foreach my $parent ($name, @$parents) {
2393     if ( !exists($info{$parent}) ) {
2394       warn "$name tried to inherit from nonexistent '$parent'\n";
2395       next;
2396     }
2397     %fields = ( # avoid replacing existing fields
2398       %{ $info{$parent}->{'fields'} || {} },
2399       %fields
2400     );
2401     foreach (@{ $info{$parent}->{'fieldorder'} || [] }) {
2402       # avoid duplicates
2403       next if $field_exists{$_};
2404       $field_exists{$_} = 1;
2405       # allow inheritors to remove inherited fields from the fieldorder
2406       push @fieldorder, $_ if !exists($fields{$_}) or
2407                               !exists($fields{$_}->{'disabled'});
2408     }
2409   }
2410   $plans{$name}->{'fields'} = \%fields;
2411   $plans{$name}->{'fieldorder'} = \@fieldorder;
2412 }
2413
2414 sub plan_info {
2415   \%plans;
2416 }
2417
2418
2419 =back
2420
2421 =head1 NEW PLAN CLASSES
2422
2423 A module should be added in FS/FS/part_pkg/  Eventually, an example may be
2424 found in eg/plan_template.pm.  Until then, it is suggested that you use the
2425 other modules in FS/FS/part_pkg/ as a guide.
2426
2427 =head1 BUGS
2428
2429 The delete method is unimplemented.
2430
2431 setup and recur semantics are not yet defined (and are implemented in
2432 FS::cust_bill.  hmm.).  now they're deprecated and need to go.
2433
2434 plandata should go
2435
2436 part_pkg_taxrate is Pg specific
2437
2438 replace should be smarter about managing the related tables (options, pkg_svc)
2439
2440 =head1 SEE ALSO
2441
2442 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
2443 schema.html from the base documentation.
2444
2445 =cut
2446
2447 1;
2448