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