+ if ( $old->get('susp') || $self->get('susp') ) {
+ dbh->rollback if $oldAutoCommit;
+ return ""; # no error # complain on adjourn?
+ }
+
+ my $date = $options{date} if $options{date}; # adjourn/suspend later
+ $date = '' if ($date && $date <= time); # complain instead?
+
+ if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
+ dbh->rollback if $oldAutoCommit;
+ return "Package $pkgnum expires before it would be suspended.";
+ }
+
+ my $suspend_time = $options{'time'} || time;
+
+ if ( $options{'reason'} ) {
+ $error = $self->insert_reason( 'reason' => $options{'reason'},
+ 'action' => $date ? 'adjourn' : 'suspend',
+ 'date' => $date ? $date : $suspend_time,
+ 'reason_otaker' => $options{'reason_otaker'},
+ );
+ if ( $error ) {
+ dbh->rollback if $oldAutoCommit;
+ return "Error inserting cust_pkg_reason: $error";
+ }
+ }
+
+ unless ( $date ) {
+
+ my @labels = ();
+
+ foreach my $cust_svc (
+ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
+ ) {
+ my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
+
+ $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "Illegal svcdb value in part_svc!";
+ };
+ my $svcdb = $1;
+ require "FS/$svcdb.pm";
+
+ my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
+ if ($svc) {
+ $error = $svc->suspend;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ my( $label, $value ) = $cust_svc->label;
+ push @labels, "$label: $value";
+ }
+ }
+
+ my $conf = new FS::Conf;
+ if ( $conf->config('suspend_email_admin') ) {
+
+ my $error = send_email(
+ 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
+ #invoice_from ??? well as good as any
+ 'to' => $conf->config('suspend_email_admin'),
+ 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
+ 'body' => [
+ "This is an automatic message from your Freeside installation\n",
+ "informing you that the following customer package has been suspended:\n",
+ "\n",
+ 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
+ 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
+ ( map { "Service : $_\n" } @labels ),
+ ],
+ );
+
+ if ( $error ) {
+ warn "WARNING: can't send suspension admin email (suspending anyway): ".
+ "$error\n";
+ }
+
+ }
+
+ }
+
+ my %hash = $self->hash;
+ if ( $date ) {
+ $hash{'adjourn'} = $date;
+ } else {
+ $hash{'susp'} = $suspend_time;
+ }
+ my $new = new FS::cust_pkg ( \%hash );
+ $error = $new->replace( $self, options => { $self->options } );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ ''; #no errors
+}
+
+=item unsuspend [ OPTION => VALUE ... ]
+
+Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
+package, then unsuspends the package itself (clears the susp field and the
+adjourn field if it is in the past).
+
+Available options are:
+
+=over 4
+
+=item adjust_next_bill
+
+Can be set true to adjust the next bill date forward by
+the amount of time the account was inactive. This was set true by default
+since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
+explicitly requested. Price plans for which this makes sense (anniversary-date
+based than prorate or subscription) could have an option to enable this
+behaviour?
+
+=back
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub unsuspend {
+ my( $self, %opt ) = @_;
+ my $error;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $old = $self->select_for_update;
+
+ my $pkgnum = $old->pkgnum;
+ if ( $old->get('cancel') || $self->get('cancel') ) {
+ dbh->rollback if $oldAutoCommit;
+ return "Can't unsuspend cancelled package $pkgnum";
+ }
+
+ unless ( $old->get('susp') && $self->get('susp') ) {
+ dbh->rollback if $oldAutoCommit;
+ return ""; # no error # complain instead?
+ }
+
+ foreach my $cust_svc (
+ qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
+ ) {
+ my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
+
+ $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
+ $dbh->rollback if $oldAutoCommit;
+ return "Illegal svcdb value in part_svc!";
+ };
+ my $svcdb = $1;
+ require "FS/$svcdb.pm";
+
+ my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
+ if ($svc) {
+ $error = $svc->unsuspend;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ }
+
+ my %hash = $self->hash;
+ my $inactive = time - $hash{'susp'};
+
+ my $conf = new FS::Conf;
+
+ $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
+ if ( $opt{'adjust_next_bill'}
+ || $conf->exists('unsuspend-always_adjust_next_bill_date') )
+ && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
+
+ $hash{'susp'} = '';
+ $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
+ my $new = new FS::cust_pkg ( \%hash );
+ $error = $new->replace( $self, options => { $self->options } );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ ''; #no errors
+}
+
+=item unadjourn
+
+Cancels any pending suspension (sets the adjourn field to null).
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub unadjourn {
+ my( $self, %options ) = @_;
+ my $error;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $old = $self->select_for_update;
+
+ my $pkgnum = $old->pkgnum;
+ if ( $old->get('cancel') || $self->get('cancel') ) {
+ dbh->rollback if $oldAutoCommit;
+ return "Can't unadjourn cancelled package $pkgnum";
+ # or at least it's pointless
+ }
+
+ if ( $old->get('susp') || $self->get('susp') ) {
+ dbh->rollback if $oldAutoCommit;
+ return "Can't unadjourn suspended package $pkgnum";
+ # perhaps this is arbitrary
+ }
+
+ unless ( $old->get('adjourn') && $self->get('adjourn') ) {
+ dbh->rollback if $oldAutoCommit;
+ return ""; # no error
+ }
+
+ my %hash = $self->hash;
+ $hash{'adjourn'} = '';
+ my $new = new FS::cust_pkg ( \%hash );
+ $error = $new->replace( $self, options => { $self->options } );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ ''; #no errors
+
+}
+
+
+=item change HASHREF | OPTION => VALUE ...
+
+Changes this package: cancels it and creates a new one, with a different
+pkgpart or locationnum or both. All services are transferred to the new
+package (no change will be made if this is not possible).
+
+Options may be passed as a list of key/value pairs or as a hash reference.
+Options are:
+
+=over 4
+
+=item locaitonnum
+
+New locationnum, to change the location for this package.
+
+=item cust_location
+
+New FS::cust_location object, to create a new location and assign it
+to this package.
+
+=item pkgpart
+
+New pkgpart (see L<FS::part_pkg>).
+
+=item refnum
+
+New refnum (see L<FS::part_referral>).
+
+=back
+
+At least one option must be specified (otherwise, what's the point?)
+
+Returns either the new FS::cust_pkg object or a scalar error.
+
+For example:
+
+ my $err_or_new_cust_pkg = $old_cust_pkg->change
+
+=cut
+
+#some false laziness w/order
+sub change {
+ my $self = shift;
+ my $opt = ref($_[0]) ? shift : { @_ };
+
+# my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
+#
+
+ my $conf = new FS::Conf;
+
+ # Transactionize this whole mess
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error;
+
+ my %hash = ();
+
+ my $time = time;
+
+ #$hash{$_} = $self->$_() foreach qw( last_bill bill );
+
+ #$hash{$_} = $self->$_() foreach qw( setup );
+
+ $hash{'setup'} = $time if $self->setup;
+
+ $hash{'change_date'} = $time;
+ $hash{"change_$_"} = $self->$_()
+ foreach qw( pkgnum pkgpart locationnum );
+
+ if ( $opt->{'cust_location'} &&
+ ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
+ $error = $opt->{'cust_location'}->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "inserting cust_location (transaction rolled back): $error";
+ }
+ $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
+ }
+
+ # Create the new package.
+ my $cust_pkg = new FS::cust_pkg {
+ custnum => $self->custnum,
+ pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
+ refnum => ( $opt->{'refnum'} || $self->refnum ),
+ locationnum => ( $opt->{'locationnum'} || $self->locationnum ),
+ %hash,
+ };
+
+ $error = $cust_pkg->insert( 'change' => 1 );
+ if ($error) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ # Transfer services and cancel old package.
+
+ $error = $self->transfer($cust_pkg);
+ if ($error and $error == 0) {
+ # $old_pkg->transfer failed.
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
+ warn "trying transfer again with change_svcpart option\n" if $DEBUG;
+ $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
+ if ($error and $error == 0) {
+ # $old_pkg->transfer failed.
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ if ($error > 0) {
+ # Transfers were successful, but we still had services left on the old
+ # package. We can't change the package under this circumstances, so abort.
+ $dbh->rollback if $oldAutoCommit;
+ return "Unable to transfer all services from package ". $self->pkgnum;
+ }
+
+ #reset usage if changing pkgpart
+ if ($self->pkgpart != $cust_pkg->pkgpart) {
+ my $part_pkg = $cust_pkg->part_pkg;
+ $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
+ ? ()
+ : ( 'null' => 1 )
+ )
+ if $part_pkg->can('reset_usage');
+
+ if ($error) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error setting usage values: $error";
+ }
+ }
+
+ #Good to go, cancel old package.
+ $error = $self->cancel( quiet=>1 );
+ if ($error) {
+ $dbh->rollback;
+ return $error;
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ $cust_pkg;
+
+}
+
+=item last_bill
+
+Returns the last bill date, or if there is no last bill date, the setup date.
+Useful for billing metered services.
+
+=cut
+
+sub last_bill {
+ my $self = shift;
+ return $self->setfield('last_bill', $_[0]) if @_;
+ return $self->getfield('last_bill') if $self->getfield('last_bill');
+ my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
+ 'edate' => $self->bill, } );
+ $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
+}
+
+=item last_cust_pkg_reason ACTION
+
+Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
+Returns false if there is no reason or the package is not currenly ACTION'd
+ACTION is one of adjourn, susp, cancel, or expire.
+
+=cut
+
+sub last_cust_pkg_reason {
+ my ( $self, $action ) = ( shift, shift );
+ my $date = $self->get($action);
+ qsearchs( {
+ 'table' => 'cust_pkg_reason',
+ 'hashref' => { 'pkgnum' => $self->pkgnum,
+ 'action' => substr(uc($action), 0, 1),
+ 'date' => $date,
+ },
+ 'order_by' => 'ORDER BY num DESC LIMIT 1',
+ } );
+}
+
+=item last_reason ACTION
+
+Returns the most recent ACTION FS::reason associated with the package.
+Returns false if there is no reason or the package is not currenly ACTION'd
+ACTION is one of adjourn, susp, cancel, or expire.
+
+=cut
+
+sub last_reason {
+ my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
+ $cust_pkg_reason->reason
+ if $cust_pkg_reason;
+}
+
+=item part_pkg
+
+Returns the definition for this billing item, as an FS::part_pkg object (see
+L<FS::part_pkg>).
+
+=cut
+
+sub part_pkg {
+ my $self = shift;
+ return $self->{'_pkgpart'} if $self->{'_pkgpart'};
+ cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
+ qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
+}
+
+=item old_cust_pkg
+
+Returns the cancelled package this package was changed from, if any.
+
+=cut
+
+sub old_cust_pkg {
+ my $self = shift;
+ return '' unless $self->change_pkgnum;
+ qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
+}
+
+=item calc_setup
+
+Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
+item.
+
+=cut
+
+sub calc_setup {
+ my $self = shift;
+ $self->part_pkg->calc_setup($self, @_);
+}
+
+=item calc_recur
+
+Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
+item.
+
+=cut
+
+sub calc_recur {
+ my $self = shift;
+ $self->part_pkg->calc_recur($self, @_);
+}
+
+=item calc_remain
+
+Calls the I<calc_remain> of the FS::part_pkg object associated with this
+billing item.
+
+=cut
+
+sub calc_remain {
+ my $self = shift;
+ $self->part_pkg->calc_remain($self, @_);
+}
+
+=item calc_cancel
+
+Calls the I<calc_cancel> of the FS::part_pkg object associated with this
+billing item.
+
+=cut
+
+sub calc_cancel {
+ my $self = shift;
+ $self->part_pkg->calc_cancel($self, @_);
+}
+
+=item cust_bill_pkg
+
+Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
+
+=cut
+
+sub cust_bill_pkg {
+ my $self = shift;
+ qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
+}
+
+=item cust_pkg_detail [ DETAILTYPE ]
+
+Returns any customer package details for this package (see
+L<FS::cust_pkg_detail>).
+
+DETAILTYPE can be set to "I" for invoice details or "C" for comments.
+
+=cut
+
+sub cust_pkg_detail {
+ my $self = shift;
+ my %hash = ( 'pkgnum' => $self->pkgnum );
+ $hash{detailtype} = shift if @_;
+ qsearch({
+ 'table' => 'cust_pkg_detail',
+ 'hashref' => \%hash,
+ 'order_by' => 'ORDER BY weight, pkgdetailnum',
+ });
+}
+
+=item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
+
+Sets customer package details for this package (see L<FS::cust_pkg_detail>).
+
+DETAILTYPE can be set to "I" for invoice details or "C" for comments.
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub set_cust_pkg_detail {
+ my( $self, $detailtype, @details ) = @_;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
+ my $error = $current->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error removing old detail: $error";
+ }
+ }
+
+ foreach my $detail ( @details ) {
+ my $cust_pkg_detail = new FS::cust_pkg_detail {
+ 'pkgnum' => $self->pkgnum,
+ 'detailtype' => $detailtype,
+ 'detail' => $detail,
+ };
+ my $error = $cust_pkg_detail->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error adding new detail: $error";
+ }
+
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
+=item cust_event
+
+Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
+
+=cut
+
+#false laziness w/cust_bill.pm
+sub cust_event {
+ my $self = shift;
+ qsearch({
+ 'table' => 'cust_event',
+ 'addl_from' => 'JOIN part_event USING ( eventpart )',
+ 'hashref' => { 'tablenum' => $self->pkgnum },
+ 'extra_sql' => " AND eventtable = 'cust_pkg' ",
+ });
+}
+
+=item num_cust_event
+
+Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
+
+=cut
+
+#false laziness w/cust_bill.pm
+sub num_cust_event {
+ my $self = shift;
+ my $sql =
+ "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
+ " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
+ my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
+ $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
+ $sth->fetchrow_arrayref->[0];
+}
+
+=item cust_svc [ SVCPART ]
+
+Returns the services for this package, as FS::cust_svc objects (see
+L<FS::cust_svc>). If a svcpart is specified, return only the matching
+services.
+
+=cut
+
+sub cust_svc {
+ my $self = shift;
+
+ return () unless $self->num_cust_svc(@_);
+
+ if ( @_ ) {
+ return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
+ 'svcpart' => shift, } );
+ }
+
+ cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
+
+ #if ( $self->{'_svcnum'} ) {
+ # values %{ $self->{'_svcnum'}->cache };
+ #} else {
+ $self->_sort_cust_svc(
+ [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
+ );
+ #}
+
+}
+
+=item overlimit [ SVCPART ]
+
+Returns the services for this package which have exceeded their
+usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
+is specified, return only the matching services.
+
+=cut
+
+sub overlimit {
+ my $self = shift;
+ return () unless $self->num_cust_svc(@_);
+ grep { $_->overlimit } $self->cust_svc(@_);
+}
+
+=item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
+
+Returns historical services for this package created before END TIMESTAMP and
+(optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
+(see L<FS::h_cust_svc>).
+
+=cut
+
+sub h_cust_svc {
+ my $self = shift;
+
+ $self->_sort_cust_svc(
+ [ qsearch( 'h_cust_svc',
+ { 'pkgnum' => $self->pkgnum, },
+ FS::h_cust_svc->sql_h_search(@_),
+ )
+ ]
+ );
+}
+
+sub _sort_cust_svc {
+ my( $self, $arrayref ) = @_;
+
+ map { $_->[0] }
+ sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
+ map {
+ my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
+ 'svcpart' => $_->svcpart } );
+ [ $_,
+ $pkg_svc ? $pkg_svc->primary_svc : '',
+ $pkg_svc ? $pkg_svc->quantity : 0,
+ ];
+ }
+ @$arrayref;
+
+}
+
+=item num_cust_svc [ SVCPART ]
+
+Returns the number of provisioned services for this package. If a svcpart is
+specified, counts only the matching services.
+
+=cut
+
+sub num_cust_svc {
+ my $self = shift;
+
+ return $self->{'_num_cust_svc'}
+ if !scalar(@_)
+ && exists($self->{'_num_cust_svc'})
+ && $self->{'_num_cust_svc'} =~ /\d/;
+
+ cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
+ if $DEBUG > 2;
+
+ my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
+ $sql .= ' AND svcpart = ?' if @_;
+
+ my $sth = dbh->prepare($sql) or die dbh->errstr;
+ $sth->execute($self->pkgnum, @_) or die $sth->errstr;
+ $sth->fetchrow_arrayref->[0];
+}
+
+=item available_part_svc
+
+Returns a list of FS::part_svc objects representing services included in this
+package but not yet provisioned. Each FS::part_svc object also has an extra
+field, I<num_avail>, which specifies the number of available services.
+
+=cut
+
+sub available_part_svc {
+ my $self = shift;
+ grep { $_->num_avail > 0 }
+ map {
+ my $part_svc = $_->part_svc;
+ $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
+ $_->quantity - $self->num_cust_svc($_->svcpart);
+ $part_svc;
+ }
+ $self->part_pkg->pkg_svc;
+}
+
+=item part_svc
+
+Returns a list of FS::part_svc objects representing provisioned and available
+services included in this package. Each FS::part_svc object also has the
+following extra fields:
+
+=over 4
+
+=item num_cust_svc (count)
+
+=item num_avail (quantity - count)
+
+=item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
+
+svcnum
+label -> ($cust_svc->label)[1]
+
+=back
+
+=cut
+
+sub part_svc {
+ my $self = shift;
+
+ #XXX some sort of sort order besides numeric by svcpart...
+ my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
+ my $pkg_svc = $_;
+ my $part_svc = $pkg_svc->part_svc;
+ my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
+ $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
+ $part_svc->{'Hash'}{'num_avail'} =
+ max( 0, $pkg_svc->quantity - $num_cust_svc );
+ $part_svc->{'Hash'}{'cust_pkg_svc'} =
+ $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
+ $part_svc;
+ } $self->part_pkg->pkg_svc;
+
+ #extras
+ push @part_svc, map {
+ my $part_svc = $_;
+ my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
+ $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
+ $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
+ $part_svc->{'Hash'}{'cust_pkg_svc'} =
+ $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
+ $part_svc;
+ } $self->extra_part_svc;
+
+ @part_svc;
+
+}
+
+=item extra_part_svc
+
+Returns a list of FS::part_svc objects corresponding to services in this
+package which are still provisioned but not (any longer) available in the
+package definition.
+
+=cut
+
+sub extra_part_svc {
+ my $self = shift;
+
+ my $pkgnum = $self->pkgnum;
+ my $pkgpart = $self->pkgpart;
+
+# qsearch( {
+# 'table' => 'part_svc',
+# 'hashref' => {},
+# 'extra_sql' =>
+# "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
+# WHERE pkg_svc.svcpart = part_svc.svcpart
+# AND pkg_svc.pkgpart = ?
+# AND quantity > 0
+# )
+# AND 0 < ( SELECT COUNT(*) FROM cust_svc
+# LEFT JOIN cust_pkg USING ( pkgnum )
+# WHERE cust_svc.svcpart = part_svc.svcpart
+# AND pkgnum = ?
+# )",
+# 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
+# } );
+
+#seems to benchmark slightly faster...
+ qsearch( {
+ 'select' => 'DISTINCT ON (svcpart) part_svc.*',
+ 'table' => 'part_svc',
+ 'addl_from' =>
+ 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
+ AND pkg_svc.pkgpart = ?
+ AND quantity > 0
+ )
+ LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
+ LEFT JOIN cust_pkg USING ( pkgnum )
+ ',
+ 'hashref' => {},
+ 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
+ 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
+ } );
+}
+
+=item status
+
+Returns a short status string for this package, currently:
+
+=over 4
+
+=item not yet billed
+
+=item one-time charge
+
+=item active
+
+=item suspended
+
+=item cancelled
+
+=back
+
+=cut
+
+sub status {
+ my $self = shift;
+
+ my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
+
+ return 'cancelled' if $self->get('cancel');
+ return 'suspended' if $self->susp;
+ return 'not yet billed' unless $self->setup;
+ return 'one-time charge' if $freq =~ /^(0|$)/;
+ return 'active';
+}
+
+=item statuses
+
+Class method that returns the list of possible status strings for packages
+(see L<the status method|/status>). For example:
+
+ @statuses = FS::cust_pkg->statuses();
+
+=cut
+
+tie my %statuscolor, 'Tie::IxHash',
+ 'not yet billed' => '000000',
+ 'one-time charge' => '000000',
+ 'active' => '00CC00',
+ 'suspended' => 'FF9900',
+ 'cancelled' => 'FF0000',
+;
+
+sub statuses {
+ my $self = shift; #could be class...
+ #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
+ # # mayble split btw one-time vs. recur
+ keys %statuscolor;
+}
+
+=item statuscolor
+
+Returns a hex triplet color string for this package's status.
+
+=cut
+
+sub statuscolor {
+ my $self = shift;
+ $statuscolor{$self->status};
+}
+
+=item labels
+
+Returns a list of lists, calling the label method for all services
+(see L<FS::cust_svc>) of this billing item.
+
+=cut
+
+sub labels {
+ my $self = shift;
+ map { [ $_->label ] } $self->cust_svc;
+}
+
+=item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
+
+Like the labels method, but returns historical information on services that
+were active as of END_TIMESTAMP and (optionally) not cancelled before
+START_TIMESTAMP.
+
+Returns a list of lists, calling the label method for all (historical) services
+(see L<FS::h_cust_svc>) of this billing item.
+
+=cut
+
+sub h_labels {
+ my $self = shift;
+ map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
+}
+
+=item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
+
+Like h_labels, except returns a simple flat list, and shortens long
+(currently >5 or the cust_bill-max_same_services configuration value) lists of
+identical services to one line that lists the service label and the number of
+individual services rather than individual items.
+
+=cut
+
+sub h_labels_short {
+ my $self = shift;
+
+ my $conf = new FS::Conf;
+ my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
+
+ my %labels;
+ #tie %labels, 'Tie::IxHash';
+ push @{ $labels{$_->[0]} }, $_->[1]
+ foreach $self->h_labels(@_);
+ my @labels;
+ foreach my $label ( keys %labels ) {
+ my %seen = ();
+ my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
+ my $num = scalar(@values);
+ if ( $num > $max_same_services ) {
+ push @labels, "$label ($num)";
+ } else {
+ push @labels, map { "$label: $_" } @values;
+ }
+ }
+
+ @labels;
+
+}
+
+=item cust_main
+
+Returns the parent customer object (see L<FS::cust_main>).
+
+=cut
+
+sub cust_main {
+ my $self = shift;
+ qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
+}
+
+=item cust_location
+
+Returns the location object, if any (see L<FS::cust_location>).
+
+=cut
+
+sub cust_location {
+ my $self = shift;
+ return '' unless $self->locationnum;
+ qsearchs( 'cust_location', { 'locationnum' => $self->locationnum } );
+}
+
+=item cust_location_or_main
+
+If this package is associated with a location, returns the locaiton (see
+L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
+
+=cut
+
+sub cust_location_or_main {
+ my $self = shift;
+ $self->cust_location || $self->cust_main;
+}
+
+=item seconds_since TIMESTAMP
+
+Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
+package have been online since TIMESTAMP, according to the session monitor.
+
+TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=cut
+
+sub seconds_since {
+ my($self, $since) = @_;
+ my $seconds = 0;
+
+ foreach my $cust_svc (
+ grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
+ ) {
+ $seconds += $cust_svc->seconds_since($since);
+ }
+
+ $seconds;
+
+}
+
+=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
+
+Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
+package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
+(exclusive).
+
+TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
+L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
+functions.
+
+
+=cut
+
+sub seconds_since_sqlradacct {
+ my($self, $start, $end) = @_;
+
+ my $seconds = 0;
+
+ foreach my $cust_svc (
+ grep {
+ my $part_svc = $_->part_svc;
+ $part_svc->svcdb eq 'svc_acct'
+ && scalar($part_svc->part_export('sqlradius'));
+ } $self->cust_svc
+ ) {
+ $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
+ }
+
+ $seconds;
+
+}
+
+=item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
+
+Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
+in this package for sessions ending between TIMESTAMP_START (inclusive) and
+TIMESTAMP_END
+(exclusive).
+
+TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
+L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
+functions.
+
+=cut
+
+sub attribute_since_sqlradacct {
+ my($self, $start, $end, $attrib) = @_;
+
+ my $sum = 0;
+
+ foreach my $cust_svc (
+ grep {
+ my $part_svc = $_->part_svc;
+ $part_svc->svcdb eq 'svc_acct'
+ && scalar($part_svc->part_export('sqlradius'));
+ } $self->cust_svc
+ ) {
+ $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
+ }
+
+ $sum;
+
+}
+
+=item quantity
+
+=cut
+
+sub quantity {
+ my( $self, $value ) = @_;
+ if ( defined($value) ) {
+ $self->setfield('quantity', $value);
+ }
+ $self->getfield('quantity') || 1;
+}
+
+=item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
+
+Transfers as many services as possible from this package to another package.
+
+The destination package can be specified by pkgnum by passing an FS::cust_pkg
+object. The destination package must already exist.
+
+Services are moved only if the destination allows services with the correct
+I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
+this option with caution! No provision is made for export differences
+between the old and new service definitions. Probably only should be used
+when your exports for all service definitions of a given svcdb are identical.
+(attempt a transfer without it first, to move all possible svcpart-matching
+services)
+
+Any services that can't be moved remain in the original package.
+
+Returns an error, if there is one; otherwise, returns the number of services
+that couldn't be moved.
+
+=cut
+
+sub transfer {
+ my ($self, $dest_pkgnum, %opt) = @_;
+
+ my $remaining = 0;
+ my $dest;
+ my %target;
+
+ if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
+ $dest = $dest_pkgnum;
+ $dest_pkgnum = $dest->pkgnum;
+ } else {
+ $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
+ }
+
+ return ('Package does not exist: '.$dest_pkgnum) unless $dest;
+
+ foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
+ $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
+ }
+
+ foreach my $cust_svc ($dest->cust_svc) {
+ $target{$cust_svc->svcpart}--;
+ }
+
+ my %svcpart2svcparts = ();
+ if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
+ warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
+ foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
+ next if exists $svcpart2svcparts{$svcpart};
+ my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
+ $svcpart2svcparts{$svcpart} = [
+ map { $_->[0] }
+ sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
+ map {
+ my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
+ 'svcpart' => $_ } );
+ [ $_,
+ $pkg_svc ? $pkg_svc->primary_svc : '',
+ $pkg_svc ? $pkg_svc->quantity : 0,
+ ];
+ }
+
+ grep { $_ != $svcpart }
+ map { $_->svcpart }
+ qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
+ ];
+ warn "alternates for svcpart $svcpart: ".
+ join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
+ if $DEBUG;
+ }
+ }
+
+ foreach my $cust_svc ($self->cust_svc) {
+ if($target{$cust_svc->svcpart} > 0) {
+ $target{$cust_svc->svcpart}--;
+ my $new = new FS::cust_svc { $cust_svc->hash };
+ $new->pkgnum($dest_pkgnum);
+ my $error = $new->replace($cust_svc);
+ return $error if $error;
+ } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
+ if ( $DEBUG ) {
+ warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
+ warn "alternates to consider: ".
+ join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
+ }
+ my @alternate = grep {
+ warn "considering alternate svcpart $_: ".
+ "$target{$_} available in new package\n"
+ if $DEBUG;
+ $target{$_} > 0;
+ } @{$svcpart2svcparts{$cust_svc->svcpart}};
+ if ( @alternate ) {
+ warn "alternate(s) found\n" if $DEBUG;
+ my $change_svcpart = $alternate[0];
+ $target{$change_svcpart}--;
+ my $new = new FS::cust_svc { $cust_svc->hash };
+ $new->svcpart($change_svcpart);
+ $new->pkgnum($dest_pkgnum);
+ my $error = $new->replace($cust_svc);
+ return $error if $error;
+ } else {
+ $remaining++;
+ }
+ } else {
+ $remaining++
+ }
+ }
+ return $remaining;
+}
+
+=item reexport
+
+This method is deprecated. See the I<depend_jobnum> option to the insert and
+order_pkgs methods in FS::cust_main for a better way to defer provisioning.
+
+=cut
+
+sub reexport {
+ my $self = shift;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ foreach my $cust_svc ( $self->cust_svc ) {
+ #false laziness w/svc_Common::insert
+ my $svc_x = $cust_svc->svc_x;
+ foreach my $part_export ( $cust_svc->part_svc->part_export ) {
+ my $error = $part_export->export_insert($svc_x);