e9d80da0b59284d3249c3e198d64c80e132fe780
[freeside.git] / FS / FS / cust_pkg.pm
1 package FS::cust_pkg;
2 use base qw( FS::cust_pkg::Search FS::cust_pkg::API
3              FS::otaker_Mixin FS::cust_main_Mixin FS::Sales_Mixin
4              FS::contact_Mixin FS::location_Mixin
5              FS::m2m_Common FS::option_Common
6            );
7
8 use strict;
9 use Carp qw(cluck);
10 use Scalar::Util qw( blessed );
11 use List::Util qw(min max sum);
12 use Tie::IxHash;
13 use Time::Local qw( timelocal timelocal_nocheck );
14 use MIME::Entity;
15 use FS::UID qw( dbh driver_name );
16 use FS::Record qw( qsearch qsearchs fields );
17 use FS::CurrentUser;
18 use FS::cust_svc;
19 use FS::part_pkg;
20 use FS::cust_main;
21 use FS::contact;
22 use FS::cust_location;
23 use FS::pkg_svc;
24 use FS::cust_bill_pkg;
25 use FS::cust_pkg_detail;
26 use FS::cust_pkg_usage;
27 use FS::cdr_cust_pkg_usage;
28 use FS::cust_event;
29 use FS::h_cust_svc;
30 use FS::reg_code;
31 use FS::part_svc;
32 use FS::cust_pkg_reason;
33 use FS::reason;
34 use FS::cust_pkg_usageprice;
35 use FS::cust_pkg_discount;
36 use FS::discount;
37 use FS::sales;
38 # for modify_charge
39 use FS::cust_credit;
40
41 # temporary fix; remove this once (un)suspend admin notices are cleaned up
42 use FS::Misc qw(send_email);
43
44 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
45 # setup }
46 # because they load configuration by setting FS::UID::callback (see TODO)
47 use FS::svc_acct;
48 use FS::svc_domain;
49 use FS::svc_www;
50 use FS::svc_forward;
51
52 # for sending cancel emails in sub cancel
53 use FS::Conf;
54
55 our ($disable_agentcheck, $DEBUG, $me, $import) = (0, 0, '[FS::cust_pkg]', 0);
56
57 our $upgrade = 0; #go away after setup+start dates cleaned up for old customers
58
59 our $cache_enabled = 0;
60
61 sub _simplecache {
62   my( $self, $hashref ) = @_;
63   if ( $cache_enabled && $hashref->{'pkg'} && $hashref->{'plan'} ) {
64     $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
65   }
66 }
67
68 sub _cache {
69   my $self = shift;
70   my ( $hashref, $cache ) = @_;
71 #  #if ( $hashref->{'pkgpart'} ) {
72 #  if ( $hashref->{'pkg'} ) {
73 #    # #@{ $self->{'_pkgnum'} } = ();
74 #    # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
75 #    # $self->{'_pkgpart'} = $subcache;
76 #    # #push @{ $self->{'_pkgnum'} },
77 #    #   FS::part_pkg->new_or_cached($hashref, $subcache);
78 #    $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
79 #  }
80   if ( exists $hashref->{'svcnum'} ) {
81     #@{ $self->{'_pkgnum'} } = ();
82     my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
83     $self->{'_svcnum'} = $subcache;
84     #push @{ $self->{'_pkgnum'} },
85     FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
86   }
87 }
88
89 =head1 NAME
90
91 FS::cust_pkg - Object methods for cust_pkg objects
92
93 =head1 SYNOPSIS
94
95   use FS::cust_pkg;
96
97   $record = new FS::cust_pkg \%hash;
98   $record = new FS::cust_pkg { 'column' => 'value' };
99
100   $error = $record->insert;
101
102   $error = $new_record->replace($old_record);
103
104   $error = $record->delete;
105
106   $error = $record->check;
107
108   $error = $record->cancel;
109
110   $error = $record->suspend;
111
112   $error = $record->unsuspend;
113
114   $part_pkg = $record->part_pkg;
115
116   @labels = $record->labels;
117
118   $seconds = $record->seconds_since($timestamp);
119
120   #bulk cancel+order... perhaps slightly deprecated, only used by the bulk
121   # cancel+order in the web UI and nowhere else (edit/process/cust_pkg.cgi)
122   $error = FS::cust_pkg::order( $custnum, \@pkgparts );
123   $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
124
125 =head1 DESCRIPTION
126
127 An FS::cust_pkg object represents a customer billing item.  FS::cust_pkg
128 inherits from FS::Record.  The following fields are currently supported:
129
130 =over 4
131
132 =item pkgnum
133
134 Primary key (assigned automatically for new billing items)
135
136 =item custnum
137
138 Customer (see L<FS::cust_main>)
139
140 =item pkgpart
141
142 Billing item definition (see L<FS::part_pkg>)
143
144 =item locationnum
145
146 Optional link to package location (see L<FS::location>)
147
148 =item order_date
149
150 date package was ordered (also remains same on changes)
151
152 =item start_date
153
154 date
155
156 =item setup
157
158 date
159
160 =item bill
161
162 date (next bill date)
163
164 =item last_bill
165
166 last bill date
167
168 =item adjourn
169
170 date
171
172 =item susp
173
174 date
175
176 =item expire
177
178 date
179
180 =item contract_end
181
182 date
183
184 =item cancel
185
186 date
187
188 =item usernum
189
190 order taker (see L<FS::access_user>)
191
192 =item quantity
193
194 If not set, defaults to 1
195
196 =item change_date
197
198 Date of change from previous package
199
200 =item change_pkgnum
201
202 Previous pkgnum
203
204 =item change_pkgpart
205
206 Previous pkgpart
207
208 =item change_locationnum
209
210 Previous locationnum
211
212 =item waive_setup
213
214 =item main_pkgnum
215
216 The pkgnum of the package that this package is supplemental to, if any.
217
218 =item pkglinknum
219
220 The package link (L<FS::part_pkg_link>) that defines this supplemental
221 package, if it is one.
222
223 =item change_to_pkgnum
224
225 The pkgnum of the package this one will be "changed to" in the future
226 (on its expiration date).
227
228 =back
229
230 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
231 are specified as UNIX timestamps; see L<perlfunc/"time">.  Also see
232 L<Time::Local> and L<Date::Parse> for conversion functions.
233
234 =head1 METHODS
235
236 =over 4
237
238 =item new HASHREF
239
240 Create a new billing item.  To add the item to the database, see L<"insert">.
241
242 =cut
243
244 sub table { 'cust_pkg'; }
245 sub cust_linked { $_[0]->cust_main_custnum || $_[0]->custnum } 
246 sub cust_unlinked_msg {
247   my $self = shift;
248   "WARNING: can't find cust_main.custnum ". $self->custnum.
249   ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
250 }
251
252 =item set_initial_timers
253
254 If required by the package definition, sets any automatic expire, adjourn,
255 or contract_end timers to some number of months after the start date 
256 (or setup date, if the package has already been setup). If the package has
257 a delayed setup fee after a period of "free days", will also set the 
258 start date to the end of that period.
259
260 If the package has an automatic transfer rule (C<change_to_pkgnum>), then
261 this will also order the package and set its start date.
262
263 =cut
264
265 sub set_initial_timers {
266   my $self = shift;
267   my $part_pkg = $self->part_pkg;
268   my $start = $self->start_date || $self->setup || time;
269
270   foreach my $action ( qw(expire adjourn contract_end) ) {
271     my $months = $part_pkg->get("${action}_months");
272     if($months and !$self->get($action)) {
273       $self->set($action, $part_pkg->add_freq($start, $months) );
274     }
275   }
276
277   # if this package has an expire date and a change_to_pkgpart, set automatic
278   # package transfer
279   # (but don't call change_later, as that would call $self->replace, and we're
280   # probably in the middle of $self->insert right now)
281   if ( $part_pkg->expire_months and $part_pkg->change_to_pkgpart ) {
282     if ( $self->change_to_pkgnum ) {
283       # this can happen if a package is ordered on hold, scheduled for a 
284       # future change _while on hold_, and then released from hold, causing
285       # the automatic transfer to schedule.
286       #
287       # what's correct behavior in that case? I think it's to disallow
288       # future-changing an on-hold package that has an automatic transfer.
289       # but if we DO get into this situation, let the manual package change
290       # win.
291       warn "pkgnum ".$self->pkgnum.": manual future package change blocks ".
292            "automatic transfer.\n";
293     } else {
294       my $change_to = FS::cust_pkg->new( {
295           start_date  => $self->get('expire'),
296           pkgpart     => $part_pkg->change_to_pkgpart,
297           map { $_ => $self->get($_) }
298             qw( custnum locationnum quantity refnum salesnum contract_end )
299       } );
300       my $error = $change_to->insert;
301
302       return $error if $error;
303       $self->set('change_to_pkgnum', $change_to->pkgnum);
304     }
305   }
306
307   # if this package has "free days" and delayed setup fee, then
308   # set start date that many days in the future.
309   # (this should have been set in the UI, but enforce it here)
310   if ( $part_pkg->option('free_days',1)
311        && $part_pkg->option('delay_setup',1)
312      )
313   {
314     $self->start_date( $part_pkg->default_start_date );
315   }
316
317   '';
318 }
319
320 =item insert [ OPTION => VALUE ... ]
321
322 Adds this billing item to the database ("Orders" the item).  If there is an
323 error, returns the error, otherwise returns false.
324
325 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
326 will be used to look up the package definition and agent restrictions will be
327 ignored.
328
329 If the additional field I<refnum> is defined, an FS::pkg_referral record will
330 be created and inserted.  Multiple FS::pkg_referral records can be created by
331 setting I<refnum> to an array reference of refnums or a hash reference with
332 refnums as keys.  If no I<refnum> is defined, a default FS::pkg_referral
333 record will be created corresponding to cust_main.refnum.
334
335 If the additional field I<cust_pkg_usageprice> is defined, it will be treated
336 as an arrayref of FS::cust_pkg_usageprice objects, which will be inserted.
337 (Note that this field cannot be set with a usual ->cust_pkg_usageprice method.
338 It can be set as part of the hash when creating the object, or with the B<set>
339 method.)
340
341 The following options are available:
342
343 =over 4
344
345 =item change
346
347 If set true, supresses actions that should only be taken for new package
348 orders.  (Currently this includes: intro periods when delay_setup is on,
349 auto-adding a 1st start date, auto-adding expiration/adjourn/contract_end dates)
350
351 =item options
352
353 cust_pkg_option records will be created
354
355 =item ticket_subject
356
357 a ticket will be added to this customer with this subject
358
359 =item ticket_queue
360
361 an optional queue name for ticket additions
362
363 =item allow_pkgpart
364
365 Don't check the legality of the package definition.  This should be used
366 when performing a package change that doesn't change the pkgpart (i.e. 
367 a location change).
368
369 =back
370
371 =cut
372
373 sub insert {
374   my( $self, %options ) = @_;
375
376   my $oldAutoCommit = $FS::UID::AutoCommit;
377   local $FS::UID::AutoCommit = 0;
378   my $dbh = dbh;
379
380   my $error;
381   $error = $self->check_pkgpart unless $options{'allow_pkgpart'};
382
383   my $part_pkg = $self->part_pkg;
384
385   if ( ! $import && ! $options{'change'} ) {
386
387     # set order date to now
388     $self->order_date(time) unless ($import && $self->order_date);
389
390     # if the package def says to start only on the first of the month:
391     if ( $part_pkg->option('start_1st', 1) && !$self->start_date ) {
392       my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5];
393       $mon += 1 unless $mday == 1;
394       until ( $mon < 12 ) { $mon -= 12; $year++; }
395       $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
396     }
397
398     if ($self->susp eq 'now' or $part_pkg->start_on_hold) {
399       # if the package was ordered on hold:
400       # - suspend it
401       # - don't set the start date (it will be started manually)
402       $self->set('susp', $self->order_date);
403       $self->set('start_date', '');
404     } else {
405       # set expire/adjourn/contract_end timers, and free days, if appropriate
406       # and automatic package transfer, which can fail, so capture the result
407       $error = $self->set_initial_timers;
408     }
409   } # else this is a package change, and shouldn't have "new package" behavior
410
411   $error ||= $self->SUPER::insert($options{options} ? %{$options{options}} : ());
412   if ( $error ) {
413     $dbh->rollback if $oldAutoCommit;
414     return $error;
415   }
416
417   $self->refnum($self->cust_main->refnum) unless $self->refnum;
418   $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
419   $self->process_m2m( 'link_table'   => 'pkg_referral',
420                       'target_table' => 'part_referral',
421                       'params'       => $self->refnum,
422                     );
423
424   if ( $self->hashref->{cust_pkg_usageprice} ) {
425     for my $cust_pkg_usageprice ( @{ $self->hashref->{cust_pkg_usageprice} } ) {
426       $cust_pkg_usageprice->pkgnum( $self->pkgnum );
427       my $error = $cust_pkg_usageprice->insert;
428       if ( $error ) {
429         $dbh->rollback if $oldAutoCommit;
430         return $error;
431       }
432     }
433   }
434
435   if ( $self->setup_discountnum || $self->recur_discountnum ) {
436     my $error = $self->insert_discount();
437     if ( $error ) {
438       $dbh->rollback if $oldAutoCommit;
439       return $error;
440     }
441   }
442
443   my $conf = new FS::Conf;
444
445   if ($self->locationnum) {
446     my @part_export =
447       map qsearch( 'part_export', {exportnum=>$_} ),
448         $conf->config('cust_location-exports'); #, $agentnum
449
450     foreach my $part_export ( @part_export ) {
451       my $error = $part_export->export_pkg_location($self); #, @$export_args);
452       if ( $error ) {
453         $dbh->rollback if $oldAutoCommit;
454         return "exporting to ". $part_export->exporttype.
455                " (transaction rolled back): $error";
456       }
457     }
458   }
459
460   if ( ! $import && $conf->config('ticket_system') && $options{ticket_subject} ) {
461
462     #this init stuff is still inefficient, but at least its limited to 
463     # the small number (any?) folks using ticket emailing on pkg order
464
465     #eval '
466     #  use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
467     #  use RT;
468     #';
469     #die $@ if $@;
470     #
471     #RT::LoadConfig();
472     #RT::Init();
473     use FS::TicketSystem;
474     FS::TicketSystem->init();
475
476     my $q = new RT::Queue($RT::SystemUser);
477     $q->Load($options{ticket_queue}) if $options{ticket_queue};
478     my $t = new RT::Ticket($RT::SystemUser);
479     my $mime = new MIME::Entity;
480     $mime->build( Type => 'text/plain', Data => $options{ticket_subject} );
481     $t->Create( $options{ticket_queue} ? (Queue => $q) : (),
482                 Subject => $options{ticket_subject},
483                 MIMEObj => $mime,
484               );
485     $t->AddLink( Type   => 'MemberOf',
486                  Target => 'freeside://freeside/cust_main/'. $self->custnum,
487                );
488   }
489
490   if (! $import && $conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
491     my $queue = new FS::queue {
492       'job'     => 'FS::cust_main::queueable_print',
493     };
494     $error = $queue->insert(
495       'custnum'  => $self->custnum,
496       'template' => 'welcome_letter',
497     );
498
499     if ($error) {
500       warn "can't send welcome letter: $error";
501     }
502
503   }
504
505   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
506   '';
507
508 }
509
510 =item delete
511
512 This method now works but you probably shouldn't use it.
513
514 You don't want to delete packages, because there would then be no record
515 the customer ever purchased the package.  Instead, see the cancel method and
516 hide cancelled packages.
517
518 =cut
519
520 # this is still used internally to abort future package changes, so it 
521 # does need to work
522
523 sub delete {
524   my $self = shift;
525
526   # The following foreign keys to cust_pkg are not cleaned up here, and will
527   # cause package deletion to fail:
528   #
529   # cust_credit.pkgnum and commission_pkgnum (and cust_credit_void)
530   # cust_credit_bill.pkgnum
531   # cust_pay_pending.pkgnum
532   # cust_pay.pkgnum (and cust_pay_void)
533   # cust_bill_pay.pkgnum (wtf, shouldn't reference pkgnum)
534   # cust_pkg_usage.pkgnum
535   # cust_pkg.uncancel_pkgnum, change_pkgnum, main_pkgnum, and change_to_pkgnum
536   # rt_field_charge.pkgnum
537
538   # cust_svc is handled by canceling the package before deleting it
539   # cust_pkg_option is handled via option_Common
540
541   my $oldAutoCommit = $FS::UID::AutoCommit;
542   local $FS::UID::AutoCommit = 0;
543   my $dbh = dbh;
544
545   foreach my $cust_pkg_discount ($self->cust_pkg_discount) {
546     my $error = $cust_pkg_discount->delete;
547     if ( $error ) {
548       $dbh->rollback if $oldAutoCommit;
549       return $error;
550     }
551   }
552   #cust_bill_pkg_discount?
553
554   foreach my $cust_pkg_detail ($self->cust_pkg_detail) {
555     my $error = $cust_pkg_detail->delete;
556     if ( $error ) {
557       $dbh->rollback if $oldAutoCommit;
558       return $error;
559     }
560   }
561
562   foreach my $cust_pkg_reason (
563     qsearchs( {
564                 'table' => 'cust_pkg_reason',
565                 'hashref' => { 'pkgnum' => $self->pkgnum },
566               }
567             )
568   ) {
569     my $error = $cust_pkg_reason->delete;
570     if ( $error ) {
571       $dbh->rollback if $oldAutoCommit;
572       return $error;
573     }
574   }
575
576   foreach my $pkg_referral ( $self->pkg_referral ) {
577     my $error = $pkg_referral->delete;
578     if ( $error ) {
579       $dbh->rollback if $oldAutoCommit;
580       return $error;
581     }
582   }
583
584   my $error = $self->SUPER::delete(@_);
585   if ( $error ) {
586     $dbh->rollback if $oldAutoCommit;
587     return $error;
588   }
589
590   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
591
592   '';
593
594 }
595
596 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
597
598 Replaces the OLD_RECORD with this one in the database.  If there is an error,
599 returns the error, otherwise returns false.
600
601 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
602
603 Changing pkgpart may have disasterous effects.  See the order subroutine.
604
605 setup and bill are normally updated by calling the bill method of a customer
606 object (see L<FS::cust_main>).
607
608 suspend is normally updated by the suspend and unsuspend methods.
609
610 cancel is normally updated by the cancel method (and also the order subroutine
611 in some cases).
612
613 Available options are:
614
615 =over 4
616
617 =item reason
618
619 can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason.  The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
620
621 =item reason_otaker
622
623 the access_user (see L<FS::access_user>) providing the reason
624
625 =item options
626
627 hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
628
629 =back
630
631 =cut
632
633 sub replace {
634   my $new = shift;
635
636   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
637               ? shift
638               : $new->replace_old;
639
640   my $options = 
641     ( ref($_[0]) eq 'HASH' )
642       ? shift
643       : { @_ };
644
645   #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
646   #return "Can't change otaker!" if $old->otaker ne $new->otaker;
647
648   #allow this *sigh*
649   #return "Can't change setup once it exists!"
650   #  if $old->getfield('setup') &&
651   #     $old->getfield('setup') != $new->getfield('setup');
652
653   #some logic for bill, susp, cancel?
654
655   local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
656
657   my $oldAutoCommit = $FS::UID::AutoCommit;
658   local $FS::UID::AutoCommit = 0;
659   my $dbh = dbh;
660
661   foreach my $method ( qw(adjourn expire) ) {  # How many reasons?
662     if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
663       my $error = $new->insert_reason(
664         'reason'        => $options->{'reason'},
665         'date'          => $new->$method,
666         'action'        => $method,
667         'reason_otaker' => $options->{'reason_otaker'},
668       );
669       if ( $error ) {
670         dbh->rollback if $oldAutoCommit;
671         return "Error inserting cust_pkg_reason: $error";
672       }
673     }
674   }
675
676   #save off and freeze RADIUS attributes for any associated svc_acct records
677   my @svc_acct = ();
678   if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
679
680                 #also check for specific exports?
681                 # to avoid spurious modify export events
682     @svc_acct = map  { $_->svc_x }
683                 grep { $_->part_svc->svcdb eq 'svc_acct' }
684                      $old->cust_svc;
685
686     $_->snapshot foreach @svc_acct;
687
688   }
689
690   my $error =  $new->export_pkg_change($old)
691             || $new->SUPER::replace( $old,
692                                      $options->{options}
693                                        ? $options->{options}
694                                        : ()
695                                    );
696   if ( $error ) {
697     $dbh->rollback if $oldAutoCommit;
698     return $error;
699   }
700
701   #for prepaid packages,
702   #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
703   foreach my $old_svc_acct ( @svc_acct ) {
704     my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
705     my $s_error =
706       $new_svc_acct->replace( $old_svc_acct,
707                               'depend_jobnum' => $options->{depend_jobnum},
708                             );
709     if ( $s_error ) {
710       $dbh->rollback if $oldAutoCommit;
711       return $s_error;
712     }
713   }
714
715   # also run exports if removing locationnum?
716   #   doesn't seem to happen, and we don't export blank locationnum on insert...
717   if ($new->locationnum and ($new->locationnum != $old->locationnum)) {
718     my $conf = new FS::Conf;
719     my @part_export =
720       map qsearch( 'part_export', {exportnum=>$_} ),
721         $conf->config('cust_location-exports'); #, $agentnum
722
723     foreach my $part_export ( @part_export ) {
724       my $error = $part_export->export_pkg_location($new); #, @$export_args);
725       if ( $error ) {
726         $dbh->rollback if $oldAutoCommit;
727         return "exporting to ". $part_export->exporttype.
728                " (transaction rolled back): $error";
729       }
730     }
731   }
732
733   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
734   '';
735
736 }
737
738 =item check
739
740 Checks all fields to make sure this is a valid billing item.  If there is an
741 error, returns the error, otherwise returns false.  Called by the insert and
742 replace methods.
743
744 =cut
745
746 sub check {
747   my $self = shift;
748
749   if ( !$self->locationnum or $self->locationnum == -1 ) {
750     $self->set('locationnum', $self->cust_main->ship_locationnum);
751   }
752
753   my $error = 
754     $self->ut_numbern('pkgnum')
755     || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
756     || $self->ut_numbern('pkgpart')
757     || $self->ut_foreign_keyn('contactnum',  'contact',       'contactnum' )
758     || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
759     || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
760     || $self->ut_numbern('quantity')
761     || $self->ut_numbern('start_date')
762     || $self->ut_numbern('setup')
763     || $self->ut_numbern('bill')
764     || $self->ut_numbern('susp')
765     || $self->ut_numbern('cancel')
766     || $self->ut_numbern('adjourn')
767     || $self->ut_numbern('resume')
768     || $self->ut_numbern('expire')
769     || $self->ut_numbern('dundate')
770     || $self->ut_flag('no_auto', [ '', 'Y' ])
771     || $self->ut_flag('waive_setup', [ '', 'Y' ])
772     || $self->ut_flag('separate_bill')
773     || $self->ut_textn('agent_pkgid')
774     || $self->ut_enum('recur_show_zero', [ '', 'Y', 'N', ])
775     || $self->ut_enum('setup_show_zero', [ '', 'Y', 'N', ])
776     || $self->ut_foreign_keyn('main_pkgnum', 'cust_pkg', 'pkgnum')
777     || $self->ut_foreign_keyn('pkglinknum', 'part_pkg_link', 'pkglinknum')
778     || $self->ut_foreign_keyn('change_to_pkgnum', 'cust_pkg', 'pkgnum')
779   ;
780   return $error if $error;
781
782   return "A package with both start date (future start) and setup date (already started) will never bill"
783     if $self->start_date && $self->setup && ! $upgrade;
784
785   return "A future unsuspend date can only be set for a package with a suspend date"
786     if $self->resume and !$self->susp and !$self->adjourn;
787
788   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
789
790   $self->SUPER::check;
791 }
792
793 =item check_pkgpart
794
795 Check the pkgpart to make sure it's allowed with the reg_code and/or
796 promo_code of the package (if present) and with the customer's agent.
797 Called from C<insert>, unless we are doing a package change that doesn't
798 affect pkgpart.
799
800 =cut
801
802 sub check_pkgpart {
803   my $self = shift;
804
805   # my $error = $self->ut_numbern('pkgpart'); # already done
806
807   my $error;
808   if ( $self->reg_code ) {
809
810     unless ( grep { $self->pkgpart == $_->pkgpart }
811              map  { $_->reg_code_pkg }
812              qsearchs( 'reg_code', { 'code'     => $self->reg_code,
813                                      'agentnum' => $self->cust_main->agentnum })
814            ) {
815       return "Unknown registration code";
816     }
817
818   } elsif ( $self->promo_code ) {
819
820     my $promo_part_pkg =
821       qsearchs('part_pkg', {
822         'pkgpart'    => $self->pkgpart,
823         'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
824       } );
825     return 'Unknown promotional code' unless $promo_part_pkg;
826
827   } else { 
828
829     unless ( $disable_agentcheck ) {
830       my $agent =
831         qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
832       return "agent ". $agent->agentnum. ':'. $agent->agent.
833              " can't purchase pkgpart ". $self->pkgpart
834         unless $agent->pkgpart_hashref->{ $self->pkgpart }
835             || $agent->agentnum == $self->part_pkg->agentnum;
836     }
837
838     $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
839     return $error if $error;
840
841   }
842
843   '';
844
845 }
846
847 =item cancel [ OPTION => VALUE ... ]
848
849 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
850 in this package, then cancels the package itself (sets the cancel field to
851 now).
852
853 Available options are:
854
855 =over 4
856
857 =item quiet - can be set true to supress email cancellation notices.
858
859 =item time -  can be set to cancel the package based on a specific future or 
860 historical date.  Using time ensures that the remaining amount is calculated 
861 correctly.  Note however that this is an immediate cancel and just changes 
862 the date.  You are PROBABLY looking to expire the account instead of using 
863 this.
864
865 =item reason - can be set to a cancellation reason (see L<FS:reason>), 
866 either a reasonnum of an existing reason, or passing a hashref will create 
867 a new reason.  The hashref should have the following keys: typenum - Reason 
868 type (see L<FS::reason_type>, reason - Text of the new reason.
869
870 =item date - can be set to a unix style timestamp to specify when to 
871 cancel (expire)
872
873 =item nobill - can be set true to skip billing if it might otherwise be done.
874
875 =item unused_credit - can be set to 1 to credit the remaining time, or 0 to 
876 not credit it.  This must be set (by change()) when changing the package 
877 to a different pkgpart or location, and probably shouldn't be in any other 
878 case.  If it's not set, the 'unused_credit_cancel' part_pkg option will 
879 be used.
880
881 =item no_delay_cancel - prevents delay_cancel behavior
882 no matter what other options say, for use when changing packages (or any
883 other time you're really sure you want an immediate cancel)
884
885 =back
886
887 If there is an error, returns the error, otherwise returns false.
888
889 =cut
890
891 #NOT DOCUMENTING - this should only be used when calling recursively
892 #=item delay_cancel - for internal use, to allow proper handling of
893 #supplemental packages when the main package is flagged to suspend 
894 #before cancelling, probably shouldn't be used otherwise (set the
895 #corresponding package option instead)
896
897 sub cancel {
898   my( $self, %options ) = @_;
899   my $error;
900
901   # supplemental packages can now be separately canceled, though the UI
902   # shouldn't permit it
903   #
904   ## pass all suspend/cancel actions to the main package
905   ## (unless the pkglinknum has been removed, then the link is defunct and
906   ## this package can be canceled on its own)
907   #if ( $self->main_pkgnum and $self->pkglinknum and !$options{'from_main'} ) {
908   #  return $self->main_pkg->cancel(%options);
909   #}
910
911   my $conf = new FS::Conf;
912
913   warn "cust_pkg::cancel called with options".
914        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
915     if $DEBUG;
916
917   my $oldAutoCommit = $FS::UID::AutoCommit;
918   local $FS::UID::AutoCommit = 0;
919   my $dbh = dbh;
920   
921   my $old = $self->select_for_update;
922
923   if ( $old->get('cancel') || $self->get('cancel') ) {
924     dbh->rollback if $oldAutoCommit;
925     return "";  # no error
926   }
927
928   # XXX possibly set cancel_time to the expire date?
929   my $cancel_time = $options{'time'} || time;
930   my $date = $options{'date'} if $options{'date'}; # expire/cancel later
931   $date = '' if ($date && $date <= $cancel_time);      # complain instead?
932
933   my $delay_cancel = $options{'no_delay_cancel'} ? 0 : $options{'delay_cancel'};
934   if ( !$date && $self->part_pkg->option('delay_cancel',1)
935        && (($self->status eq 'active') || ($self->status eq 'suspended'))
936        && !$options{'no_delay_cancel'}
937   ) {
938     my $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
939     my $expsecs = 60*60*24*$expdays;
940     my $suspfor = $self->susp ? $cancel_time - $self->susp : 0;
941     $expsecs = $expsecs - $suspfor if $suspfor;
942     unless ($expsecs <= 0) { #if it's already been suspended long enough, don't re-suspend
943       $delay_cancel = 1;
944       $date = $cancel_time + $expsecs;
945     }
946   }
947
948   #race condition: usage could be ongoing until unprovisioned
949   #resolved by performing a change package instead (which unprovisions) and
950   #later cancelling
951   if ( !$options{nobill} && !$date ) {
952     # && $conf->exists('bill_usage_on_cancel') ) { #calc_cancel checks this
953       my $copy = $self->new({$self->hash});
954       my $error =
955         $copy->cust_main->bill( 'pkg_list' => [ $copy ], 
956                                 'cancel'   => 1,
957                                 'time'     => $cancel_time );
958       warn "Error billing during cancel, custnum ".
959         #$self->cust_main->custnum. ": $error"
960         ": $error"
961         if $error;
962   }
963
964   if ( $options{'reason'} ) {
965     $error = $self->insert_reason( 'reason' => $options{'reason'},
966                                    'action' => $date ? 'expire' : 'cancel',
967                                    'date'   => $date ? $date : $cancel_time,
968                                    'reason_otaker' => $options{'reason_otaker'},
969                                  );
970     if ( $error ) {
971       dbh->rollback if $oldAutoCommit;
972       return "Error inserting cust_pkg_reason: $error";
973     }
974   }
975
976   my %svc_cancel_opt = ();
977   $svc_cancel_opt{'date'} = $date if $date;
978   foreach my $cust_svc (
979     #schwartz
980     map  { $_->[0] }
981     sort { $a->[1] <=> $b->[1] }
982     map  { [ $_, $_->svc_x ? $_->svc_x->table_info->{'cancel_weight'} : -1 ]; }
983     qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
984   ) {
985     my $part_svc = $cust_svc->part_svc;
986     next if ( defined($part_svc) and $part_svc->preserve );
987     my $error = $cust_svc->cancel( %svc_cancel_opt );
988
989     if ( $error ) {
990       $dbh->rollback if $oldAutoCommit;
991       return 'Error '. ($svc_cancel_opt{'date'} ? 'expiring' : 'canceling' ).
992              " cust_svc: $error";
993     }
994   }
995
996   # if a reasonnum was passed, get the actual reason object so we can check
997   # unused_credit
998
999   my $reason;
1000   if ($options{'reason'} =~ /^\d+$/) {
1001     $reason = FS::reason->by_key($options{'reason'});
1002   }
1003
1004   unless ($date) {
1005     # credit remaining time if any of these are true:
1006     # - unused_credit => 1 was passed (this happens when canceling a package
1007     #   for a package change when unused_credit_change is set)
1008     # - no unused_credit option, and there is a cancel reason, and the cancel
1009     #   reason says to credit the package
1010     # - no unused_credit option, and the package definition says to credit the
1011     #   package on cancellation
1012     my $do_credit;
1013     if ( exists($options{'unused_credit'}) ) {
1014       $do_credit = $options{'unused_credit'};
1015     } elsif ( defined($reason) && $reason->unused_credit ) {
1016       $do_credit = 1;
1017     } else {
1018       $do_credit = $self->part_pkg->option('unused_credit_cancel', 1);
1019     }
1020     if ( $do_credit ) {
1021       my $error = $self->credit_remaining('cancel', $cancel_time);
1022       if ($error) {
1023         $dbh->rollback if $oldAutoCommit;
1024         return $error;
1025       }
1026     }
1027   } #unless $date
1028
1029   my %hash = $self->hash;
1030   if ( $date ) {
1031     $hash{'expire'} = $date;
1032     if ($delay_cancel) {
1033       # just to be sure these are clear
1034       $hash{'adjourn'} = undef;
1035       $hash{'resume'} = undef;
1036     }
1037   } else {
1038     $hash{'cancel'} = $cancel_time;
1039   }
1040   $hash{'change_custnum'} = $options{'change_custnum'};
1041
1042   # if this is a supplemental package that's lost its part_pkg_link, and it's
1043   # being canceled for real, unlink it completely
1044   if ( !$date and ! $self->pkglinknum ) {
1045     $hash{main_pkgnum} = '';
1046   }
1047
1048   # if there is a future package change scheduled, unlink from it (like
1049   # abort_change) first, then delete it.
1050   $hash{'change_to_pkgnum'} = '';
1051
1052   # save the package state
1053   my $new = new FS::cust_pkg ( \%hash );
1054   $error = $new->replace( $self, options => { $self->options } );
1055
1056   if ( $self->change_to_pkgnum ) {
1057     my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
1058     $error ||= $change_to->cancel('no_delay_cancel' => 1) || $change_to->delete;
1059   }
1060   if ( $error ) {
1061     $dbh->rollback if $oldAutoCommit;
1062     return $error;
1063   }
1064
1065   foreach my $supp_pkg ( $self->supplemental_pkgs ) {
1066     $error = $supp_pkg->cancel(%options, 
1067       'from_main' => 1, 
1068       'date' => $date, #in case it got changed by delay_cancel
1069       'delay_cancel' => $delay_cancel,
1070     );
1071     if ( $error ) {
1072       $dbh->rollback if $oldAutoCommit;
1073       return "canceling supplemental pkg#".$supp_pkg->pkgnum.": $error";
1074     }
1075   }
1076
1077   if ($delay_cancel && !$options{'from_main'}) {
1078     $error = $new->suspend(
1079       'from_cancel' => 1,
1080       'time'        => $cancel_time
1081     );
1082   }
1083
1084   unless ($date) {
1085     foreach my $usage ( $self->cust_pkg_usage ) {
1086       $error = $usage->delete;
1087       if ( $error ) {
1088         $dbh->rollback if $oldAutoCommit;
1089         return "deleting usage pools: $error";
1090       }
1091     }
1092   }
1093
1094   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1095   return '' if $date; #no errors
1096
1097   my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
1098   if ( !$options{'quiet'} && 
1099         $conf->exists('emailcancel', $self->cust_main->agentnum) && 
1100         @invoicing_list ) {
1101     my $msgnum = $conf->config('cancel_msgnum', $self->cust_main->agentnum);
1102     my $error = '';
1103     if ( $msgnum ) {
1104       my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
1105       $error = $msg_template->send( 'cust_main' => $self->cust_main,
1106                                     'object'    => $self );
1107     }
1108     #should this do something on errors?
1109   }
1110
1111   ''; #no errors
1112
1113 }
1114
1115 =item cancel_if_expired [ NOW_TIMESTAMP ]
1116
1117 Cancels this package if its expire date has been reached.
1118
1119 =cut
1120
1121 sub cancel_if_expired {
1122   my $self = shift;
1123   my $time = shift || time;
1124   return '' unless $self->expire && $self->expire <= $time;
1125   my $error = $self->cancel;
1126   if ( $error ) {
1127     return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
1128            $self->custnum. ": $error";
1129   }
1130   '';
1131 }
1132
1133 =item uncancel_svc_x
1134
1135 For cancelled cust_pkg, returns a list of new, uninserted FS::svc_X records 
1136 for services that would be inserted by L</uncancel>.  Returned objects also
1137 include the field _h_svc_x, which contains the service history object.
1138
1139 Set pkgnum before inserting.
1140
1141 Accepts the following options:
1142
1143 only_svcnum - arrayref of svcnum, only returns objects for these svcnum 
1144 (and only if they would otherwise be returned by this)
1145
1146 =cut
1147
1148 sub uncancel_svc_x {
1149   my ($self, %opt) = @_;
1150
1151   die 'uncancel_svc_x called on a non-cancelled cust_pkg' unless $self->get('cancel');
1152
1153   #find historical services within this timeframe before the package cancel
1154   # (incompatible with "time" option to cust_pkg->cancel?)
1155   my $fuzz = 2 * 60; #2 minutes?  too much?   (might catch separate unprovision)
1156                      #            too little? (unprovisioing export delay?)
1157   my($end, $start) = ( $self->get('cancel'), $self->get('cancel') - $fuzz );
1158   my @h_cust_svc = $self->h_cust_svc( $end, $start );
1159
1160   my @svc_x;
1161   foreach my $h_cust_svc (@h_cust_svc) {
1162     next if $opt{'only_svcnum'} && !(grep { $_ == $h_cust_svc->svcnum } @{$opt{'only_svcnum'}});
1163     # filter out services that still exist on this package (ie preserved svcs)
1164     # but keep services that have since been provisioned on another package (for informational purposes)
1165     next if qsearchs('cust_svc',{ 'svcnum' => $h_cust_svc->svcnum, 'pkgnum' => $self->pkgnum });
1166     my $h_svc_x = $h_cust_svc->h_svc_x( $end, $start );
1167     next unless $h_svc_x; # this probably doesn't happen, but just in case
1168     (my $table = $h_svc_x->table) =~ s/^h_//;
1169     require "FS/$table.pm";
1170     my $class = "FS::$table";
1171     my $svc_x = $class->new( {
1172       'svcpart' => $h_cust_svc->svcpart,
1173       '_h_svc_x' => $h_svc_x,
1174       map { $_ => $h_svc_x->get($_) } fields($table)
1175     } );
1176
1177     # radius_usergroup
1178     if ( $h_svc_x->isa('FS::h_svc_Radius_Mixin') ) {
1179       $svc_x->usergroup( [ $h_svc_x->h_usergroup($end, $start) ] );
1180     }
1181
1182     #these are pretty rare, but should handle them
1183     # - dsl_device (mac addresses)
1184     # - phone_device (mac addresses)
1185     # - dsl_note (ikano notes)
1186     # - domain_record (i.e. restore DNS information w/domains)
1187     # - inventory_item(?) (inventory w/un-cancelling service?)
1188     # - nas (svc_broaband nas stuff)
1189     #this stuff is unused in the wild afaik
1190     # - mailinglistmember
1191     # - router.svcnum?
1192     # - svc_domain.parent_svcnum?
1193     # - acct_snarf (ancient mail fetching config)
1194     # - cgp_rule (communigate)
1195     # - cust_svc_option (used by our Tron stuff)
1196     # - acct_rt_transaction (used by our time worked stuff)
1197
1198     push @svc_x, $svc_x;
1199   }
1200   return @svc_x;
1201 }
1202
1203 =item uncancel_svc_summary
1204
1205 Returns an array of hashrefs, one for each service that could 
1206 potentially be reprovisioned by L</uncancel>, with the following keys:
1207
1208 svcpart
1209
1210 svc
1211
1212 uncancel_svcnum
1213
1214 label - from history table if not currently calculable, undefined if it can't be loaded
1215
1216 reprovisionable - 1 if test reprovision succeeded, otherwise 0
1217
1218 num_cust_svc - number of svcs for this svcpart, only if summarizing (see below)
1219
1220 Cannot be run from within a transaction.  Performs inserts
1221 to test the results, and then rolls back the transaction.
1222 Does not perform exports, so does not catch if export would fail.
1223
1224 Also accepts the following options:
1225
1226 no_test_reprovision - skip the test inserts (reprovisionable field will not exist)
1227
1228 summarize_size - if true, returns a single summary record for svcparts with at
1229 least this many svcs, will have key num_cust_svc but not uncancel_svcnum, label or reprovisionable
1230
1231 =cut
1232
1233 sub uncancel_svc_summary {
1234   my ($self, %opt) = @_;
1235
1236   die 'uncancel_svc_summary called on a non-cancelled cust_pkg' unless $self->get('cancel');
1237   die 'uncancel_svc_summary called from within a transaction' unless $FS::UID::AutoCommit;
1238
1239   local $FS::svc_Common::noexport_hack = 1; # very important not to run exports!!!
1240   local $FS::UID::AutoCommit = 0;
1241
1242   # sort by svcpart, to check summarize_size
1243   my $uncancel_svc_x = {};
1244   foreach my $svc_x (sort { $a->{'svcpart'} <=> $b->{'svcpart'} } $self->uncancel_svc_x) {
1245     $uncancel_svc_x->{$svc_x->svcpart} = [] unless $uncancel_svc_x->{$svc_x->svcpart};
1246     push @{$uncancel_svc_x->{$svc_x->svcpart}}, $svc_x;
1247   }
1248
1249   my @out;
1250   foreach my $svcpart (keys %$uncancel_svc_x) {
1251     my @svcpart_svc_x = @{$uncancel_svc_x->{$svcpart}};
1252     if ($opt{'summarize_size'} && (@svcpart_svc_x >= $opt{'summarize_size'})) {
1253       my $svc_x = $svcpart_svc_x[0]; #grab first one for access to $part_svc
1254       my $part_svc = $svc_x->part_svc;
1255       push @out, {
1256         'svcpart'      => $part_svc->svcpart,
1257         'svc'          => $part_svc->svc,
1258         'num_cust_svc' => scalar(@svcpart_svc_x),
1259       };
1260     } else {
1261       foreach my $svc_x (@svcpart_svc_x) {
1262         my $part_svc = $svc_x->part_svc;
1263         my $out = {
1264           'svcpart' => $part_svc->svcpart,
1265           'svc'     => $part_svc->svc,
1266           'uncancel_svcnum' => $svc_x->get('_h_svc_x')->svcnum,
1267         };
1268         $svc_x->pkgnum($self->pkgnum); # provisioning services on a canceled package, will be rolled back
1269         my $insert_error;
1270         unless ($opt{'no_test_reprovision'}) {
1271           # avoid possibly fatal errors from missing linked records
1272           eval { $insert_error = $svc_x->insert };
1273           $insert_error ||= $@;
1274         }
1275         if ($opt{'no_test_reprovision'} or $insert_error) {
1276           # avoid possibly fatal errors from missing linked records
1277           eval { $out->{'label'} = $svc_x->label };
1278           eval { $out->{'label'} = $svc_x->get('_h_svc_x')->label } unless defined($out->{'label'});
1279           $out->{'reprovisionable'} = 0 unless $opt{'no_test_reprovision'};
1280         } else {
1281           $out->{'label'} = $svc_x->label;
1282           $out->{'reprovisionable'} = 1;
1283         }
1284         push @out, $out;
1285       }
1286     }
1287   }
1288
1289   dbh->rollback;
1290   return @out;
1291 }
1292
1293 =item uncancel
1294
1295 "Un-cancels" this package: Orders a new package with the same custnum, pkgpart,
1296 locationnum, (other fields?).  Attempts to re-provision cancelled services
1297 using history information (errors at this stage are not fatal).
1298
1299 cust_pkg: pass a scalar reference, will be filled in with the new cust_pkg object
1300
1301 svc_fatal: service provisioning errors are fatal
1302
1303 svc_errors: pass an array reference, will be filled in with any provisioning errors
1304
1305 only_svcnum: arrayref, only attempt to re-provision these cancelled services
1306
1307 main_pkgnum: link the package as a supplemental package of this one.  For 
1308 internal use only.
1309
1310 =cut
1311
1312 sub uncancel {
1313   my( $self, %options ) = @_;
1314
1315   #in case you try do do $uncancel-date = $cust_pkg->uncacel 
1316   return '' unless $self->get('cancel');
1317
1318   if ( $self->main_pkgnum and !$options{'main_pkgnum'} ) {
1319     return $self->main_pkg->uncancel(%options);
1320   }
1321
1322   ##
1323   # Transaction-alize
1324   ##
1325
1326   my $oldAutoCommit = $FS::UID::AutoCommit;
1327   local $FS::UID::AutoCommit = 0;
1328   my $dbh = dbh;
1329
1330   ##
1331   # insert the new package
1332   ##
1333
1334   my $cust_pkg = new FS::cust_pkg {
1335     last_bill       => ( $options{'last_bill'} || $self->get('last_bill') ),
1336     bill            => ( $options{'bill'}      || $self->get('bill')      ),
1337     uncancel        => time,
1338     uncancel_pkgnum => $self->pkgnum,
1339     main_pkgnum     => ($options{'main_pkgnum'} || ''),
1340     map { $_ => $self->get($_) } qw(
1341       custnum pkgpart locationnum
1342       setup
1343       susp adjourn resume expire start_date contract_end dundate
1344       change_date change_pkgpart change_locationnum
1345       no_auto separate_bill quantity agent_pkgid 
1346       recur_show_zero setup_show_zero
1347     ),
1348   };
1349
1350   my $error = $cust_pkg->insert(
1351     'change' => 1, #supresses any referral credit to a referring customer
1352     'allow_pkgpart' => 1, # allow this even if the package def is disabled
1353   );
1354   if ($error) {
1355     $dbh->rollback if $oldAutoCommit;
1356     return $error;
1357   }
1358
1359   ##
1360   # insert services
1361   ##
1362
1363   my @svc_errors;
1364   foreach my $svc_x ($self->uncancel_svc_x('only_svcnum' => $options{'only_svcnum'})) {
1365
1366     $svc_x->pkgnum($cust_pkg->pkgnum);
1367     my $svc_error = $svc_x->insert;
1368
1369     if ( $svc_error ) {
1370       if ( $options{svc_fatal} ) {
1371         $dbh->rollback if $oldAutoCommit;
1372         return $svc_error;
1373       } else {
1374         # if we've failed to insert the svc_x object, svc_Common->insert 
1375         # will have removed the cust_svc already.  if not, then both records
1376         # were inserted but we failed for some other reason (export, most 
1377         # likely).  in that case, report the error and delete the records.
1378         push @svc_errors, $svc_error;
1379         my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_x->svcnum });
1380         if ( $cust_svc ) {
1381           # except if export_insert failed, export_delete probably won't be
1382           # much better
1383           local $FS::svc_Common::noexport_hack = 1;
1384           my $cleanup_error = $svc_x->delete; # also deletes cust_svc
1385           if ( $cleanup_error ) { # and if THAT fails, then run away
1386             $dbh->rollback if $oldAutoCommit;
1387             return $cleanup_error;
1388           }
1389         }
1390       } # svc_fatal
1391     } # svc_error
1392   } #foreach uncancel_svc_x
1393
1394   ##
1395   # also move over any services that didn't unprovision at cancellation
1396   ## 
1397
1398   foreach my $cust_svc ( qsearch('cust_svc', { pkgnum => $self->pkgnum } ) ) {
1399     $cust_svc->pkgnum( $cust_pkg->pkgnum );
1400     my $error = $cust_svc->replace;
1401     if ( $error ) {
1402       $dbh->rollback if $oldAutoCommit;
1403       return $error;
1404     }
1405   }
1406
1407   ##
1408   # Uncancel any supplemental packages, and make them supplemental to the 
1409   # new one.
1410   ##
1411
1412   foreach my $supp_pkg ( $self->supplemental_pkgs ) {
1413     my $new_pkg;
1414     $error = $supp_pkg->uncancel(%options, 'main_pkgnum' => $cust_pkg->pkgnum);
1415     if ( $error ) {
1416       $dbh->rollback if $oldAutoCommit;
1417       return "canceling supplemental pkg#".$supp_pkg->pkgnum.": $error";
1418     }
1419   }
1420
1421   ##
1422   # Finish
1423   ##
1424
1425   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1426
1427   ${ $options{cust_pkg} }   = $cust_pkg   if ref($options{cust_pkg});
1428   @{ $options{svc_errors} } = @svc_errors if ref($options{svc_errors});
1429
1430   '';
1431 }
1432
1433 =item unexpire
1434
1435 Cancels any pending expiration (sets the expire field to null)
1436 for this package and any supplemental packages.
1437
1438 If there is an error, returns the error, otherwise returns false.
1439
1440 =cut
1441
1442 sub unexpire {
1443   my( $self ) = @_;
1444   my $error;
1445
1446   my $oldAutoCommit = $FS::UID::AutoCommit;
1447   local $FS::UID::AutoCommit = 0;
1448   my $dbh = dbh;
1449
1450   my $old = $self->select_for_update;
1451
1452   my $pkgnum = $old->pkgnum;
1453   if ( $old->get('cancel') || $self->get('cancel') ) {
1454     dbh->rollback if $oldAutoCommit;
1455     return "Can't unexpire cancelled package $pkgnum";
1456     # or at least it's pointless
1457   }
1458
1459   unless ( $old->get('expire') && $self->get('expire') ) {
1460     dbh->rollback if $oldAutoCommit;
1461     return "";  # no error
1462   }
1463
1464   my %hash = $self->hash;
1465   $hash{'expire'} = '';
1466   my $new = new FS::cust_pkg ( \%hash );
1467   $error = $new->replace( $self, options => { $self->options } );
1468   if ( $error ) {
1469     $dbh->rollback if $oldAutoCommit;
1470     return $error;
1471   }
1472
1473   foreach my $supp_pkg ( $self->supplemental_pkgs ) {
1474     $error = $supp_pkg->unexpire;
1475     if ( $error ) {
1476       $dbh->rollback if $oldAutoCommit;
1477       return "unexpiring supplemental pkg#".$supp_pkg->pkgnum.": $error";
1478     }
1479   }
1480
1481   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1482
1483   ''; #no errors
1484
1485 }
1486
1487 =item suspend [ OPTION => VALUE ... ]
1488
1489 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
1490 package, then suspends the package itself (sets the susp field to now).
1491
1492 Available options are:
1493
1494 =over 4
1495
1496 =item reason - can be set to a cancellation reason (see L<FS:reason>),
1497 either a reasonnum of an existing reason, or passing a hashref will create 
1498 a new reason.  The hashref should have the following keys: 
1499 - typenum - Reason type (see L<FS::reason_type>
1500 - reason - Text of the new reason.
1501
1502 =item date - can be set to a unix style timestamp to specify when to 
1503 suspend (adjourn)
1504
1505 =item time - can be set to override the current time, for calculation 
1506 of final invoices or unused-time credits
1507
1508 =item resume_date - can be set to a time when the package should be 
1509 unsuspended.  This may be more convenient than calling C<unsuspend()>
1510 separately.
1511
1512 =item from_main - allows a supplemental package to be suspended, rather
1513 than redirecting the method call to its main package.  For internal use.
1514
1515 =item from_cancel - used when suspending from the cancel method, forces
1516 this to skip everything besides basic suspension.  For internal use.
1517
1518 =back
1519
1520 If there is an error, returns the error, otherwise returns false.
1521
1522 =cut
1523
1524 sub suspend {
1525   my( $self, %options ) = @_;
1526   my $error;
1527
1528   # supplemental packages still can't be separately suspended, but silently
1529   # exit instead of failing or passing the action to the main package (so
1530   # that the "Suspend customer" action doesn't trip over the supplemental
1531   # packages and die)
1532
1533   if ( $self->main_pkgnum and !$options{'from_main'} ) {
1534     return;
1535   }
1536
1537   my $oldAutoCommit = $FS::UID::AutoCommit;
1538   local $FS::UID::AutoCommit = 0;
1539   my $dbh = dbh;
1540
1541   my $old = $self->select_for_update;
1542
1543   my $pkgnum = $old->pkgnum;
1544   if ( $old->get('cancel') || $self->get('cancel') ) {
1545     dbh->rollback if $oldAutoCommit;
1546     return "Can't suspend cancelled package $pkgnum";
1547   }
1548
1549   if ( $old->get('susp') || $self->get('susp') ) {
1550     dbh->rollback if $oldAutoCommit;
1551     return "";  # no error                     # complain on adjourn?
1552   }
1553
1554   my $suspend_time = $options{'time'} || time;
1555   my $date = $options{date} if $options{date}; # adjourn/suspend later
1556   $date = '' if ($date && $date <= $suspend_time); # complain instead?
1557
1558   if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
1559     dbh->rollback if $oldAutoCommit;
1560     return "Package $pkgnum expires before it would be suspended.";
1561   }
1562
1563   # some false laziness with sub cancel
1564   if ( !$options{nobill} && !$date && !$options{'from_cancel'} &&
1565        $self->part_pkg->option('bill_suspend_as_cancel',1) ) {
1566     # kind of a kludge--'bill_suspend_as_cancel' to avoid having to 
1567     # make the entire cust_main->bill path recognize 'suspend' and 
1568     # 'cancel' separately.
1569     warn "Billing $pkgnum on suspension (at $suspend_time)\n" if $DEBUG;
1570     my $copy = $self->new({$self->hash});
1571     my $error =
1572       $copy->cust_main->bill( 'pkg_list' => [ $copy ], 
1573                               'cancel'   => 1,
1574                               'time'     => $suspend_time );
1575     warn "Error billing during suspend, custnum ".
1576       #$self->cust_main->custnum. ": $error"
1577       ": $error"
1578       if $error;
1579   }
1580
1581   my $cust_pkg_reason;
1582   if ( $options{'reason'} ) {
1583     $error = $self->insert_reason( 'reason' => $options{'reason'},
1584                                    'action' => $date ? 'adjourn' : 'suspend',
1585                                    'date'   => $date ? $date : $suspend_time,
1586                                    'reason_otaker' => $options{'reason_otaker'},
1587                                  );
1588     if ( $error ) {
1589       dbh->rollback if $oldAutoCommit;
1590       return "Error inserting cust_pkg_reason: $error";
1591     }
1592     $cust_pkg_reason = qsearchs('cust_pkg_reason', {
1593         'date'    => $date ? $date : $suspend_time,
1594         'action'  => $date ? 'A' : 'S',
1595         'pkgnum'  => $self->pkgnum,
1596     });
1597   }
1598
1599   # if a reasonnum was passed, get the actual reason object so we can check
1600   # unused_credit
1601   # (passing a reason hashref is still allowed, but it can't be used with
1602   # the fancy behavioral options.)
1603
1604   my $reason;
1605   if ($options{'reason'} =~ /^\d+$/) {
1606     $reason = FS::reason->by_key($options{'reason'});
1607   }
1608
1609   my %hash = $self->hash;
1610   if ( $date ) {
1611     $hash{'adjourn'} = $date;
1612   } else {
1613     $hash{'susp'} = $suspend_time;
1614   }
1615
1616   my $resume_date = $options{'resume_date'} || 0;
1617   if ( $resume_date > ($date || $suspend_time) ) {
1618     $hash{'resume'} = $resume_date;
1619   }
1620
1621   $options{options} ||= {};
1622
1623   my $new = new FS::cust_pkg ( \%hash );
1624   $error = $new->replace( $self, options => { $self->options,
1625                                               %{ $options{options} },
1626                                             }
1627                         );
1628   if ( $error ) {
1629     $dbh->rollback if $oldAutoCommit;
1630     return $error;
1631   }
1632
1633   unless ( $date ) { # then we are suspending now
1634
1635     unless ($options{'from_cancel'}) {
1636       # credit remaining time if appropriate
1637       # (if required by the package def, or the suspend reason)
1638       my $unused_credit = $self->part_pkg->option('unused_credit_suspend',1)
1639                           || ( defined($reason) && $reason->unused_credit );
1640
1641       if ( $unused_credit ) {
1642         warn "crediting unused time on pkg#".$self->pkgnum."\n" if $DEBUG;
1643         my $error = $self->credit_remaining('suspend', $suspend_time);
1644         if ($error) {
1645           $dbh->rollback if $oldAutoCommit;
1646           return $error;
1647         }
1648       }
1649     }
1650
1651     my @cust_svc = qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
1652
1653     #attempt ordering ala cust_svc_suspend_cascade (without infinite-looping
1654     # on the circular dep case)
1655     #  (this is too simple for multi-level deps, we need to use something
1656     #   to resolve the DAG properly when possible)
1657     my %svcpart = ();
1658     $svcpart{$_->svcpart} = 0 foreach @cust_svc;
1659     foreach my $svcpart ( keys %svcpart ) {
1660       foreach my $part_svc_link (
1661         FS::part_svc_link->by_agentnum($self->cust_main->agentnum,
1662                                          src_svcpart => $svcpart,
1663                                          link_type => 'cust_svc_suspend_cascade'
1664                                       )
1665       ) {
1666         $svcpart{$part_svc_link->dst_svcpart} = max(
1667           $svcpart{$part_svc_link->dst_svcpart},
1668           $svcpart{$part_svc_link->src_svcpart} + 1
1669         );
1670       }
1671     }
1672     @cust_svc = sort { $svcpart{ $a->svcpart } <=> $svcpart{ $b->svcpart } }
1673                   @cust_svc;
1674
1675     my @labels = ();
1676     foreach my $cust_svc ( @cust_svc ) {
1677       $cust_svc->suspend( 'labels_arrayref' => \@labels );
1678     }
1679
1680     # suspension fees: if there is a feepart, and it's not an unsuspend fee,
1681     # and this is not a suspend-before-cancel
1682     if ( $cust_pkg_reason ) {
1683       my $reason_obj = $cust_pkg_reason->reason;
1684       if ( $reason_obj->feepart and
1685            ! $reason_obj->fee_on_unsuspend and
1686            ! $options{'from_cancel'} ) {
1687
1688         # register the need to charge a fee, cust_main->bill will do the rest
1689         warn "registering suspend fee: pkgnum ".$self->pkgnum.", feepart ".$reason->feepart."\n"
1690           if $DEBUG;
1691         my $cust_pkg_reason_fee = FS::cust_pkg_reason_fee->new({
1692             'pkgreasonnum'  => $cust_pkg_reason->num,
1693             'pkgnum'        => $self->pkgnum,
1694             'feepart'       => $reason->feepart,
1695             'nextbill'      => $reason->fee_hold,
1696         });
1697         $error ||= $cust_pkg_reason_fee->insert;
1698       }
1699     }
1700
1701     my $conf = new FS::Conf;
1702     if ( $conf->config('suspend_email_admin') && !$options{'from_cancel'} ) {
1703  
1704       my $error = send_email(
1705         'from'    => $conf->config('invoice_from', $self->cust_main->agentnum),
1706                                    #invoice_from ??? well as good as any
1707         'to'      => $conf->config('suspend_email_admin'),
1708         'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
1709         'body'    => [
1710           "This is an automatic message from your Freeside installation\n",
1711           "informing you that the following customer package has been suspended:\n",
1712           "\n",
1713           'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
1714           'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
1715           ( map { "Service : $_\n" } @labels ),
1716         ],
1717         'custnum' => $self->custnum,
1718         'msgtype' => 'admin'
1719       );
1720
1721       if ( $error ) {
1722         warn "WARNING: can't send suspension admin email (suspending anyway): ".
1723              "$error\n";
1724       }
1725
1726     }
1727
1728   }
1729
1730   foreach my $supp_pkg ( $self->supplemental_pkgs ) {
1731     $error = $supp_pkg->suspend(%options, 'from_main' => 1);
1732     if ( $error ) {
1733       $dbh->rollback if $oldAutoCommit;
1734       return "suspending supplemental pkg#".$supp_pkg->pkgnum.": $error";
1735     }
1736   }
1737
1738   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1739
1740   ''; #no errors
1741 }
1742
1743 =item credit_remaining MODE TIME
1744
1745 Generate a credit for this package for the time remaining in the current 
1746 billing period.  MODE is either "suspend" or "cancel" (determines the 
1747 credit type).  TIME is the time of suspension/cancellation.  Both arguments
1748 are mandatory.
1749
1750 =cut
1751
1752 # Implementation note:
1753 #
1754 # If you pkgpart-change a package that has been billed, and it's set to give
1755 # credit on package change, then this method gets called and then the new
1756 # package will have no last_bill date. Therefore the customer will be credited
1757 # only once (per billing period) even if there are multiple package changes.
1758 #
1759 # If you location-change a package that has been billed, this method will NOT
1760 # be called and the new package WILL have the last bill date of the old
1761 # package.
1762 #
1763 # If the new package is then canceled within the same billing cycle, 
1764 # credit_remaining needs to run calc_remain on the OLD package to determine
1765 # the amount of unused time to credit.
1766
1767 sub credit_remaining {
1768   # Add a credit for remaining service
1769   my ($self, $mode, $time) = @_;
1770   die 'credit_remaining requires suspend or cancel' 
1771     unless $mode eq 'suspend' or $mode eq 'cancel';
1772   die 'no suspend/cancel time' unless $time > 0;
1773
1774   my $conf = FS::Conf->new;
1775   my $reason_type = $conf->config($mode.'_credit_type');
1776
1777   $time ||= time;
1778
1779   my $remain_pkg = $self;
1780   my (@billpkgnums, @amounts, @setuprecurs);
1781   
1782   # we may have to walk back past some package changes to get to the 
1783   # one that actually has unused time. loop until that happens, or we
1784   # reach the first package in the chain.
1785   while (1) {
1786     my $last_bill = $remain_pkg->get('last_bill') || 0;
1787     my $next_bill = $remain_pkg->get('bill') || 0;
1788     if ( $last_bill > 0         # the package has been billed
1789         and $next_bill > 0      # the package has a next bill date
1790         and $next_bill >= $time # which is in the future
1791     ) {
1792
1793       # Find actual charges for the period ending on or after the cancel
1794       # date.
1795       my @charges = qsearch('cust_bill_pkg', {
1796         pkgnum => $remain_pkg->pkgnum,
1797         edate => {op => '>=', value => $time},
1798         recur => {op => '>' , value => 0},
1799       });
1800
1801       foreach my $cust_bill_pkg (@charges) {
1802         # hack to deal with the weird behavior of edate on package
1803         # cancellation
1804         my $edate = $cust_bill_pkg->edate;
1805         if ( $self->recur_temporality eq 'preceding' ) {
1806           $edate = $self->add_freq($cust_bill_pkg->sdate);
1807         }
1808
1809         # this will also get any package charges that are _entirely_ after
1810         # the cancellation date (can happen with advance billing). in that
1811         # case, use the entire recurring charge:
1812         my $amount = $cust_bill_pkg->recur - $cust_bill_pkg->usage;
1813
1814         # but if the cancellation happens during the interval, prorate it:
1815         # (XXX obey prorate_round_day here?)
1816         if ( $cust_bill_pkg->sdate < $time ) {
1817           $amount = $amount *
1818                       ($edate - $time) / ($edate - $cust_bill_pkg->sdate);
1819         }
1820
1821         $amount = sprintf('%.2f', $amount);
1822
1823         push @billpkgnums, $cust_bill_pkg->billpkgnum;
1824         push @amounts,     $amount;
1825         push @setuprecurs, 'recur';
1826
1827         warn "Crediting for $amount on package ".$remain_pkg->pkgnum."\n"
1828           if $DEBUG;
1829
1830       }
1831
1832       last if @charges;
1833     }
1834
1835     if ( my $changed_from_pkgnum = $remain_pkg->change_pkgnum ) {
1836       $remain_pkg = FS::cust_pkg->by_key($changed_from_pkgnum);
1837     } else {
1838       # the package has really never been billed
1839       return;
1840     }
1841   }
1842
1843   # keep traditional behavior here. 
1844   local $@;
1845   my $reason = FS::reason->new_or_existing(
1846     reason  => 'Credit for unused time on '. $self->part_pkg->pkg,
1847     type    => $reason_type,
1848     class   => 'R',
1849   );
1850   if ( $@ ) {
1851     return "failed to set credit reason: $@";
1852   }
1853
1854   my $error = FS::cust_credit->credit_lineitems(
1855     'billpkgnums' => \@billpkgnums,
1856     'setuprecurs' => \@setuprecurs,
1857     'amounts'     => \@amounts,
1858     'custnum'     => $self->custnum,
1859     'date'        => time,
1860     'reasonnum'   => $reason->reasonnum,
1861     'apply'       => 1,
1862   );
1863
1864   '';
1865 }
1866
1867 =item unsuspend [ OPTION => VALUE ... ]
1868
1869 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
1870 package, then unsuspends the package itself (clears the susp field and the
1871 adjourn field if it is in the past).  If the suspend reason includes an 
1872 unsuspension package, that package will be ordered.
1873
1874 Available options are:
1875
1876 =over 4
1877
1878 =item date
1879
1880 Can be set to a date to unsuspend the package in the future (the 'resume' 
1881 field).
1882
1883 =item adjust_next_bill
1884
1885 Can be set true to adjust the next bill date forward by
1886 the amount of time the account was inactive.  This was set true by default
1887 in the past (from 1.4.2 and 1.5.0pre6 through 1.7.0), but now needs to be
1888 explicitly requested with this option or in the price plan.
1889
1890 =back
1891
1892 If there is an error, returns the error, otherwise returns false.
1893
1894 =cut
1895
1896 sub unsuspend {
1897   my( $self, %opt ) = @_;
1898   my $error;
1899
1900   # pass all suspend/cancel actions to the main package
1901   if ( $self->main_pkgnum and !$opt{'from_main'} ) {
1902     return $self->main_pkg->unsuspend(%opt);
1903   }
1904
1905   my $oldAutoCommit = $FS::UID::AutoCommit;
1906   local $FS::UID::AutoCommit = 0;
1907   my $dbh = dbh;
1908
1909   my $old = $self->select_for_update;
1910
1911   my $pkgnum = $old->pkgnum;
1912   if ( $old->get('cancel') || $self->get('cancel') ) {
1913     $dbh->rollback if $oldAutoCommit;
1914     return "Can't unsuspend cancelled package $pkgnum";
1915   }
1916
1917   unless ( $old->get('susp') && $self->get('susp') ) {
1918     $dbh->rollback if $oldAutoCommit;
1919     return "";  # no error                     # complain instead?
1920   }
1921
1922   # handle the case of setting a future unsuspend (resume) date
1923   # and do not continue to actually unsuspend the package
1924   my $date = $opt{'date'};
1925   if ( $date and $date > time ) { # return an error if $date <= time?
1926
1927     if ( $old->get('expire') && $old->get('expire') < $date ) {
1928       $dbh->rollback if $oldAutoCommit;
1929       return "Package $pkgnum expires before it would be unsuspended.";
1930     }
1931
1932     my $new = new FS::cust_pkg { $self->hash };
1933     $new->set('resume', $date);
1934     $error = $new->replace($self, options => $self->options);
1935
1936     if ( $error ) {
1937       $dbh->rollback if $oldAutoCommit;
1938       return $error;
1939     }
1940     else {
1941       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1942       return '';
1943     }
1944   
1945   } #if $date 
1946
1947   if (!$self->setup) {
1948     # then this package is being released from on-hold status
1949     $error = $self->set_initial_timers;
1950     if ( $error ) {
1951       $dbh->rollback if $oldAutoCommit;
1952       return $error;
1953     }
1954   }
1955
1956   my @labels = ();
1957
1958   foreach my $cust_svc (
1959     qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
1960   ) {
1961     my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
1962
1963     $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
1964       $dbh->rollback if $oldAutoCommit;
1965       return "Illegal svcdb value in part_svc!";
1966     };
1967     my $svcdb = $1;
1968     require "FS/$svcdb.pm";
1969
1970     my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
1971     if ($svc) {
1972       $error = $svc->unsuspend;
1973       if ( $error ) {
1974         $dbh->rollback if $oldAutoCommit;
1975         return $error;
1976       }
1977       my( $label, $value ) = $cust_svc->label;
1978       push @labels, "$label: $value";
1979     }
1980
1981   }
1982
1983   my $cust_pkg_reason = $self->last_cust_pkg_reason('susp');
1984   my $reason = $cust_pkg_reason ? $cust_pkg_reason->reason : '';
1985
1986   my %hash = $self->hash;
1987   my $inactive = time - $hash{'susp'};
1988
1989   my $conf = new FS::Conf;
1990
1991   #adjust the next bill date forward
1992   # increment next bill date if certain conditions are met:
1993   # - it was due to be billed at some point
1994   # - either the global or local config says to do this
1995   my $adjust_bill = 0;
1996   if (
1997        $inactive > 0
1998     && ( $hash{'bill'} || $hash{'setup'} )
1999     && (    $opt{'adjust_next_bill'}
2000          || $conf->exists('unsuspend-always_adjust_next_bill_date')
2001          || $self->part_pkg->option('unsuspend_adjust_bill', 1)
2002        )
2003   ) {
2004     $adjust_bill = 1;
2005   }
2006
2007   # but not if:
2008   # - the package billed during suspension
2009   # - or it was ordered on hold
2010   # - or the customer was credited for the unused time
2011
2012   if ( $self->option('suspend_bill',1)
2013       or ( $self->part_pkg->option('suspend_bill',1)
2014            and ! $self->option('no_suspend_bill',1)
2015          )
2016       or $hash{'order_date'} == $hash{'susp'}
2017   ) {
2018     $adjust_bill = 0;
2019   }
2020
2021   if ( $adjust_bill ) {
2022     if (    $self->part_pkg->option('unused_credit_suspend')
2023          or ( ref($reason) and $reason->unused_credit ) ) {
2024       # then the customer was credited for the unused time before suspending,
2025       # so their next bill should be immediate 
2026       $hash{'bill'} = time;
2027     } else {
2028       # add the length of time suspended to the bill date
2029       $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive;
2030     }
2031   }
2032
2033   $hash{'susp'} = '';
2034   $hash{'adjourn'} = '' if $hash{'adjourn'} and $hash{'adjourn'} < time;
2035   $hash{'resume'} = '' if !$hash{'adjourn'};
2036   my $new = new FS::cust_pkg ( \%hash );
2037   $error = $new->replace( $self, options => { $self->options } );
2038   if ( $error ) {
2039     $dbh->rollback if $oldAutoCommit;
2040     return $error;
2041   }
2042
2043   my $unsusp_pkg;
2044
2045   if ( $reason ) {
2046     if ( $reason->unsuspend_pkgpart ) {
2047       warn "Suspend reason '".$reason->reason."' uses deprecated unsuspend_pkgpart feature.\n";
2048       my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart)
2049         or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart.
2050                     " not found.";
2051       my $start_date = $self->cust_main->next_bill_date 
2052         if $reason->unsuspend_hold;
2053
2054       if ( $part_pkg ) {
2055         $unsusp_pkg = FS::cust_pkg->new({
2056             'custnum'     => $self->custnum,
2057             'pkgpart'     => $reason->unsuspend_pkgpart,
2058             'start_date'  => $start_date,
2059             'locationnum' => $self->locationnum,
2060             # discount? probably not...
2061         });
2062
2063         $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg );
2064       }
2065     }
2066     # new way, using fees
2067     if ( $reason->feepart and $reason->fee_on_unsuspend ) {
2068       # register the need to charge a fee, cust_main->bill will do the rest
2069       warn "registering unsuspend fee: pkgnum ".$self->pkgnum.", feepart ".$reason->feepart."\n"
2070         if $DEBUG;
2071       my $cust_pkg_reason_fee = FS::cust_pkg_reason_fee->new({
2072           'pkgreasonnum'  => $cust_pkg_reason->num,
2073           'pkgnum'        => $self->pkgnum,
2074           'feepart'       => $reason->feepart,
2075           'nextbill'      => $reason->fee_hold,
2076       });
2077       $error ||= $cust_pkg_reason_fee->insert;
2078     }
2079
2080     if ( $error ) {
2081       $dbh->rollback if $oldAutoCommit;
2082       return $error;
2083     }
2084   }
2085
2086   if ( $conf->config('unsuspend_email_admin') ) {
2087  
2088     my $error = send_email(
2089       'from'    => $conf->config('invoice_from', $self->cust_main->agentnum),
2090                                  #invoice_from ??? well as good as any
2091       'to'      => $conf->config('unsuspend_email_admin'),
2092       'subject' => 'FREESIDE NOTIFICATION: Customer package unsuspended',       'body'    => [
2093         "This is an automatic message from your Freeside installation\n",
2094         "informing you that the following customer package has been unsuspended:\n",
2095         "\n",
2096         'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
2097         'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
2098         ( map { "Service : $_\n" } @labels ),
2099         ($unsusp_pkg ?
2100           "An unsuspension fee was charged: ".
2101             $unsusp_pkg->part_pkg->pkg_comment."\n"
2102           : ''
2103         ),
2104       ],
2105       'custnum' => $self->custnum,
2106       'msgtype' => 'admin',
2107     );
2108
2109     if ( $error ) {
2110       warn "WARNING: can't send unsuspension admin email (unsuspending anyway): ".
2111            "$error\n";
2112     }
2113
2114   }
2115
2116   foreach my $supp_pkg ( $self->supplemental_pkgs ) {
2117     $error = $supp_pkg->unsuspend(%opt, 'from_main' => 1);
2118     if ( $error ) {
2119       $dbh->rollback if $oldAutoCommit;
2120       return "unsuspending supplemental pkg#".$supp_pkg->pkgnum.": $error";
2121     }
2122   }
2123
2124   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2125
2126   ''; #no errors
2127 }
2128
2129 =item unadjourn
2130
2131 Cancels any pending suspension (sets the adjourn field to null)
2132 for this package and any supplemental packages.
2133
2134 If there is an error, returns the error, otherwise returns false.
2135
2136 =cut
2137
2138 sub unadjourn {
2139   my( $self ) = @_;
2140   my $error;
2141
2142   my $oldAutoCommit = $FS::UID::AutoCommit;
2143   local $FS::UID::AutoCommit = 0;
2144   my $dbh = dbh;
2145
2146   my $old = $self->select_for_update;
2147
2148   my $pkgnum = $old->pkgnum;
2149   if ( $old->get('cancel') || $self->get('cancel') ) {
2150     dbh->rollback if $oldAutoCommit;
2151     return "Can't unadjourn cancelled package $pkgnum";
2152     # or at least it's pointless
2153   }
2154
2155   if ( $old->get('susp') || $self->get('susp') ) {
2156     dbh->rollback if $oldAutoCommit;
2157     return "Can't unadjourn suspended package $pkgnum";
2158     # perhaps this is arbitrary
2159   }
2160
2161   unless ( $old->get('adjourn') && $self->get('adjourn') ) {
2162     dbh->rollback if $oldAutoCommit;
2163     return "";  # no error
2164   }
2165
2166   my %hash = $self->hash;
2167   $hash{'adjourn'} = '';
2168   $hash{'resume'}  = '';
2169   my $new = new FS::cust_pkg ( \%hash );
2170   $error = $new->replace( $self, options => { $self->options } );
2171   if ( $error ) {
2172     $dbh->rollback if $oldAutoCommit;
2173     return $error;
2174   }
2175
2176   foreach my $supp_pkg ( $self->supplemental_pkgs ) {
2177     $error = $supp_pkg->unadjourn;
2178     if ( $error ) {
2179       $dbh->rollback if $oldAutoCommit;
2180       return "unadjourning supplemental pkg#".$supp_pkg->pkgnum.": $error";
2181     }
2182   }
2183
2184   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2185
2186   ''; #no errors
2187
2188 }
2189
2190
2191 =item change HASHREF | OPTION => VALUE ... 
2192
2193 Changes this package: cancels it and creates a new one, with a different
2194 pkgpart or locationnum or both.  All services are transferred to the new
2195 package (no change will be made if this is not possible).
2196
2197 Options may be passed as a list of key/value pairs or as a hash reference.
2198 Options are:
2199
2200 =over 4
2201
2202 =item locationnum
2203
2204 New locationnum, to change the location for this package.
2205
2206 =item cust_location
2207
2208 New FS::cust_location object, to create a new location and assign it
2209 to this package.
2210
2211 =item cust_main
2212
2213 New FS::cust_main object, to create a new customer and assign the new package
2214 to it.
2215
2216 =item pkgpart
2217
2218 New pkgpart (see L<FS::part_pkg>).
2219
2220 =item refnum
2221
2222 New refnum (see L<FS::part_referral>).
2223
2224 =item quantity
2225
2226 New quantity; if unspecified, the new package will have the same quantity
2227 as the old.
2228
2229 =item cust_pkg
2230
2231 "New" (existing) FS::cust_pkg object.  The package's services and other 
2232 attributes will be transferred to this package.
2233
2234 =item keep_dates
2235
2236 Set to true to transfer billing dates (start_date, setup, last_bill, bill, 
2237 susp, adjourn, cancel, expire, and contract_end) to the new package.
2238
2239 =item unprotect_svcs
2240
2241 Normally, change() will rollback and return an error if some services 
2242 can't be transferred (also see the I<cust_pkg-change_svcpart> config option).
2243 If unprotect_svcs is true, this method will transfer as many services as 
2244 it can and then unconditionally cancel the old package.
2245
2246 =item contract_end
2247
2248 If specified, sets this value for the contract_end date on the new package 
2249 (without regard for keep_dates or the usual date-preservation behavior.)
2250 Will throw an error if defined but false;  the UI doesn't allow editing 
2251 this unless it already exists, making removal impossible to undo.
2252
2253 =back
2254
2255 At least one of locationnum, cust_location, pkgpart, refnum, cust_main, or
2256 cust_pkg must be specified (otherwise, what's the point?)
2257
2258 Returns either the new FS::cust_pkg object or a scalar error.
2259
2260 For example:
2261
2262   my $err_or_new_cust_pkg = $old_cust_pkg->change
2263
2264 =cut
2265
2266 #used by change and change_later
2267 #didn't put with documented check methods because it depends on change-specific opts
2268 #and it also possibly edits the value of opts
2269 sub _check_change {
2270   my $self = shift;
2271   my $opt = shift;
2272   if ( defined($opt->{'contract_end'}) ) {
2273     my $current_contract_end = $self->get('contract_end');
2274     unless ($opt->{'contract_end'}) {
2275       if ($current_contract_end) {
2276         return "Cannot remove contract end date when changing packages";
2277       } else {
2278         #shouldn't even pass this option if there's not a current value
2279         #but can be handled gracefully if the option is empty
2280         warn "Contract end date passed unexpectedly";
2281         delete $opt->{'contract_end'};
2282         return '';
2283       }
2284     }
2285     unless ($current_contract_end) {
2286       #option shouldn't be passed, throw error if it's non-empty
2287       return "Cannot add contract end date when changing packages " . $self->pkgnum;
2288     }
2289   }
2290   return '';
2291 }
2292
2293 #some false laziness w/order
2294 sub change {
2295   my $self = shift;
2296   my $opt = ref($_[0]) ? shift : { @_ };
2297
2298   my $conf = new FS::Conf;
2299
2300   # handle contract_end on cust_pkg same as passed option
2301   if ( $opt->{'cust_pkg'} ) {
2302     $opt->{'contract_end'} = $opt->{'cust_pkg'}->contract_end;
2303     delete $opt->{'contract_end'} unless $opt->{'contract_end'};
2304   }
2305
2306   # check contract_end, prevent adding/removing
2307   my $error = $self->_check_change($opt);
2308   return $error if $error;
2309
2310   # Transactionize this whole mess
2311   my $oldAutoCommit = $FS::UID::AutoCommit;
2312   local $FS::UID::AutoCommit = 0;
2313   my $dbh = dbh;
2314
2315   if ( $opt->{'cust_location'} ) {
2316     $error = $opt->{'cust_location'}->find_or_insert;
2317     if ( $error ) {
2318       $dbh->rollback if $oldAutoCommit;
2319       return "creating location record: $error";
2320     }
2321     $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
2322   }
2323
2324   # figure out if we're changing pkgpart
2325   if ( $opt->{'cust_pkg'} ) {
2326     $opt->{'pkgpart'} = $opt->{'cust_pkg'}->pkgpart;
2327   }
2328
2329   # whether to override pkgpart checking on the new package
2330   my $same_pkgpart = 1;
2331   if ( $opt->{'pkgpart'} and ( $opt->{'pkgpart'} != $self->pkgpart ) ) {
2332     $same_pkgpart = 0;
2333   }
2334
2335   # Before going any further here: if the package is still in the pre-setup
2336   # state, it's safe to modify it in place. No need to charge/credit for 
2337   # partial period, transfer usage pools, copy invoice details, or change any
2338   # dates. We DO need to "transfer" services (from the package to itself) to
2339   # check their validity on the new pkgpart.
2340   if ( ! $self->setup and ! $opt->{cust_pkg} and ! $opt->{cust_main} ) {
2341     foreach ( qw( locationnum pkgpart quantity refnum salesnum ) ) {
2342       if ( length($opt->{$_}) ) {
2343         $self->set($_, $opt->{$_});
2344       }
2345     }
2346     # almost. if the new pkgpart specifies start/adjourn/expire timers, 
2347     # apply those.
2348     if ( !$same_pkgpart ) {
2349       $error ||= $self->set_initial_timers;
2350     }
2351     # but if contract_end was explicitly specified, that overrides all else
2352     $self->set('contract_end', $opt->{'contract_end'})
2353       if $opt->{'contract_end'};
2354
2355     $error ||= $self->replace;
2356     if ( $error ) {
2357       $dbh->rollback if $oldAutoCommit;
2358       return "modifying package: $error";
2359     }
2360
2361     # check/convert services (only on pkgpart change, to avoid surprises
2362     # when editing locations)
2363     # (maybe do this if changing quantity?)
2364     if ( !$same_pkgpart ) {
2365
2366       $error = $self->transfer($self);
2367
2368       if ( $error and $error == 0 ) {
2369         $error = "transferring $error";
2370       } elsif ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
2371         warn "trying transfer again with change_svcpart option\n" if $DEBUG;
2372         $error = $self->transfer($self, 'change_svcpart'=>1 );
2373         if ($error and $error == 0) {
2374           $error = "converting $error";
2375         }
2376       }
2377
2378       if ($error > 0) {
2379         $error = "unable to transfer all services";
2380       }
2381
2382       if ( $error ) {
2383         $dbh->rollback if $oldAutoCommit;
2384         return $error;
2385       }
2386
2387     } # done transferring services
2388
2389     $dbh->commit if $oldAutoCommit;
2390     return $self;
2391
2392   }
2393
2394   my %hash = (); 
2395
2396   my $time = time;
2397
2398   $hash{'setup'} = $time if $self->get('setup');
2399
2400   $hash{'change_date'} = $time;
2401   $hash{"change_$_"}  = $self->$_()
2402     foreach qw( pkgnum pkgpart locationnum );
2403
2404   my $unused_credit = 0;
2405   my $keep_dates = $opt->{'keep_dates'};
2406
2407   # Special case.  If the pkgpart is changing, and the customer is going to be
2408   # credited for remaining time, don't keep setup, bill, or last_bill dates,
2409   # and DO pass the flag to cancel() to credit the customer.  If the old
2410   # package had a setup date, set the new package's setup to the package
2411   # change date so that it has the same status as before.
2412   if ( $opt->{'pkgpart'} 
2413        and $opt->{'pkgpart'} != $self->pkgpart
2414        and $self->part_pkg->option('unused_credit_change', 1) ) {
2415     $unused_credit = 1;
2416     $keep_dates = 0;
2417     $hash{'last_bill'} = '';
2418     $hash{'bill'} = '';
2419   }
2420
2421   if ( $keep_dates ) {
2422     foreach my $date ( qw(setup bill last_bill) ) {
2423       $hash{$date} = $self->getfield($date);
2424     }
2425   }
2426   # always keep the following dates
2427   foreach my $date (qw(order_date susp adjourn cancel expire resume 
2428                     start_date contract_end)) {
2429     $hash{$date} = $self->getfield($date);
2430   }
2431   # but if contract_end was explicitly specified, that overrides all else
2432   $hash{'contract_end'} = $opt->{'contract_end'}
2433     if $opt->{'contract_end'};
2434
2435   # allow $opt->{'locationnum'} = '' to specifically set it to null
2436   # (i.e. customer default location)
2437   $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
2438
2439   # usually this doesn't matter.  the two cases where it does are:
2440   # 1. unused_credit_change + pkgpart change + setup fee on the new package
2441   # and
2442   # 2. (more importantly) changing a package before it's billed
2443   $hash{'waive_setup'} = $self->waive_setup;
2444
2445   # if this package is scheduled for a future package change, preserve that
2446   $hash{'change_to_pkgnum'} = $self->change_to_pkgnum;
2447
2448   my $custnum = $self->custnum;
2449   if ( $opt->{cust_main} ) {
2450     my $cust_main = $opt->{cust_main};
2451     unless ( $cust_main->custnum ) { 
2452       my $error = $cust_main->insert( @{ $opt->{cust_main_insert_args}||[] } );
2453       if ( $error ) {
2454         $dbh->rollback if $oldAutoCommit;
2455         return "inserting customer record: $error";
2456       }
2457     }
2458     $custnum = $cust_main->custnum;
2459   }
2460
2461   $hash{'contactnum'} = $opt->{'contactnum'} if $opt->{'contactnum'};
2462
2463   my $cust_pkg;
2464   if ( $opt->{'cust_pkg'} ) {
2465     # The target package already exists; update it to show that it was 
2466     # changed from this package.
2467     $cust_pkg = $opt->{'cust_pkg'};
2468
2469     # follow all the above rules for date changes, etc.
2470     foreach (keys %hash) {
2471       $cust_pkg->set($_, $hash{$_});
2472     }
2473     # except those that implement the future package change behavior
2474     foreach (qw(change_to_pkgnum start_date expire)) {
2475       $cust_pkg->set($_, '');
2476     }
2477
2478     $error = $cust_pkg->replace;
2479
2480   } else {
2481     # Create the new package.
2482     $cust_pkg = new FS::cust_pkg {
2483       custnum     => $custnum,
2484       locationnum => $opt->{'locationnum'},
2485       ( map {  $_ => ( $opt->{$_} || $self->$_() )  }
2486           qw( pkgpart quantity refnum salesnum )
2487       ),
2488       %hash,
2489     };
2490     $error = $cust_pkg->insert( 'change' => 1,
2491                                 'allow_pkgpart' => $same_pkgpart );
2492   }
2493   if ($error) {
2494     $dbh->rollback if $oldAutoCommit;
2495     return "inserting new package: $error";
2496   }
2497
2498   # Transfer services and cancel old package.
2499   # Enforce service limits only if this is a pkgpart change.
2500   local $FS::cust_svc::ignore_quantity;
2501   $FS::cust_svc::ignore_quantity = 1 if $same_pkgpart;
2502   $error = $self->transfer($cust_pkg);
2503   if ($error and $error == 0) {
2504     # $old_pkg->transfer failed.
2505     $dbh->rollback if $oldAutoCommit;
2506     return "transferring $error";
2507   }
2508
2509   if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
2510     warn "trying transfer again with change_svcpart option\n" if $DEBUG;
2511     $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
2512     if ($error and $error == 0) {
2513       # $old_pkg->transfer failed.
2514       $dbh->rollback if $oldAutoCommit;
2515       return "converting $error";
2516     }
2517   }
2518
2519   # We set unprotect_svcs when executing a "future package change".  It's 
2520   # not a user-interactive operation, so returning an error means the 
2521   # package change will just fail.  Rather than have that happen, we'll 
2522   # let leftover services be deleted.
2523   if ($error > 0 and !$opt->{'unprotect_svcs'}) {
2524     # Transfers were successful, but we still had services left on the old
2525     # package.  We can't change the package under this circumstances, so abort.
2526     $dbh->rollback if $oldAutoCommit;
2527     return "unable to transfer all services";
2528   }
2529
2530   #reset usage if changing pkgpart
2531   # AND usage rollover is off (otherwise adds twice, now and at package bill)
2532   if ($self->pkgpart != $cust_pkg->pkgpart) {
2533     my $part_pkg = $cust_pkg->part_pkg;
2534     $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
2535                                                  ? ()
2536                                                  : ( 'null' => 1 )
2537                                    )
2538       if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover',1);
2539
2540     if ($error) {
2541       $dbh->rollback if $oldAutoCommit;
2542       return "setting usage values: $error";
2543     }
2544   } else {
2545     # if NOT changing pkgpart, transfer any usage pools over
2546     foreach my $usage ($self->cust_pkg_usage) {
2547       $usage->set('pkgnum', $cust_pkg->pkgnum);
2548       $error = $usage->replace;
2549       if ( $error ) {
2550         $dbh->rollback if $oldAutoCommit;
2551         return "transferring usage pools: $error";
2552       }
2553     }
2554   }
2555
2556   # transfer usage pricing add-ons, if we're not changing pkgpart or if they were specified
2557   if ( $same_pkgpart || $opt->{'cust_pkg_usageprice'}) {
2558     my @old_cust_pkg_usageprice;
2559     if ($opt->{'cust_pkg_usageprice'}) {
2560       @old_cust_pkg_usageprice = @{ $opt->{'cust_pkg_usageprice'} };
2561     } else {
2562       @old_cust_pkg_usageprice = $self->cust_pkg_usageprice;
2563     }
2564     foreach my $old_cust_pkg_usageprice (@old_cust_pkg_usageprice) {
2565       my $new_cust_pkg_usageprice = new FS::cust_pkg_usageprice {
2566         'pkgnum'         => $cust_pkg->pkgnum,
2567         'usagepricepart' => $old_cust_pkg_usageprice->usagepricepart,
2568         'quantity'       => $old_cust_pkg_usageprice->quantity,
2569       };
2570       $error = $new_cust_pkg_usageprice->insert;
2571       if ( $error ) {
2572         $dbh->rollback if $oldAutoCommit;
2573         return "Error transferring usage pricing add-on: $error";
2574       }
2575     }
2576   }
2577
2578   # transfer discounts, if we're not changing pkgpart
2579   if ( $same_pkgpart ) {
2580     foreach my $old_discount ($self->cust_pkg_discount_active) {
2581       # don't remove the old discount, we may still need to bill that package.
2582       my $new_discount = new FS::cust_pkg_discount {
2583         'pkgnum'      => $cust_pkg->pkgnum,
2584         'discountnum' => $old_discount->discountnum,
2585         'months_used' => $old_discount->months_used,
2586       };
2587       $error = $new_discount->insert;
2588       if ( $error ) {
2589         $dbh->rollback if $oldAutoCommit;
2590         return "transferring discounts: $error";
2591       }
2592     }
2593   }
2594
2595   # transfer (copy) invoice details
2596   foreach my $detail ($self->cust_pkg_detail) {
2597     my $new_detail = FS::cust_pkg_detail->new({ $detail->hash });
2598     $new_detail->set('pkgdetailnum', '');
2599     $new_detail->set('pkgnum', $cust_pkg->pkgnum);
2600     $error = $new_detail->insert;
2601     if ( $error ) {
2602       $dbh->rollback if $oldAutoCommit;
2603       return "transferring package notes: $error";
2604     }
2605   }
2606
2607   # transfer scheduled expire/adjourn reasons
2608   foreach my $action ('expire', 'adjourn') {
2609     if ( $cust_pkg->get($action) ) {
2610       my $reason = $self->last_cust_pkg_reason($action);
2611       if ( $reason ) {
2612         $reason->set('pkgnum', $cust_pkg->pkgnum);
2613         $error = $reason->replace;
2614         if ( $error ) {
2615           $dbh->rollback if $oldAutoCommit;
2616           return "transferring $action reason: $error";
2617         }
2618       }
2619     }
2620   }
2621   
2622   my @new_supp_pkgs;
2623
2624   if ( !$opt->{'cust_pkg'} ) {
2625     # Order any supplemental packages.
2626     my $part_pkg = $cust_pkg->part_pkg;
2627     my @old_supp_pkgs = $self->supplemental_pkgs;
2628     foreach my $link ($part_pkg->supp_part_pkg_link) {
2629       my $old;
2630       foreach (@old_supp_pkgs) {
2631         if ($_->pkgpart == $link->dst_pkgpart) {
2632           $old = $_;
2633           $_->pkgpart(0); # so that it can't match more than once
2634         }
2635         last if $old;
2636       }
2637       # false laziness with FS::cust_main::Packages::order_pkg
2638       my $new = FS::cust_pkg->new({
2639           pkgpart       => $link->dst_pkgpart,
2640           pkglinknum    => $link->pkglinknum,
2641           custnum       => $custnum,
2642           main_pkgnum   => $cust_pkg->pkgnum,
2643           locationnum   => $cust_pkg->locationnum,
2644           start_date    => $cust_pkg->start_date,
2645           order_date    => $cust_pkg->order_date,
2646           expire        => $cust_pkg->expire,
2647           adjourn       => $cust_pkg->adjourn,
2648           contract_end  => $cust_pkg->contract_end,
2649           refnum        => $cust_pkg->refnum,
2650           discountnum   => $cust_pkg->discountnum,
2651           waive_setup   => $cust_pkg->waive_setup,
2652       });
2653       if ( $old and $opt->{'keep_dates'} ) {
2654         foreach (qw(setup bill last_bill)) {
2655           $new->set($_, $old->get($_));
2656         }
2657       }
2658       $error = $new->insert( allow_pkgpart => $same_pkgpart );
2659       # transfer services
2660       if ( $old ) {
2661         $error ||= $old->transfer($new);
2662       }
2663       if ( $error and $error > 0 ) {
2664         # no reason why this should ever fail, but still...
2665         $error = "Unable to transfer all services from supplemental package ".
2666           $old->pkgnum;
2667       }
2668       if ( $error ) {
2669         $dbh->rollback if $oldAutoCommit;
2670         return $error;
2671       }
2672       push @new_supp_pkgs, $new;
2673     }
2674   } # if !$opt->{'cust_pkg'}
2675     # because if there is one, then supplemental packages would already
2676     # have been created for it.
2677
2678   #Good to go, cancel old package.  Notify 'cancel' of whether to credit 
2679   #remaining time.
2680   #Don't allow billing the package (preceding period packages and/or 
2681   #outstanding usage) if we are keeping dates (i.e. location changing), 
2682   #because the new package will be billed for the same date range.
2683   #Supplemental packages are also canceled here.
2684
2685   # during scheduled changes, avoid canceling the package we just
2686   # changed to (duh)
2687   $self->set('change_to_pkgnum' => '');
2688
2689   $error = $self->cancel(
2690     quiet          => 1, 
2691     unused_credit  => $unused_credit,
2692     nobill         => $keep_dates,
2693     change_custnum => ( $self->custnum != $custnum ? $custnum : '' ),
2694     no_delay_cancel => 1,
2695   );
2696   if ($error) {
2697     $dbh->rollback if $oldAutoCommit;
2698     return "canceling old package: $error";
2699   }
2700
2701   # transfer rt_field_charge, if we're not changing pkgpart
2702   # after billing of old package, before billing of new package
2703   if ( $same_pkgpart ) {
2704     foreach my $rt_field_charge ($self->rt_field_charge) {
2705       $rt_field_charge->set('pkgnum', $cust_pkg->pkgnum);
2706       $error = $rt_field_charge->replace;
2707       if ( $error ) {
2708         $dbh->rollback if $oldAutoCommit;
2709         return "transferring rt_field_charge: $error";
2710       }
2711     }
2712   }
2713
2714   if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
2715     #$self->cust_main
2716     my $error = $cust_pkg->cust_main->bill( 
2717       'pkg_list' => [ $cust_pkg, @new_supp_pkgs ]
2718     );
2719     if ( $error ) {
2720       $dbh->rollback if $oldAutoCommit;
2721       return "billing new package: $error";
2722     }
2723   }
2724
2725   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2726
2727   $cust_pkg;
2728
2729 }
2730
2731 =item change_later OPTION => VALUE...
2732
2733 Schedule a package change for a later date.  This actually orders the new
2734 package immediately, but sets its start date for a future date, and sets
2735 the current package to expire on the same date.
2736
2737 If the package is already scheduled for a change, this can be called with 
2738 'start_date' to change the scheduled date, or with pkgpart and/or 
2739 locationnum to modify the package change.  To cancel the scheduled change 
2740 entirely, see C<abort_change>.
2741
2742 Options include:
2743
2744 =over 4
2745
2746 =item start_date
2747
2748 The date for the package change.  Required, and must be in the future.
2749
2750 =item pkgpart
2751
2752 =item locationnum
2753
2754 =item quantity
2755
2756 =item contract_end
2757
2758 The pkgpart, locationnum, quantity and optional contract_end of the new 
2759 package, with the same meaning as in C<change>.
2760
2761 =back
2762
2763 =cut
2764
2765 sub change_later {
2766   my $self = shift;
2767   my $opt = ref($_[0]) ? shift : { @_ };
2768
2769   # check contract_end, prevent adding/removing
2770   my $error = $self->_check_change($opt);
2771   return $error if $error;
2772
2773   my $oldAutoCommit = $FS::UID::AutoCommit;
2774   local $FS::UID::AutoCommit = 0;
2775   my $dbh = dbh;
2776
2777   my $cust_main = $self->cust_main;
2778
2779   my $date = delete $opt->{'start_date'} or return 'start_date required';
2780  
2781   if ( $date <= time ) {
2782     $dbh->rollback if $oldAutoCommit;
2783     return "start_date $date is in the past";
2784   }
2785
2786   # If the user entered a new location, set it up now.
2787   if ( $opt->{'cust_location'} ) {
2788     $error = $opt->{'cust_location'}->find_or_insert;
2789     if ( $error ) {
2790       $dbh->rollback if $oldAutoCommit;
2791       return "creating location record: $error";
2792     }
2793     $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
2794   }
2795
2796   if ( $self->change_to_pkgnum ) {
2797     my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
2798     my $new_pkgpart = $opt->{'pkgpart'}
2799         if $opt->{'pkgpart'} and $opt->{'pkgpart'} != $change_to->pkgpart;
2800     my $new_locationnum = $opt->{'locationnum'}
2801         if $opt->{'locationnum'} and $opt->{'locationnum'} != $change_to->locationnum;
2802     my $new_quantity = $opt->{'quantity'}
2803         if $opt->{'quantity'} and $opt->{'quantity'} != $change_to->quantity;
2804     my $new_contract_end = $opt->{'contract_end'}
2805         if $opt->{'contract_end'} and $opt->{'contract_end'} != $change_to->contract_end;
2806     if ( $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end ) {
2807       # it hasn't been billed yet, so in principle we could just edit
2808       # it in place (w/o a package change), but that's bad form.
2809       # So change the package according to the new options...
2810       my $err_or_pkg = $change_to->change(%$opt);
2811       if ( ref $err_or_pkg ) {
2812         # Then set that package up for a future start.
2813         $self->set('change_to_pkgnum', $err_or_pkg->pkgnum);
2814         $self->set('expire', $date); # in case it's different
2815         $err_or_pkg->set('start_date', $date);
2816         $err_or_pkg->set('change_date', '');
2817         $err_or_pkg->set('change_pkgnum', '');
2818
2819         $error = $self->replace       ||
2820                  $err_or_pkg->replace ||
2821                  #because change() might've edited existing scheduled change in place
2822                  (($err_or_pkg->pkgnum == $change_to->pkgnum) ? '' :
2823                   $change_to->cancel('no_delay_cancel' => 1) ||
2824                   $change_to->delete);
2825       } else {
2826         $error = $err_or_pkg;
2827       }
2828     } else { # change the start date only.
2829       $self->set('expire', $date);
2830       $change_to->set('start_date', $date);
2831       $error = $self->replace || $change_to->replace;
2832     }
2833     if ( $error ) {
2834       $dbh->rollback if $oldAutoCommit;
2835       return $error;
2836     } else {
2837       $dbh->commit if $oldAutoCommit;
2838       return '';
2839     }
2840   } # if $self->change_to_pkgnum
2841
2842   my $new_pkgpart = $opt->{'pkgpart'}
2843       if $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart;
2844   my $new_locationnum = $opt->{'locationnum'}
2845       if $opt->{'locationnum'} and $opt->{'locationnum'} != $self->locationnum;
2846   my $new_quantity = $opt->{'quantity'}
2847       if $opt->{'quantity'} and $opt->{'quantity'} != $self->quantity;
2848   my $new_contract_end = $opt->{'contract_end'}
2849       if $opt->{'contract_end'} and $opt->{'contract_end'} != $self->contract_end;
2850
2851   return '' unless $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end; # wouldn't do anything
2852
2853   # allow $opt->{'locationnum'} = '' to specifically set it to null
2854   # (i.e. customer default location)
2855   $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
2856
2857   my $new = FS::cust_pkg->new( {
2858     custnum     => $self->custnum,
2859     locationnum => $opt->{'locationnum'},
2860     start_date  => $date,
2861     map   {  $_ => ( $opt->{$_} || $self->$_() )  }
2862       qw( pkgpart quantity refnum salesnum contract_end )
2863   } );
2864   $error = $new->insert('change' => 1, 
2865                         'allow_pkgpart' => ($new_pkgpart ? 0 : 1));
2866   if ( !$error ) {
2867     $self->set('change_to_pkgnum', $new->pkgnum);
2868     $self->set('expire', $date);
2869     $error = $self->replace;
2870   }
2871   if ( $error ) {
2872     $dbh->rollback if $oldAutoCommit;
2873   } else {
2874     $dbh->commit if $oldAutoCommit;
2875   }
2876
2877   $error;
2878 }
2879
2880 =item abort_change
2881
2882 Cancels a future package change scheduled by C<change_later>.
2883
2884 =cut
2885
2886 sub abort_change {
2887   my $self = shift;
2888   my $oldAutoCommit = $FS::UID::AutoCommit;
2889   local $FS::UID::AutoCommit = 0;
2890
2891   my $pkgnum = $self->change_to_pkgnum;
2892   my $change_to = FS::cust_pkg->by_key($pkgnum) if $pkgnum;
2893   my $error;
2894   $self->set('change_to_pkgnum', '');
2895   $self->set('expire', '');
2896   $error = $self->replace;
2897   if ( $change_to ) {
2898     $error ||= $change_to->cancel || $change_to->delete;
2899   }
2900
2901   if ( $oldAutoCommit ) {
2902     if ( $error ) {
2903       dbh->rollback;
2904     } else {
2905       dbh->commit;
2906     }
2907   }
2908
2909   return $error;
2910 }
2911
2912 =item set_quantity QUANTITY
2913
2914 Change the package's quantity field.  This is one of the few package properties
2915 that can safely be changed without canceling and reordering the package
2916 (because it doesn't affect tax eligibility).  Returns an error or an 
2917 empty string.
2918
2919 =cut
2920
2921 sub set_quantity {
2922   my $self = shift;
2923   $self = $self->replace_old; # just to make sure
2924   $self->quantity(shift);
2925   $self->replace;
2926 }
2927
2928 =item set_salesnum SALESNUM
2929
2930 Change the package's salesnum (sales person) field.  This is one of the few
2931 package properties that can safely be changed without canceling and reordering
2932 the package (because it doesn't affect tax eligibility).  Returns an error or
2933 an empty string.
2934
2935 =cut
2936
2937 sub set_salesnum {
2938   my $self = shift;
2939   $self = $self->replace_old; # just to make sure
2940   $self->salesnum(shift);
2941   $self->replace;
2942   # XXX this should probably reassign any credit that's already been given
2943 }
2944
2945 =item modify_charge OPTIONS
2946
2947 Change the properties of a one-time charge.  The following properties can
2948 be changed this way:
2949 - pkg: the package description
2950 - classnum: the package class
2951 - additional: arrayref of additional invoice details to add to this package
2952
2953 and, I<if the charge has not yet been billed>:
2954 - start_date: the date when it will be billed
2955 - amount: the setup fee to be charged
2956 - quantity: the multiplier for the setup fee
2957 - separate_bill: whether to put the charge on a separate invoice
2958
2959 If you pass 'adjust_commission' => 1, and the classnum changes, and there are
2960 commission credits linked to this charge, they will be recalculated.
2961
2962 =cut
2963
2964 sub modify_charge {
2965   my $self = shift;
2966   my %opt = @_;
2967   my $part_pkg = $self->part_pkg;
2968   my $pkgnum = $self->pkgnum;
2969
2970   my $dbh = dbh;
2971   my $oldAutoCommit = $FS::UID::AutoCommit;
2972   local $FS::UID::AutoCommit = 0;
2973
2974   return "Can't use modify_charge except on one-time charges"
2975     unless $part_pkg->freq eq '0';
2976
2977   if ( length($opt{'pkg'}) and $part_pkg->pkg ne $opt{'pkg'} ) {
2978     $part_pkg->set('pkg', $opt{'pkg'});
2979   }
2980
2981   my %pkg_opt = $part_pkg->options;
2982   my $pkg_opt_modified = 0;
2983
2984   $opt{'additional'} ||= [];
2985   my $i;
2986   my @old_additional;
2987   foreach (grep /^additional/, keys %pkg_opt) {
2988     ($i) = ($_ =~ /^additional_info(\d+)$/);
2989     $old_additional[$i] = $pkg_opt{$_} if $i;
2990     delete $pkg_opt{$_};
2991   }
2992
2993   for ( $i = 0; exists($opt{'additional'}->[$i]); $i++ ) {
2994     $pkg_opt{ "additional_info$i" } = $opt{'additional'}->[$i];
2995     if (!exists($old_additional[$i])
2996         or $old_additional[$i] ne $opt{'additional'}->[$i])
2997     {
2998       $pkg_opt_modified = 1;
2999     }
3000   }
3001   $pkg_opt_modified = 1 if (scalar(@old_additional) - 1) != $i;
3002   $pkg_opt{'additional_count'} = $i if $i > 0;
3003
3004   my $old_classnum;
3005   if ( exists($opt{'classnum'}) and $part_pkg->classnum ne $opt{'classnum'} )
3006   {
3007     # remember it
3008     $old_classnum = $part_pkg->classnum;
3009     $part_pkg->set('classnum', $opt{'classnum'});
3010   }
3011
3012   if ( !$self->get('setup') ) {
3013     # not yet billed, so allow amount, setup_cost, quantity, start_date,
3014     # and separate_bill
3015
3016     if ( exists($opt{'amount'}) 
3017           and $part_pkg->option('setup_fee') != $opt{'amount'}
3018           and $opt{'amount'} > 0 ) {
3019
3020       $pkg_opt{'setup_fee'} = $opt{'amount'};
3021       $pkg_opt_modified = 1;
3022     }
3023
3024     if ( exists($opt{'setup_cost'}) 
3025           and $part_pkg->setup_cost != $opt{'setup_cost'}
3026           and $opt{'setup_cost'} > 0 ) {
3027
3028       $part_pkg->set('setup_cost', $opt{'setup_cost'});
3029     }
3030
3031     if ( exists($opt{'quantity'})
3032           and $opt{'quantity'} != $self->quantity
3033           and $opt{'quantity'} > 0 ) {
3034         
3035       $self->set('quantity', $opt{'quantity'});
3036     }
3037
3038     if ( exists($opt{'start_date'})
3039           and $opt{'start_date'} != $self->start_date ) {
3040
3041       $self->set('start_date', $opt{'start_date'});
3042     }
3043
3044     if ( exists($opt{'separate_bill'})
3045           and $opt{'separate_bill'} ne $self->separate_bill ) {
3046
3047       $self->set('separate_bill', $opt{'separate_bill'});
3048     }
3049
3050
3051   } # else simply ignore them; the UI shouldn't allow editing the fields
3052
3053   
3054   if ( exists($opt{'taxclass'}) 
3055           and $part_pkg->taxclass ne $opt{'taxclass'}) {
3056     
3057       $part_pkg->set('taxclass', $opt{'taxclass'});
3058   }
3059
3060   my $error;
3061   if ( $part_pkg->modified or $pkg_opt_modified ) {
3062     # can we safely modify the package def?
3063     # Yes, if it's not available for purchase, and this is the only instance
3064     # of it.
3065     if ( $part_pkg->disabled
3066          and FS::cust_pkg->count('pkgpart = '.$part_pkg->pkgpart) == 1
3067          and FS::quotation_pkg->count('pkgpart = '.$part_pkg->pkgpart) == 0
3068        ) {
3069       $error = $part_pkg->replace( options => \%pkg_opt );
3070     } else {
3071       # clone it
3072       $part_pkg = $part_pkg->clone;
3073       $part_pkg->set('disabled' => 'Y');
3074       $error = $part_pkg->insert( options => \%pkg_opt );
3075       # and associate this as yet-unbilled package to the new package def
3076       $self->set('pkgpart' => $part_pkg->pkgpart);
3077     }
3078     if ( $error ) {
3079       $dbh->rollback if $oldAutoCommit;
3080       return $error;
3081     }
3082   }
3083
3084   if ($self->modified) { # for quantity or start_date change, or if we had
3085                          # to clone the existing package def
3086     my $error = $self->replace;
3087     return $error if $error;
3088   }
3089   if (defined $old_classnum) {
3090     # fix invoice grouping records
3091     my $old_catname = $old_classnum
3092                       ? FS::pkg_class->by_key($old_classnum)->categoryname
3093                       : '';
3094     my $new_catname = $opt{'classnum'}
3095                       ? $part_pkg->pkg_class->categoryname
3096                       : '';
3097     if ( $old_catname ne $new_catname ) {
3098       foreach my $cust_bill_pkg ($self->cust_bill_pkg) {
3099         # (there should only be one...)
3100         my @display = qsearch( 'cust_bill_pkg_display', {
3101             'billpkgnum'  => $cust_bill_pkg->billpkgnum,
3102             'section'     => $old_catname,
3103         });
3104         foreach (@display) {
3105           $_->set('section', $new_catname);
3106           $error = $_->replace;
3107           if ( $error ) {
3108             $dbh->rollback if $oldAutoCommit;
3109             return $error;
3110           }
3111         }
3112       } # foreach $cust_bill_pkg
3113     }
3114
3115     if ( $opt{'adjust_commission'} ) {
3116       # fix commission credits...tricky.
3117       foreach my $cust_event ($self->cust_event) {
3118         my $part_event = $cust_event->part_event;
3119         foreach my $table (qw(sales agent)) {
3120           my $class =
3121             "FS::part_event::Action::Mixin::credit_${table}_pkg_class";
3122           my $credit = qsearchs('cust_credit', {
3123               'eventnum' => $cust_event->eventnum,
3124           });
3125           if ( $part_event->isa($class) ) {
3126             # Yes, this results in current commission rates being applied 
3127             # retroactively to a one-time charge.  For accounting purposes 
3128             # there ought to be some kind of time limit on doing this.
3129             my $amount = $part_event->_calc_credit($self);
3130             if ( $credit and $credit->amount ne $amount ) {
3131               # Void the old credit.
3132               $error = $credit->void('Package class changed');
3133               if ( $error ) {
3134                 $dbh->rollback if $oldAutoCommit;
3135                 return "$error (adjusting commission credit)";
3136               }
3137             }
3138             # redo the event action to recreate the credit.
3139             local $@ = '';
3140             eval { $part_event->do_action( $self, $cust_event ) };
3141             if ( $@ ) {
3142               $dbh->rollback if $oldAutoCommit;
3143               return $@;
3144             }
3145           } # if $part_event->isa($class)
3146         } # foreach $table
3147       } # foreach $cust_event
3148     } # if $opt{'adjust_commission'}
3149   } # if defined $old_classnum
3150
3151   $dbh->commit if $oldAutoCommit;
3152   '';
3153 }
3154
3155
3156
3157 use Data::Dumper;
3158 sub process_bulk_cust_pkg {
3159   my $job = shift;
3160   my $param = shift;
3161   warn Dumper($param) if $DEBUG;
3162
3163   my $old_part_pkg = qsearchs('part_pkg', 
3164                               { pkgpart => $param->{'old_pkgpart'} });
3165   my $new_part_pkg = qsearchs('part_pkg',
3166                               { pkgpart => $param->{'new_pkgpart'} });
3167   die "Must select a new package type\n" unless $new_part_pkg;
3168   #my $keep_dates = $param->{'keep_dates'} || 0;
3169   my $keep_dates = 1; # there is no good reason to turn this off
3170
3171   my $oldAutoCommit = $FS::UID::AutoCommit;
3172   local $FS::UID::AutoCommit = 0;
3173   my $dbh = dbh;
3174
3175   my @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } );
3176
3177   my $i = 0;
3178   foreach my $old_cust_pkg ( @cust_pkgs ) {
3179     $i++;
3180     $job->update_statustext(int(100*$i/(scalar @cust_pkgs)));
3181     if ( $old_cust_pkg->getfield('cancel') ) {
3182       warn '[process_bulk_cust_pkg ] skipping canceled pkgnum '.
3183         $old_cust_pkg->pkgnum."\n"
3184         if $DEBUG;
3185       next;
3186     }
3187     warn '[process_bulk_cust_pkg] changing pkgnum '.$old_cust_pkg->pkgnum."\n"
3188       if $DEBUG;
3189     my $error = $old_cust_pkg->change(
3190       'pkgpart'     => $param->{'new_pkgpart'},
3191       'keep_dates'  => $keep_dates
3192     );
3193     if ( !ref($error) ) { # change returns the cust_pkg on success
3194       $dbh->rollback;
3195       die "Error changing pkgnum ".$old_cust_pkg->pkgnum.": '$error'\n";
3196     }
3197   }
3198   $dbh->commit if $oldAutoCommit;
3199   return;
3200 }
3201
3202 =item last_bill
3203
3204 Returns the last bill date, or if there is no last bill date, the setup date.
3205 Useful for billing metered services.
3206
3207 =cut
3208
3209 sub last_bill {
3210   my $self = shift;
3211   return $self->setfield('last_bill', $_[0]) if @_;
3212   return $self->getfield('last_bill') if $self->getfield('last_bill');
3213   my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
3214                                                   'edate'  => $self->bill,  } );
3215   $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
3216 }
3217
3218 =item last_cust_pkg_reason ACTION
3219
3220 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
3221 Returns false if there is no reason or the package is not currenly ACTION'd
3222 ACTION is one of adjourn, susp, cancel, or expire.
3223
3224 =cut
3225
3226 sub last_cust_pkg_reason {
3227   my ( $self, $action ) = ( shift, shift );
3228   my $date = $self->get($action);
3229   qsearchs( {
3230               'table' => 'cust_pkg_reason',
3231               'hashref' => { 'pkgnum' => $self->pkgnum,
3232                              'action' => substr(uc($action), 0, 1),
3233                              'date'   => $date,
3234                            },
3235               'order_by' => 'ORDER BY num DESC LIMIT 1',
3236            } );
3237 }
3238
3239 =item last_reason ACTION
3240
3241 Returns the most recent ACTION FS::reason associated with the package.
3242 Returns false if there is no reason or the package is not currenly ACTION'd
3243 ACTION is one of adjourn, susp, cancel, or expire.
3244
3245 =cut
3246
3247 sub last_reason {
3248   my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
3249   $cust_pkg_reason->reason
3250     if $cust_pkg_reason;
3251 }
3252
3253 =item part_pkg
3254
3255 Returns the definition for this billing item, as an FS::part_pkg object (see
3256 L<FS::part_pkg>).
3257
3258 =cut
3259
3260 sub part_pkg {
3261   my $self = shift;
3262   return $self->{'_pkgpart'} if $self->{'_pkgpart'};
3263   cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
3264   qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
3265 }
3266
3267 =item old_cust_pkg
3268
3269 Returns the cancelled package this package was changed from, if any.
3270
3271 =cut
3272
3273 sub old_cust_pkg {
3274   my $self = shift;
3275   return '' unless $self->change_pkgnum;
3276   qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
3277 }
3278
3279 =item change_cust_main
3280
3281 Returns the customter this package was detached to, if any.
3282
3283 =cut
3284
3285 sub change_cust_main {
3286   my $self = shift;
3287   return '' unless $self->change_custnum;
3288   qsearchs('cust_main', { 'custnum' => $self->change_custnum } );
3289 }
3290
3291 =item calc_setup
3292
3293 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
3294 item.
3295
3296 =cut
3297
3298 sub calc_setup {
3299   my $self = shift;
3300   $self->part_pkg->calc_setup($self, @_);
3301 }
3302
3303 =item calc_recur
3304
3305 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
3306 item.
3307
3308 =cut
3309
3310 sub calc_recur {
3311   my $self = shift;
3312   $self->part_pkg->calc_recur($self, @_);
3313 }
3314
3315 =item base_setup
3316
3317 Calls the I<base_setup> of the FS::part_pkg object associated with this billing
3318 item.
3319
3320 =cut
3321
3322 sub base_setup {
3323   my $self = shift;
3324   $self->part_pkg->base_setup($self, @_);
3325 }
3326
3327 =item base_recur
3328
3329 Calls the I<base_recur> of the FS::part_pkg object associated with this billing
3330 item.
3331
3332 =cut
3333
3334 sub base_recur {
3335   my $self = shift;
3336   $self->part_pkg->base_recur($self, @_);
3337 }
3338
3339 =item calc_remain
3340
3341 Calls the I<calc_remain> of the FS::part_pkg object associated with this
3342 billing item.
3343
3344 =cut
3345
3346 sub calc_remain {
3347   my $self = shift;
3348   $self->part_pkg->calc_remain($self, @_);
3349 }
3350
3351 =item calc_cancel
3352
3353 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
3354 billing item.
3355
3356 =cut
3357
3358 sub calc_cancel {
3359   my $self = shift;
3360   $self->part_pkg->calc_cancel($self, @_);
3361 }
3362
3363 =item cust_bill_pkg
3364
3365 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
3366
3367 =cut
3368
3369 sub cust_bill_pkg {
3370   my $self = shift;
3371   qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
3372 }
3373
3374 =item cust_pkg_detail [ DETAILTYPE ]
3375
3376 Returns any customer package details for this package (see
3377 L<FS::cust_pkg_detail>).
3378
3379 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
3380
3381 =cut
3382
3383 sub cust_pkg_detail {
3384   my $self = shift;
3385   my %hash = ( 'pkgnum' => $self->pkgnum );
3386   $hash{detailtype} = shift if @_;
3387   qsearch({
3388     'table'    => 'cust_pkg_detail',
3389     'hashref'  => \%hash,
3390     'order_by' => 'ORDER BY weight, pkgdetailnum',
3391   });
3392 }
3393
3394 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
3395
3396 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
3397
3398 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
3399
3400 If there is an error, returns the error, otherwise returns false.
3401
3402 =cut
3403
3404 sub set_cust_pkg_detail {
3405   my( $self, $detailtype, @details ) = @_;
3406
3407   my $oldAutoCommit = $FS::UID::AutoCommit;
3408   local $FS::UID::AutoCommit = 0;
3409   my $dbh = dbh;
3410
3411   foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
3412     my $error = $current->delete;
3413     if ( $error ) {
3414       $dbh->rollback if $oldAutoCommit;
3415       return "error removing old detail: $error";
3416     }
3417   }
3418
3419   foreach my $detail ( @details ) {
3420     my $cust_pkg_detail = new FS::cust_pkg_detail {
3421       'pkgnum'     => $self->pkgnum,
3422       'detailtype' => $detailtype,
3423       'detail'     => $detail,
3424     };
3425     my $error = $cust_pkg_detail->insert;
3426     if ( $error ) {
3427       $dbh->rollback if $oldAutoCommit;
3428       return "error adding new detail: $error";
3429     }
3430
3431   }
3432
3433   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3434   '';
3435
3436 }
3437
3438 =item cust_event
3439
3440 Returns the customer billing events (see L<FS::cust_event>) for this invoice.
3441
3442 =cut
3443
3444 #false laziness w/cust_bill.pm
3445 sub cust_event {
3446   my $self = shift;
3447   qsearch({
3448     'table'     => 'cust_event',
3449     'addl_from' => 'JOIN part_event USING ( eventpart )',
3450     'hashref'   => { 'tablenum' => $self->pkgnum },
3451     'extra_sql' => " AND eventtable = 'cust_pkg' ",
3452   });
3453 }
3454
3455 =item num_cust_event
3456
3457 Returns the number of customer billing events (see L<FS::cust_event>) for this package.
3458
3459 =cut
3460
3461 #false laziness w/cust_bill.pm
3462 sub num_cust_event {
3463   my $self = shift;
3464   my $sql = "SELECT COUNT(*) ". $self->_from_cust_event_where;
3465   $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref->[0];
3466 }
3467
3468 =item exists_cust_event
3469
3470 Returns true if there are customer billing events (see L<FS::cust_event>) for this package.  More efficient than using num_cust_event.
3471
3472 =cut
3473
3474 sub exists_cust_event {
3475   my $self = shift;
3476   my $sql = "SELECT 1 ". $self->_from_cust_event_where. " LIMIT 1";
3477   my $row = $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref;
3478   $row ? $row->[0] : '';
3479 }
3480
3481 sub _from_cust_event_where {
3482   #my $self = shift;
3483   " FROM cust_event JOIN part_event USING ( eventpart ) ".
3484   "  WHERE tablenum = ? AND eventtable = 'cust_pkg' ";
3485 }
3486
3487 sub _prep_ex {
3488   my( $self, $sql, @args ) = @_;
3489   my $sth = dbh->prepare($sql) or die  dbh->errstr. " preparing $sql"; 
3490   $sth->execute(@args)         or die $sth->errstr. " executing $sql";
3491   $sth;
3492 }
3493
3494 =item part_pkg_currency_option OPTIONNAME
3495
3496 Returns a two item list consisting of the currency of this customer, if any,
3497 and a value for the provided option.  If the customer has a currency, the value
3498 is the option value the given name and the currency (see
3499 L<FS::part_pkg_currency>).  Otherwise, if the customer has no currency, is the
3500 regular option value for the given name (see L<FS::part_pkg_option>).
3501
3502 =cut
3503
3504 sub part_pkg_currency_option {
3505   my( $self, $optionname ) = @_;
3506   my $part_pkg = $self->part_pkg;
3507   if ( my $currency = $self->cust_main->currency ) {
3508     ($currency, $part_pkg->part_pkg_currency_option($currency, $optionname) );
3509   } else {
3510     ('', $part_pkg->option($optionname) );
3511   }
3512 }
3513
3514 =item cust_svc [ SVCPART ] (old, deprecated usage)
3515
3516 =item cust_svc [ OPTION => VALUE ... ] (current usage)
3517
3518 =item cust_svc_unsorted [ OPTION => VALUE ... ] 
3519
3520 Returns the services for this package, as FS::cust_svc objects (see
3521 L<FS::cust_svc>).  Available options are svcpart and svcdb.  If either is
3522 spcififed, returns only the matching services.
3523
3524 As an optimization, use the cust_svc_unsorted version if you are not displaying
3525 the results.
3526
3527 =cut
3528
3529 sub cust_svc {
3530   my $self = shift;
3531   cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
3532   $self->_sort_cust_svc( $self->cust_svc_unsorted_arrayref(@_) );
3533 }
3534
3535 sub cust_svc_unsorted {
3536   my $self = shift;
3537   @{ $self->cust_svc_unsorted_arrayref(@_) };
3538 }
3539
3540 sub cust_svc_unsorted_arrayref {
3541   my $self = shift;
3542
3543   return [] unless $self->num_cust_svc(@_);
3544
3545   my %opt = ();
3546   if ( @_ && $_[0] =~ /^\d+/ ) {
3547     $opt{svcpart} = shift;
3548   } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
3549     %opt = %{ $_[0] };
3550   } elsif ( @_ ) {
3551     %opt = @_;
3552   }
3553
3554   my %search = (
3555     'select'    => 'cust_svc.*, part_svc.*',
3556     'table'     => 'cust_svc',
3557     'hashref'   => { 'pkgnum' => $self->pkgnum },
3558     'addl_from' => 'LEFT JOIN part_svc USING ( svcpart )',
3559   );
3560   $search{hashref}->{svcpart} = $opt{svcpart}
3561     if $opt{svcpart};
3562   $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{svcdb} )
3563     if $opt{svcdb};
3564
3565   [ qsearch(\%search) ];
3566
3567 }
3568
3569 =item overlimit [ SVCPART ]
3570
3571 Returns the services for this package which have exceeded their
3572 usage limit as FS::cust_svc objects (see L<FS::cust_svc>).  If a svcpart
3573 is specified, return only the matching services.
3574
3575 =cut
3576
3577 sub overlimit {
3578   my $self = shift;
3579   return () unless $self->num_cust_svc(@_);
3580   grep { $_->overlimit } $self->cust_svc(@_);
3581 }
3582
3583 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
3584
3585 Returns historical services for this package created before END TIMESTAMP and
3586 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
3587 (see L<FS::h_cust_svc>).  If MODE is 'I' (for 'invoice'), services with the 
3588 I<pkg_svc.hidden> flag will be omitted.
3589
3590 =cut
3591
3592 sub h_cust_svc {
3593   my $self = shift;
3594   warn "$me _h_cust_svc called on $self\n"
3595     if $DEBUG;
3596
3597   my ($end, $start, $mode) = @_;
3598
3599   local($FS::Record::qsearch_qualify_columns) = 0;
3600
3601   my @cust_svc = $self->_sort_cust_svc(
3602     [ qsearch( 'h_cust_svc',
3603       { 'pkgnum' => $self->pkgnum, },  
3604       FS::h_cust_svc->sql_h_search(@_),  
3605     ) ]
3606   );
3607
3608   if ( defined($mode) && $mode eq 'I' ) {
3609     my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc;
3610     return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc;
3611   } else {
3612     return @cust_svc;
3613   }
3614 }
3615
3616 sub _sort_cust_svc {
3617   my( $self, $arrayref ) = @_;
3618
3619   my $sort =
3620     sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] };
3621
3622   my %pkg_svc = map { $_->svcpart => $_ }
3623                 qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
3624
3625   map  { $_->[0] }
3626   sort $sort
3627   map {
3628         my $pkg_svc = $pkg_svc{ $_->svcpart } || '';
3629         [ $_,
3630           $pkg_svc ? $pkg_svc->primary_svc : '',
3631           $pkg_svc ? $pkg_svc->quantity : 0,
3632         ];
3633       }
3634   @$arrayref;
3635
3636 }
3637
3638 =item num_cust_svc [ SVCPART ] (old, deprecated usage)
3639
3640 =item num_cust_svc [ OPTION => VALUE ... ] (current usage)
3641
3642 Returns the number of services for this package.  Available options are svcpart
3643 and svcdb.  If either is spcififed, returns only the matching services.
3644
3645 =cut
3646
3647 sub num_cust_svc {
3648   my $self = shift;
3649
3650   return $self->{'_num_cust_svc'}
3651     if !scalar(@_)
3652        && exists($self->{'_num_cust_svc'})
3653        && $self->{'_num_cust_svc'} =~ /\d/;
3654
3655   cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
3656     if $DEBUG > 2;
3657
3658   my %opt = ();
3659   if ( @_ && $_[0] =~ /^\d+/ ) {
3660     $opt{svcpart} = shift;
3661   } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
3662     %opt = %{ $_[0] };
3663   } elsif ( @_ ) {
3664     %opt = @_;
3665   }
3666
3667   my $select = 'SELECT COUNT(*) FROM cust_svc ';
3668   my $where = ' WHERE pkgnum = ? ';
3669   my @param = ($self->pkgnum);
3670
3671   if ( $opt{'svcpart'} ) {
3672     $where .= ' AND svcpart = ? ';
3673     push @param, $opt{'svcpart'};
3674   }
3675   if ( $opt{'svcdb'} ) {
3676     $select .= ' LEFT JOIN part_svc USING ( svcpart ) ';
3677     $where .= ' AND svcdb = ? ';
3678     push @param, $opt{'svcdb'};
3679   }
3680
3681   my $sth = dbh->prepare("$select $where") or die  dbh->errstr;
3682   $sth->execute(@param) or die $sth->errstr;
3683   $sth->fetchrow_arrayref->[0];
3684 }
3685
3686 =item available_part_svc 
3687
3688 Returns a list of FS::part_svc objects representing services included in this
3689 package but not yet provisioned.  Each FS::part_svc object also has an extra
3690 field, I<num_avail>, which specifies the number of available services.
3691
3692 Accepts option I<provision_hold>;  if true, only returns part_svc for which the
3693 associated pkg_svc has the provision_hold flag set.
3694
3695 =cut
3696
3697 sub available_part_svc {
3698   my $self = shift;
3699   my %opt  = @_;
3700
3701   my $pkg_quantity = $self->quantity || 1;
3702
3703   grep { $_->num_avail > 0 }
3704   map {
3705     my $part_svc = $_->part_svc;
3706     $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
3707     $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart);
3708
3709     # more evil encapsulation breakage
3710     if ($part_svc->{'Hash'}{'num_avail'} > 0) {
3711       my @exports = $part_svc->part_export_did;
3712       $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
3713         }
3714
3715     $part_svc;
3716   }
3717   grep { $opt{'provision_hold'} ? $_->provision_hold : 1 }
3718   $self->part_pkg->pkg_svc;
3719 }
3720
3721 =item part_svc [ OPTION => VALUE ... ]
3722
3723 Returns a list of FS::part_svc objects representing provisioned and available
3724 services included in this package.  Each FS::part_svc object also has the
3725 following extra fields:
3726
3727 =over 4
3728
3729 =item num_cust_svc
3730
3731 (count)
3732
3733 =item num_avail
3734
3735 (quantity - count)
3736
3737 =item cust_pkg_svc
3738
3739 (services) - array reference containing the provisioned services, as cust_svc objects
3740
3741 =back
3742
3743 Accepts two options:
3744
3745 =over 4
3746
3747 =item summarize_size
3748
3749 If true, will omit the extra cust_pkg_svc option for objects where num_cust_svc
3750 is this size or greater.
3751
3752 =item hide_discontinued
3753
3754 If true, will omit looking for services that are no longer avaialble in the
3755 package definition.
3756
3757 =back
3758
3759 =cut
3760
3761 #svcnum
3762 #label -> ($cust_svc->label)[1]
3763
3764 sub part_svc {
3765   my $self = shift;
3766   my %opt = @_;
3767
3768   my $pkg_quantity = $self->quantity || 1;
3769
3770   #XXX some sort of sort order besides numeric by svcpart...
3771   my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
3772     my $pkg_svc = $_;
3773     my $part_svc = $pkg_svc->part_svc;
3774     my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
3775     $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
3776     $part_svc->{'Hash'}{'num_avail'}    =
3777       max( 0, $pkg_quantity * $pkg_svc->quantity - $num_cust_svc );
3778     $part_svc->{'Hash'}{'cust_pkg_svc'} =
3779         $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []
3780       unless exists($opt{summarize_size}) && $opt{summarize_size} > 0
3781           && $num_cust_svc >= $opt{summarize_size};
3782     $part_svc->{'Hash'}{'hidden'} = $pkg_svc->hidden;
3783     $part_svc;
3784   } $self->part_pkg->pkg_svc;
3785
3786   unless ( $opt{hide_discontinued} ) {
3787     #extras
3788     push @part_svc, map {
3789       my $part_svc = $_;
3790       my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
3791       $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
3792       $part_svc->{'Hash'}{'num_avail'}    = 0; #0-$num_cust_svc ?
3793       $part_svc->{'Hash'}{'cust_pkg_svc'} =
3794         $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
3795       $part_svc;
3796     } $self->extra_part_svc;
3797   }
3798
3799   @part_svc;
3800
3801 }
3802
3803 =item extra_part_svc
3804
3805 Returns a list of FS::part_svc objects corresponding to services in this
3806 package which are still provisioned but not (any longer) available in the
3807 package definition.
3808
3809 =cut
3810
3811 sub extra_part_svc {
3812   my $self = shift;
3813
3814   my $pkgnum  = $self->pkgnum;
3815   #my $pkgpart = $self->pkgpart;
3816
3817 #  qsearch( {
3818 #    'table'     => 'part_svc',
3819 #    'hashref'   => {},
3820 #    'extra_sql' =>
3821 #      "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc 
3822 #                     WHERE pkg_svc.svcpart = part_svc.svcpart 
3823 #                       AND pkg_svc.pkgpart = ?
3824 #                       AND quantity > 0 
3825 #                 )
3826 #        AND 0 < ( SELECT COUNT(*) FROM cust_svc
3827 #                       LEFT JOIN cust_pkg USING ( pkgnum )
3828 #                     WHERE cust_svc.svcpart = part_svc.svcpart
3829 #                       AND pkgnum = ?
3830 #                 )",
3831 #    'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
3832 #  } );
3833
3834 #seems to benchmark slightly faster... (or did?)
3835
3836   my @pkgparts = map $_->pkgpart, $self->part_pkg->self_and_svc_linked;
3837   my $pkgparts = join(',', @pkgparts);
3838
3839   qsearch( {
3840     #'select'      => 'DISTINCT ON (svcpart) part_svc.*',
3841     #MySQL doesn't grok DISINCT ON
3842     'select'      => 'DISTINCT part_svc.*',
3843     'table'       => 'part_svc',
3844     'addl_from'   =>
3845       "LEFT JOIN pkg_svc  ON (     pkg_svc.svcpart   = part_svc.svcpart 
3846                                AND pkg_svc.pkgpart IN ($pkgparts)
3847                                AND quantity > 0
3848                              )
3849        LEFT JOIN cust_svc ON (     cust_svc.svcpart = part_svc.svcpart )
3850        LEFT JOIN cust_pkg USING ( pkgnum )
3851       ",
3852     'hashref'     => {},
3853     'extra_sql'   => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
3854     'extra_param' => [ [$self->pkgnum=>'int'] ],
3855   } );
3856 }
3857
3858 =item status
3859
3860 Returns a short status string for this package, currently:
3861
3862 =over 4
3863
3864 =item on hold
3865
3866 =item not yet billed
3867
3868 =item one-time charge
3869
3870 =item active
3871
3872 =item suspended
3873
3874 =item cancelled
3875
3876 =back
3877
3878 =cut
3879
3880 sub status {
3881   my $self = shift;
3882
3883   my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
3884
3885   return 'cancelled' if $self->get('cancel');
3886   return 'on hold' if $self->susp && ! $self->setup;
3887   return 'suspended' if $self->susp;
3888   return 'not yet billed' unless $self->setup;
3889   return 'one-time charge' if $freq =~ /^(0|$)/;
3890   return 'active';
3891 }
3892
3893 =item ucfirst_status
3894
3895 Returns the status with the first character capitalized.
3896
3897 =cut
3898
3899 sub ucfirst_status {
3900   ucfirst(shift->status);
3901 }
3902
3903 =item statuses
3904
3905 Class method that returns the list of possible status strings for packages
3906 (see L<the status method|/status>).  For example:
3907
3908   @statuses = FS::cust_pkg->statuses();
3909
3910 =cut
3911
3912 tie my %statuscolor, 'Tie::IxHash', 
3913   'on hold'         => 'FF00F5', #brighter purple!
3914   'not yet billed'  => '009999', #teal? cyan?
3915   'one-time charge' => '0000CC', #blue  #'000000',
3916   'active'          => '00CC00',
3917   'suspended'       => 'FF9900',
3918   'cancelled'       => 'FF0000',
3919 ;
3920
3921 sub statuses {
3922   my $self = shift; #could be class...
3923   #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
3924   #                                    # mayble split btw one-time vs. recur
3925     keys %statuscolor;
3926 }
3927
3928 sub statuscolors {
3929   #my $self = shift;
3930   \%statuscolor;
3931 }
3932
3933 =item statuscolor
3934
3935 Returns a hex triplet color string for this package's status.
3936
3937 =cut
3938
3939 sub statuscolor {
3940   my $self = shift;
3941   $statuscolor{$self->status};
3942 }
3943
3944 =item is_status_delay_cancel
3945
3946 Returns true if part_pkg has option delay_cancel, 
3947 cust_pkg status is 'suspended' and expire is set
3948 to cancel package within the next day (or however
3949 many days are set in global config part_pkg-delay_cancel-days.
3950
3951 Accepts option I<part_pkg-delay_cancel-days> which should be
3952 the value of the config setting, to avoid looking it up again.
3953
3954 This is not a real status, this only meant for hacking display 
3955 values, because otherwise treating the package as suspended is 
3956 really the whole point of the delay_cancel option.
3957
3958 =cut
3959
3960 sub is_status_delay_cancel {
3961   my ($self,%opt) = @_;
3962   if ( $self->main_pkgnum and $self->pkglinknum ) {
3963     return $self->main_pkg->is_status_delay_cancel;
3964   }
3965   return 0 unless $self->part_pkg->option('delay_cancel',1);
3966   return 0 unless $self->status eq 'suspended';
3967   return 0 unless $self->expire;
3968   my $expdays = $opt{'part_pkg-delay_cancel-days'};
3969   unless ($expdays) {
3970     my $conf = new FS::Conf;
3971     $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
3972   }
3973   my $expsecs = 60*60*24*$expdays;
3974   return 0 unless $self->expire < time + $expsecs;
3975   return 1;
3976 }
3977
3978 =item pkg_label
3979
3980 Returns a label for this package.  (Currently "pkgnum: pkg - comment" or
3981 "pkg - comment" depending on user preference).
3982
3983 =cut
3984
3985 sub pkg_label {
3986   my $self = shift;
3987   my $label = $self->part_pkg->pkg_comment( cust_pkg=>$self, nopkgpart=>1 );
3988   $label = $self->pkgnum. ": $label"
3989     if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
3990   $label;
3991 }
3992
3993 =item pkg_label_long
3994
3995 Returns a long label for this package, adding the primary service's label to
3996 pkg_label.
3997
3998 =cut
3999
4000 sub pkg_label_long {
4001   my $self = shift;
4002   my $label = $self->pkg_label;
4003   my $cust_svc = $self->primary_cust_svc;
4004   $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
4005   $label;
4006 }
4007
4008 =item pkg_locale
4009
4010 Returns a customer-localized label for this package.
4011
4012 =cut
4013
4014 sub pkg_locale {
4015   my $self = shift;
4016   $self->part_pkg->pkg_locale( $self->cust_main->locale );
4017 }
4018
4019 =item primary_cust_svc
4020
4021 Returns a primary service (as FS::cust_svc object) if one can be identified.
4022
4023 =cut
4024
4025 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
4026
4027 sub primary_cust_svc {
4028   my $self = shift;
4029
4030   my @cust_svc = $self->cust_svc;
4031
4032   return '' unless @cust_svc; #no serivces - irrelevant then
4033   
4034   return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
4035
4036   # primary service as specified in the package definition
4037   # or exactly one service definition with quantity one
4038   my $svcpart = $self->part_pkg->svcpart;
4039   @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
4040   return $cust_svc[0] if scalar(@cust_svc) == 1;
4041
4042   #couldn't identify one thing..
4043   return '';
4044 }
4045
4046 =item labels
4047
4048 Returns a list of lists, calling the label method for all services
4049 (see L<FS::cust_svc>) of this billing item.
4050
4051 =cut
4052
4053 sub labels {
4054   my $self = shift;
4055   map { [ $_->label ] } $self->cust_svc;
4056 }
4057
4058 =item h_labels END_TIMESTAMP [, START_TIMESTAMP [, MODE [, LOCALE ] ] ]
4059
4060 Like the labels method, but returns historical information on services that
4061 were active as of END_TIMESTAMP and (optionally) not cancelled before
4062 START_TIMESTAMP.  If MODE is 'I' (for 'invoice'), services with the 
4063 I<pkg_svc.hidden> flag will be omitted.
4064
4065 If LOCALE is passed, service definition names will be localized.
4066
4067 Returns a list of lists, calling the label method for all (historical)
4068 services (see L<FS::h_cust_svc>) of this billing item.
4069
4070 =cut
4071
4072 sub h_labels {
4073   my $self = shift;
4074   my ($end, $start, $mode, $locale) = @_;
4075   warn "$me h_labels\n"
4076     if $DEBUG;
4077   map { [ $_->label($end, $start, $locale) ] }
4078         $self->h_cust_svc($end, $start, $mode);
4079 }
4080
4081 =item labels_short
4082
4083 Like labels, except returns a simple flat list, and shortens long
4084 (currently >5 or the cust_bill-max_same_services configuration value) lists of
4085 identical services to one line that lists the service label and the number of
4086 individual services rather than individual items.
4087
4088 =cut
4089
4090 sub labels_short {
4091   shift->_labels_short( 'labels' ); # 'labels' takes no further arguments
4092 }
4093
4094 =item h_labels_short END_TIMESTAMP [, START_TIMESTAMP [, MODE [, LOCALE ] ] ]
4095
4096 Like h_labels, except returns a simple flat list, and shortens long
4097 (currently >5 or the cust_bill-max_same_services configuration value) lists
4098 of identical services to one line that lists the service label and the
4099 number of individual services rather than individual items.
4100
4101 =cut
4102
4103 sub h_labels_short {
4104   shift->_labels_short( 'h_labels', @_ );
4105 }
4106
4107 # takes a method name ('labels' or 'h_labels') and all its arguments;
4108 # maybe should be "shorten($self->h_labels( ... ) )"
4109
4110 sub _labels_short {
4111   my( $self, $method ) = ( shift, shift );
4112
4113   warn "$me _labels_short called on $self with $method method\n"
4114     if $DEBUG;
4115
4116   my $conf = new FS::Conf;
4117   my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
4118
4119   warn "$me _labels_short populating \%labels\n"
4120     if $DEBUG;
4121
4122   my %labels;
4123   #tie %labels, 'Tie::IxHash';
4124   push @{ $labels{$_->[0]} }, $_->[1]
4125     foreach $self->$method(@_);
4126
4127   warn "$me _labels_short populating \@labels\n"
4128     if $DEBUG;
4129
4130   my @labels;
4131   foreach my $label ( keys %labels ) {
4132     my %seen = ();
4133     my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
4134     my $num = scalar(@values);
4135     warn "$me _labels_short $num items for $label\n"
4136       if $DEBUG;
4137
4138     if ( $num > $max_same_services ) {
4139       warn "$me _labels_short   more than $max_same_services, so summarizing\n"
4140         if $DEBUG;
4141       push @labels, "$label ($num)";
4142     } else {
4143       if ( $conf->exists('cust_bill-consolidate_services') ) {
4144         warn "$me _labels_short   consolidating services\n"
4145           if $DEBUG;
4146         # push @labels, "$label: ". join(', ', @values);
4147         while ( @values ) {
4148           my $detail = "$label: ";
4149           $detail .= shift(@values). ', '
4150             while @values
4151                && ( length($detail.$values[0]) < 78 || $detail eq "$label: " );
4152           $detail =~ s/, $//;
4153           push @labels, $detail;
4154         }
4155         warn "$me _labels_short   done consolidating services\n"
4156           if $DEBUG;
4157       } else {
4158         warn "$me _labels_short   adding service data\n"
4159           if $DEBUG;
4160         push @labels, map { "$label: $_" } @values;
4161       }
4162     }
4163   }
4164
4165  @labels;
4166
4167 }
4168
4169 =item cust_main
4170
4171 Returns the parent customer object (see L<FS::cust_main>).
4172
4173 =item balance
4174
4175 Returns the balance for this specific package, when using
4176 experimental package balance.
4177
4178 =cut
4179
4180 sub balance {
4181   my $self = shift;
4182   $self->cust_main->balance_pkgnum( $self->pkgnum );
4183 }
4184
4185 #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
4186
4187 =item cust_location
4188
4189 Returns the location object, if any (see L<FS::cust_location>).
4190
4191 =item cust_location_or_main
4192
4193 If this package is associated with a location, returns the locaiton (see
4194 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
4195
4196 =item location_label [ OPTION => VALUE ... ]
4197
4198 Returns the label of the location object (see L<FS::cust_location>).
4199
4200 =cut
4201
4202 #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
4203
4204 =item tax_locationnum
4205
4206 Returns the foreign key to a L<FS::cust_location> object for calculating  
4207 tax on this package, as determined by the C<tax-pkg_address> and 
4208 C<tax-ship_address> configuration flags.
4209
4210 =cut
4211
4212 sub tax_locationnum {
4213   my $self = shift;
4214   my $conf = FS::Conf->new;
4215   if ( $conf->exists('tax-pkg_address') ) {
4216     return $self->locationnum;
4217   }
4218   elsif ( $conf->exists('tax-ship_address') ) {
4219     return $self->cust_main->ship_locationnum;
4220   }
4221   else {
4222     return $self->cust_main->bill_locationnum;
4223   }
4224 }
4225
4226 =item tax_location
4227
4228 Returns the L<FS::cust_location> object for tax_locationnum.
4229
4230 =cut
4231
4232 sub tax_location {
4233   my $self = shift;
4234   my $conf = FS::Conf->new;
4235   if ( $conf->exists('tax-pkg_address') and $self->locationnum ) {
4236     return FS::cust_location->by_key($self->locationnum);
4237   }
4238   elsif ( $conf->exists('tax-ship_address') ) {
4239     return $self->cust_main->ship_location;
4240   }
4241   else {
4242     return $self->cust_main->bill_location;
4243   }
4244 }
4245
4246 =item seconds_since TIMESTAMP
4247
4248 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
4249 package have been online since TIMESTAMP, according to the session monitor.
4250
4251 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
4252 L<Time::Local> and L<Date::Parse> for conversion functions.
4253
4254 =cut
4255
4256 sub seconds_since {
4257   my($self, $since) = @_;
4258   my $seconds = 0;
4259
4260   foreach my $cust_svc (
4261     grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
4262   ) {
4263     $seconds += $cust_svc->seconds_since($since);
4264   }
4265
4266   $seconds;
4267
4268 }
4269
4270 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
4271
4272 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
4273 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
4274 (exclusive).
4275
4276 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
4277 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
4278 functions.
4279
4280
4281 =cut
4282
4283 sub seconds_since_sqlradacct {
4284   my($self, $start, $end) = @_;
4285
4286   my $seconds = 0;
4287
4288   foreach my $cust_svc (
4289     grep {
4290       my $part_svc = $_->part_svc;
4291       $part_svc->svcdb eq 'svc_acct'
4292         && scalar($part_svc->part_export_usage);
4293     } $self->cust_svc
4294   ) {
4295     $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
4296   }
4297
4298   $seconds;
4299
4300 }
4301
4302 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
4303
4304 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
4305 in this package for sessions ending between TIMESTAMP_START (inclusive) and
4306 TIMESTAMP_END
4307 (exclusive).
4308
4309 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
4310 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
4311 functions.
4312
4313 =cut
4314
4315 sub attribute_since_sqlradacct {
4316   my($self, $start, $end, $attrib) = @_;
4317
4318   my $sum = 0;
4319
4320   foreach my $cust_svc (
4321     grep {
4322       my $part_svc = $_->part_svc;
4323       scalar($part_svc->part_export_usage);
4324     } $self->cust_svc
4325   ) {
4326     $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
4327   }
4328
4329   $sum;
4330
4331 }
4332
4333 =item quantity
4334
4335 =cut
4336
4337 sub quantity {
4338   my( $self, $value ) = @_;
4339   if ( defined($value) ) {
4340     $self->setfield('quantity', $value);
4341   }
4342   $self->getfield('quantity') || 1;
4343 }
4344
4345 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
4346
4347 Transfers as many services as possible from this package to another package.
4348
4349 The destination package can be specified by pkgnum by passing an FS::cust_pkg
4350 object.  The destination package must already exist.
4351
4352 Services are moved only if the destination allows services with the correct
4353 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true.  Use
4354 this option with caution!  No provision is made for export differences
4355 between the old and new service definitions.  Probably only should be used
4356 when your exports for all service definitions of a given svcdb are identical.
4357 (attempt a transfer without it first, to move all possible svcpart-matching
4358 services)
4359
4360 Any services that can't be moved remain in the original package.
4361
4362 Returns an error, if there is one; otherwise, returns the number of services 
4363 that couldn't be moved.
4364
4365 =cut
4366
4367 sub transfer {
4368   my ($self, $dest_pkgnum, %opt) = @_;
4369
4370   my $remaining = 0;
4371   my $dest;
4372   my %target;
4373
4374   if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
4375     $dest = $dest_pkgnum;
4376     $dest_pkgnum = $dest->pkgnum;
4377   } else {
4378     $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
4379   }
4380
4381   return ('Package does not exist: '.$dest_pkgnum) unless $dest;
4382
4383   foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
4384     $target{$pkg_svc->svcpart} = $pkg_svc->quantity * ( $dest->quantity || 1 );
4385   }
4386
4387   foreach my $cust_svc ($dest->cust_svc) {
4388     $target{$cust_svc->svcpart}--;
4389   }
4390
4391   my %svcpart2svcparts = ();
4392   if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
4393     warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
4394     foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
4395       next if exists $svcpart2svcparts{$svcpart};
4396       my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
4397       $svcpart2svcparts{$svcpart} = [
4398         map  { $_->[0] }
4399         sort { $b->[1] cmp $a->[1]  or  $a->[2] <=> $b->[2] } 
4400         map {
4401               my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
4402                                                    'svcpart' => $_          } );
4403               [ $_,
4404                 $pkg_svc ? $pkg_svc->primary_svc : '',
4405                 $pkg_svc ? $pkg_svc->quantity : 0,
4406               ];
4407             }
4408
4409         grep { $_ != $svcpart }
4410         map  { $_->svcpart }
4411         qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
4412       ];
4413       warn "alternates for svcpart $svcpart: ".
4414            join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
4415         if $DEBUG;
4416     }
4417   }
4418
4419   my $error;
4420   foreach my $cust_svc ($self->cust_svc) {
4421     my $svcnum = $cust_svc->svcnum;
4422     if($target{$cust_svc->svcpart} > 0
4423        or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option
4424       $target{$cust_svc->svcpart}--;
4425       my $new = new FS::cust_svc { $cust_svc->hash };
4426       $new->pkgnum($dest_pkgnum);
4427       $error = $new->replace($cust_svc);
4428     } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
4429       if ( $DEBUG ) {
4430         warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
4431         warn "alternates to consider: ".
4432              join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
4433       }
4434       my @alternate = grep {
4435                              warn "considering alternate svcpart $_: ".
4436                                   "$target{$_} available in new package\n"
4437                                if $DEBUG;
4438                              $target{$_} > 0;
4439                            } @{$svcpart2svcparts{$cust_svc->svcpart}};
4440       if ( @alternate ) {
4441         warn "alternate(s) found\n" if $DEBUG;
4442         my $change_svcpart = $alternate[0];
4443         $target{$change_svcpart}--;
4444         my $new = new FS::cust_svc { $cust_svc->hash };
4445         $new->svcpart($change_svcpart);
4446         $new->pkgnum($dest_pkgnum);
4447         $error = $new->replace($cust_svc);
4448       } else {
4449         $remaining++;
4450       }
4451     } else {
4452       $remaining++
4453     }
4454     if ( $error ) {
4455       my @label = $cust_svc->label;
4456       return "$label[0] $label[1]: $error";
4457     }
4458   }
4459   return $remaining;
4460 }
4461
4462 =item grab_svcnums SVCNUM, SVCNUM ...
4463
4464 Change the pkgnum for the provided services to this packages.  If there is an
4465 error, returns the error, otherwise returns false.
4466
4467 =cut
4468
4469 sub grab_svcnums {
4470   my $self = shift;
4471   my @svcnum = @_;
4472
4473   my $oldAutoCommit = $FS::UID::AutoCommit;
4474   local $FS::UID::AutoCommit = 0;
4475   my $dbh = dbh;
4476
4477   foreach my $svcnum (@svcnum) {
4478     my $cust_svc = qsearchs('cust_svc', { svcnum=>$svcnum } ) or do {
4479       $dbh->rollback if $oldAutoCommit;
4480       return "unknown svcnum $svcnum";
4481     };
4482     $cust_svc->pkgnum( $self->pkgnum );
4483     my $error = $cust_svc->replace;
4484     if ( $error ) {
4485       $dbh->rollback if $oldAutoCommit;
4486       return $error;
4487     }
4488   }
4489
4490   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4491   '';
4492
4493 }
4494
4495 =item reexport
4496
4497 This method is deprecated.  See the I<depend_jobnum> option to the insert and
4498 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
4499
4500 =cut
4501
4502 #looks like this is still used by the order_pkg and change_pkg methods in
4503 # ClientAPI/MyAccount, need to look into those before removing
4504 sub reexport {
4505   my $self = shift;
4506
4507   my $oldAutoCommit = $FS::UID::AutoCommit;
4508   local $FS::UID::AutoCommit = 0;
4509   my $dbh = dbh;
4510
4511   foreach my $cust_svc ( $self->cust_svc ) {
4512     #false laziness w/svc_Common::insert
4513     my $svc_x = $cust_svc->svc_x;
4514     foreach my $part_export ( $cust_svc->part_svc->part_export ) {
4515       my $error = $part_export->export_insert($svc_x);
4516       if ( $error ) {
4517         $dbh->rollback if $oldAutoCommit;
4518         return $error;
4519       }
4520     }
4521   }
4522
4523   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4524   '';
4525