add quantity and location to self-service package order API, RT#33219
[freeside.git] / FS / FS / cust_main / Packages.pm
1 package FS::cust_main::Packages;
2
3 use strict;
4 use vars qw( $DEBUG $me );
5 use List::Util qw( min );
6 use FS::UID qw( dbh );
7 use FS::Record qw( qsearch qsearchs );
8 use FS::cust_pkg;
9 use FS::cust_svc;
10 use FS::contact;       # for attach_pkgs
11 use FS::cust_location; #
12
13 $DEBUG = 0;
14 $me = '[FS::cust_main::Packages]';
15
16 =head1 NAME
17
18 FS::cust_main::Packages - Packages mixin for cust_main
19
20 =head1 SYNOPSIS
21
22 =head1 DESCRIPTION
23
24 These methods are available on FS::cust_main objects;
25
26 =head1 METHODS
27
28 =over 4
29
30 =item order_pkg HASHREF | OPTION => VALUE ... 
31
32 Orders a single package.
33
34 Note that if the package definition has supplemental packages, those will
35 be ordered as well.
36
37 Options may be passed as a list of key/value pairs or as a hash reference.
38 Options are:
39
40 =over 4
41
42 =item cust_pkg
43
44 FS::cust_pkg object
45
46 =item cust_location
47
48 Optional FS::cust_location object.  If not specified, the customer's 
49 ship_location will be used.
50
51 =item svcs
52
53 Optional arryaref of FS::svc_* service objects.
54
55 =item depend_jobnum
56
57 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
58 jobs will have a dependancy on the supplied job (they will not run until the
59 specific job completes).  This can be used to defer provisioning until some
60 action completes (such as running the customer's credit card successfully).
61
62 =item noexport
63
64 This option is option is deprecated but still works for now (use
65 I<depend_jobnum> instead for new code).  If I<noexport> is set true, no
66 provisioning jobs (exports) are scheduled.  (You can schedule them later with
67 the B<reexport> method for each cust_pkg object.  Using the B<reexport> method
68 on the cust_main object is not recommended, as existing services will also be
69 reexported.)
70
71 =item ticket_subject
72
73 Optional subject for a ticket created and attached to this customer
74
75 =item ticket_queue
76
77 Optional queue name for ticket additions
78
79 =back
80
81 =cut
82
83 sub order_pkg {
84   my $self = shift;
85   my $opt = ref($_[0]) ? shift : { @_ };
86
87   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
88
89   warn "$me order_pkg called with options ".
90        join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
91     if $DEBUG;
92
93   local $FS::svc_Common::noexport_hack = 1 if $opt->{'noexport'};
94
95   my $cust_pkg = $opt->{'cust_pkg'};
96   my $svcs     = $opt->{'svcs'} || [];
97
98   my %svc_options = ();
99   $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
100     if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
101
102   my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
103                           qw( ticket_subject ticket_queue allow_pkgpart );
104
105   local $SIG{HUP} = 'IGNORE';
106   local $SIG{INT} = 'IGNORE';
107   local $SIG{QUIT} = 'IGNORE';
108   local $SIG{TERM} = 'IGNORE';
109   local $SIG{TSTP} = 'IGNORE';
110   local $SIG{PIPE} = 'IGNORE';
111
112   my $oldAutoCommit = $FS::UID::AutoCommit;
113   local $FS::UID::AutoCommit = 0;
114   my $dbh = dbh;
115
116   if ( $opt->{'contactnum'} and $opt->{'contactnum'} != -1 ) {
117
118     $cust_pkg->contactnum($opt->{'contactnum'});
119
120   } elsif ( $opt->{'contact'} ) {
121
122     if ( ! $opt->{'contact'}->contactnum ) {
123       # not inserted yet
124       my $error = $opt->{'contact'}->insert;
125       if ( $error ) {
126         $dbh->rollback if $oldAutoCommit;
127         return "inserting contact (transaction rolled back): $error";
128       }
129     }
130     $cust_pkg->contactnum($opt->{'contact'}->contactnum);
131
132   #} else {
133   #
134   #  $cust_pkg->contactnum();
135
136   }
137
138   if ( $opt->{'locationnum'} and $opt->{'locationnum'} != -1 ) {
139
140     $cust_pkg->locationnum($opt->{'locationnum'});
141
142   } elsif ( $opt->{'cust_location'} ) {
143
144     my $error = $opt->{'cust_location'}->find_or_insert;
145     if ( $error ) {
146       $dbh->rollback if $oldAutoCommit;
147       return "inserting cust_location (transaction rolled back): $error";
148     }
149     $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
150
151   } else {
152
153     $cust_pkg->locationnum($self->ship_locationnum);
154
155   }
156
157   $cust_pkg->custnum( $self->custnum );
158
159   my $error = $cust_pkg->insert( %insert_params );
160   if ( $error ) {
161     $dbh->rollback if $oldAutoCommit;
162     return "inserting cust_pkg (transaction rolled back): $error";
163   }
164
165   foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
166     if ( $svc_something->svcnum ) {
167       my $old_cust_svc = $svc_something->cust_svc;
168       my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
169       $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
170       $error = $new_cust_svc->replace($old_cust_svc);
171     } else {
172       $svc_something->pkgnum( $cust_pkg->pkgnum );
173       if ( $svc_something->isa('FS::svc_acct') ) {
174         foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
175                        qw( seconds upbytes downbytes totalbytes )      ) {
176           $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
177           ${ $opt->{$_.'_ref'} } = 0;
178         }
179       }
180       $error = $svc_something->insert(%svc_options);
181     }
182     if ( $error ) {
183       $dbh->rollback if $oldAutoCommit;
184       return "inserting svc_ (transaction rolled back): $error";
185     }
186   }
187
188   # add supplemental packages, if any are needed
189   my $part_pkg = FS::part_pkg->by_key($cust_pkg->pkgpart);
190   foreach my $link ($part_pkg->supp_part_pkg_link) {
191     #warn "inserting supplemental package ".$link->dst_pkgpart;
192     my $pkg = FS::cust_pkg->new({
193         'pkgpart'       => $link->dst_pkgpart,
194         'pkglinknum'    => $link->pkglinknum,
195         'custnum'       => $self->custnum,
196         'main_pkgnum'   => $cust_pkg->pkgnum,
197         # try to prevent as many surprises as possible
198         'allow_pkgpart' => $opt->{'allow_pkgpart'},
199         map { $_ => $cust_pkg->$_() }
200           qw( pkgbatch
201               start_date order_date expire adjourn contract_end
202               refnum discountnum waive_setup
203             )
204     });
205     $error = $self->order_pkg('cust_pkg'    => $pkg,
206                               'locationnum' => $cust_pkg->locationnum);
207     if ( $error ) {
208       $dbh->rollback if $oldAutoCommit;
209       return "inserting supplemental package: $error";
210     }
211   }
212
213   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
214   ''; #no error
215
216 }
217
218 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
219
220 Like the insert method on an existing record, this method orders multiple
221 packages and included services atomicaly.  Pass a Tie::RefHash data structure
222 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
223 There should be a better explanation of this, but until then, here's an
224 example:
225
226   use Tie::RefHash;
227   tie %hash, 'Tie::RefHash'; #this part is important
228   %hash = (
229     $cust_pkg => [ $svc_acct ],
230     ...
231   );
232   $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
233
234 Services can be new, in which case they are inserted, or existing unaudited
235 services, in which case they are linked to the newly-created package.
236
237 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
238 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
239
240 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
241 on the supplied jobnum (they will not run until the specific job completes).
242 This can be used to defer provisioning until some action completes (such
243 as running the customer's credit card successfully).
244
245 The I<noexport> option is deprecated but still works for now (use
246 I<depend_jobnum> instead for new code).  If I<noexport> is set true, no
247 provisioning jobs (exports) are scheduled.  (You can schedule them later with
248 the B<reexport> method for each cust_pkg object.  Using the B<reexport> method
249 on the cust_main object is not recommended, as existing services will also be
250 reexported.)
251
252 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
253 provided, the scalars (provided by references) will be incremented by the
254 values of the prepaid card.`
255
256 =cut
257
258 sub order_pkgs {
259   my $self = shift;
260   my $cust_pkgs = shift;
261   my %options = @_;
262
263   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
264
265   warn "$me order_pkgs called with options ".
266        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
267     if $DEBUG;
268
269   local $SIG{HUP} = 'IGNORE';
270   local $SIG{INT} = 'IGNORE';
271   local $SIG{QUIT} = 'IGNORE';
272   local $SIG{TERM} = 'IGNORE';
273   local $SIG{TSTP} = 'IGNORE';
274   local $SIG{PIPE} = 'IGNORE';
275
276   my $oldAutoCommit = $FS::UID::AutoCommit;
277   local $FS::UID::AutoCommit = 0;
278   my $dbh = dbh;
279
280   local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
281
282   foreach my $cust_pkg ( keys %$cust_pkgs ) {
283
284     my $error = $self->order_pkg(
285       'cust_pkg'     => $cust_pkg,
286       'svcs'         => $cust_pkgs->{$cust_pkg},
287       map { $_ => $options{$_} }
288         qw( seconds_ref upbytes_ref downbytes_ref totalbytes_ref depend_jobnum )
289     );
290     if ( $error ) {
291       $dbh->rollback if $oldAutoCommit;
292       return $error;
293     }
294
295   }
296
297   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
298   ''; #no error
299 }
300
301 =item attach_pkgs 
302
303 Merges this customer's package's into the target customer and then cancels them.
304
305 =cut
306
307 sub attach_pkgs {
308   my( $self, $new_custnum ) = @_;
309
310   #mostly false laziness w/ merge
311
312   return "Can't attach packages to self" if $self->custnum == $new_custnum;
313
314   my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
315     or return "Invalid new customer number: $new_custnum";
316
317   return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent'
318     if $self->agentnum != $new_cust_main->agentnum 
319     && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents');
320
321   local $SIG{HUP} = 'IGNORE';
322   local $SIG{INT} = 'IGNORE';
323   local $SIG{QUIT} = 'IGNORE';
324   local $SIG{TERM} = 'IGNORE';
325   local $SIG{TSTP} = 'IGNORE';
326   local $SIG{PIPE} = 'IGNORE';
327
328   my $oldAutoCommit = $FS::UID::AutoCommit;
329   local $FS::UID::AutoCommit = 0;
330   my $dbh = dbh;
331
332   if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
333      $dbh->rollback if $oldAutoCommit;
334      return "Can't merge a master agent customer";
335   }
336
337   #use FS::access_user
338   if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
339      $dbh->rollback if $oldAutoCommit;
340      return "Can't merge a master employee customer";
341   }
342
343   if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
344                                      'status'  => { op=>'!=', value=>'done' },
345                                    }
346               )
347   ) {
348      $dbh->rollback if $oldAutoCommit;
349      return "Can't merge a customer with pending payments";
350   }
351
352   #end of false laziness
353
354   #pull in contact
355
356   my %contact_hash = ( 'first'    => $self->first,
357                        'last'     => $self->get('last'),
358                        'custnum'  => $new_custnum,
359                        'disabled' => '',
360                      );
361
362   my $contact = qsearchs(  'contact', \%contact_hash)
363                  || new FS::contact   \%contact_hash;
364   unless ( $contact->contactnum ) {
365     my $error = $contact->insert;
366     if ( $error ) {
367       $dbh->rollback if $oldAutoCommit;
368       return $error;
369     }
370   }
371
372   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
373
374     my $cust_location = $cust_pkg->cust_location || $self->ship_location;
375     my %loc_hash = $cust_location->hash;
376     $loc_hash{'locationnum'} = '';
377     $loc_hash{'custnum'}     = $new_custnum;
378     $loc_hash{'disabled'}    = '';
379     my $new_cust_location = qsearchs(  'cust_location', \%loc_hash)
380                              || new FS::cust_location   \%loc_hash;
381
382     my $pkg_or_error = $cust_pkg->change( {
383       'keep_dates'    => 1,
384       'cust_main'     => $new_cust_main,
385       'contactnum'    => $contact->contactnum,
386       'cust_location' => $new_cust_location,
387     } );
388
389     my $error = ref($pkg_or_error) ? '' : $pkg_or_error;
390
391     if ( $error ) {
392       $dbh->rollback if $oldAutoCommit;
393       return $error;
394     }
395
396   }
397
398   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
399   ''; #no error
400
401 }
402
403 =item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
404
405 Returns all packages (see L<FS::cust_pkg>) for this customer.
406
407 =cut
408
409 sub all_pkgs {
410   my $self = shift;
411   my $extra_qsearch = ref($_[0]) ? shift : { @_ };
412
413   return $self->num_pkgs unless wantarray || keys %$extra_qsearch;
414
415   my @cust_pkg = ();
416   if ( $self->{'_pkgnum'} && ! keys %$extra_qsearch ) {
417     @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
418   } else {
419     @cust_pkg = $self->_cust_pkg($extra_qsearch);
420   }
421
422   map { $_ } sort sort_packages @cust_pkg;
423 }
424
425 =item cust_pkg
426
427 Synonym for B<all_pkgs>.
428
429 =cut
430
431 sub cust_pkg {
432   shift->all_pkgs(@_);
433 }
434
435 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
436
437 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
438
439 =cut
440
441 sub ncancelled_pkgs {
442   my $self = shift;
443   my $extra_qsearch = ref($_[0]) ? shift : {};
444
445   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
446
447   return $self->num_ncancelled_pkgs unless wantarray;
448
449   my @cust_pkg = ();
450   if ( $self->{'_pkgnum'} ) {
451
452     warn "$me ncancelled_pkgs: returning cached objects"
453       if $DEBUG > 1;
454
455     @cust_pkg = grep { ! $_->getfield('cancel') }
456                 values %{ $self->{'_pkgnum'}->cache };
457
458   } else {
459
460     warn "$me ncancelled_pkgs: searching for packages with custnum ".
461          $self->custnum. "\n"
462       if $DEBUG > 1;
463
464     $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
465
466     @cust_pkg = $self->_cust_pkg($extra_qsearch);
467
468   }
469
470   sort sort_packages @cust_pkg;
471
472 }
473
474 sub _cust_pkg {
475   my $self = shift;
476   my $extra_qsearch = ref($_[0]) ? shift : {};
477
478   $extra_qsearch->{'select'} ||= '*';
479   $extra_qsearch->{'select'} .=
480    ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
481      AS _num_cust_svc';
482
483   map {
484         $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
485         $_;
486       }
487   qsearch({
488     %$extra_qsearch,
489     'table'   => 'cust_pkg',
490     'hashref' => { 'custnum' => $self->custnum },
491   });
492
493 }
494
495 # This should be generalized to use config options to determine order.
496 sub sort_packages {
497   
498   my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
499   return $locationsort if $locationsort;
500
501   if ( $a->get('cancel') xor $b->get('cancel') ) {
502     return -1 if $b->get('cancel');
503     return  1 if $a->get('cancel');
504     #shouldn't get here...
505     return 0;
506   } else {
507     my $a_num_cust_svc = $a->num_cust_svc;
508     my $b_num_cust_svc = $b->num_cust_svc;
509     return 0  if !$a_num_cust_svc && !$b_num_cust_svc;
510     return -1 if  $a_num_cust_svc && !$b_num_cust_svc;
511     return 1  if !$a_num_cust_svc &&  $b_num_cust_svc;
512     return 0 if $a_num_cust_svc + $b_num_cust_svc > 20; #for perf, just give up
513     my @a_cust_svc = $a->cust_svc_unsorted;
514     my @b_cust_svc = $b->cust_svc_unsorted;
515     return 0  if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
516     return -1 if  scalar(@a_cust_svc) && !scalar(@b_cust_svc);
517     return 1  if !scalar(@a_cust_svc) &&  scalar(@b_cust_svc);
518     $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
519   }
520
521 }
522
523 =item suspended_pkgs
524
525 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
526
527 =cut
528
529 sub suspended_pkgs {
530   my $self = shift;
531   return $self->num_suspended_pkgs unless wantarray;
532   grep { $_->susp } $self->ncancelled_pkgs;
533 }
534
535 =item unflagged_suspended_pkgs
536
537 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
538 customer (thouse packages without the `manual_flag' set).
539
540 =cut
541
542 sub unflagged_suspended_pkgs {
543   my $self = shift;
544   return $self->suspended_pkgs
545     unless dbdef->table('cust_pkg')->column('manual_flag');
546   grep { ! $_->manual_flag } $self->suspended_pkgs;
547 }
548
549 =item unsuspended_pkgs
550
551 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
552 this customer.
553
554 =cut
555
556 sub unsuspended_pkgs {
557   my $self = shift;
558   return $self->num_unsuspended_pkgs unless wantarray;
559   grep { ! $_->susp } $self->ncancelled_pkgs;
560 }
561
562 =item active_pkgs
563
564 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
565 this customer that are active (recurring).
566
567 =cut
568
569 sub active_pkgs {
570   my $self = shift; 
571   grep { my $part_pkg = $_->part_pkg;
572          $part_pkg->freq ne '' && $part_pkg->freq ne '0';
573        }
574        $self->unsuspended_pkgs;
575 }
576
577 =item billing_pkgs
578
579 Returns active packages, and also any suspended packages which are set to
580 continue billing while suspended.
581
582 =cut
583
584 sub billing_pkgs {
585   my $self = shift;
586   grep { my $part_pkg = $_->part_pkg;
587          $part_pkg->freq ne '' && $part_pkg->freq ne '0'
588            && ( ! $_->susp || $_->option('suspend_bill',1)
589                            || ( $part_pkg->option('suspend_bill', 1)
590                                   && ! $_->option('no_suspend_bill',1)
591                               )
592               );
593        }
594        $self->ncancelled_pkgs;
595 }
596
597 =item next_bill_date
598
599 Returns the next date this customer will be billed, as a UNIX timestamp, or
600 undef if no billing package has a next bill date.
601
602 =cut
603
604 sub next_bill_date {
605   my $self = shift;
606   min( map $_->get('bill'), grep $_->get('bill'), $self->billing_pkgs );
607 }
608
609 =item num_cancelled_pkgs
610
611 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
612 customer.
613
614 =cut
615
616 sub num_cancelled_pkgs {
617   shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
618 }
619
620 sub num_ncancelled_pkgs {
621   shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
622 }
623
624 sub num_suspended_pkgs {
625   shift->num_pkgs("     ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
626                     AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0   ");
627 }
628
629 sub num_unsuspended_pkgs {
630   shift->num_pkgs("     ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
631                     AND ( cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0 ) ");
632 }
633
634 sub num_pkgs {
635   my( $self ) = shift;
636   my $sql = scalar(@_) ? shift : '';
637   $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
638   my $sth = dbh->prepare(
639     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
640   ) or die dbh->errstr;
641   $sth->execute($self->custnum) or die $sth->errstr;
642   $sth->fetchrow_arrayref->[0];
643 }
644
645 =back
646
647 =head1 BUGS
648
649 =head1 SEE ALSO
650
651 L<FS::cust_main>, L<FS::cust_pkg>
652
653 =cut
654
655 1;
656