our $upgrade = 0; #go away after setup+start dates cleaned up for old customers
+our $cache_enabled = 0;
+
sub _simplecache {
my( $self, $hashref ) = @_;
- if ( $hashref->{'pkg'} ) {
+ if ( $cache_enabled && $hashref->{'pkg'} && $hashref->{'plan'} ) {
$self->{'_pkgpart'} = FS::part_pkg->new($hashref);
}
}
order taker (see L<FS::access_user>)
-=item manual_flag
-
-If this field is set to 1, disables the automatic
-unsuspension of this package when using the B<unsuspendauto> config option.
-
=item quantity
If not set, defaults to 1
my $conf = new FS::Conf;
+ if ($self->locationnum) {
+ my @part_export =
+ map qsearch( 'part_export', {exportnum=>$_} ),
+ $conf->config('cust_location-exports'); #, $agentnum
+
+ foreach my $part_export ( @part_export ) {
+ my $error = $part_export->export_pkg_location($self); #, @$export_args);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "exporting to ". $part_export->exporttype.
+ " (transaction rolled back): $error";
+ }
+ }
+ }
+
if ( ! $import && $conf->config('ticket_system') && $options{ticket_subject} ) {
#this init stuff is still inefficient, but at least its limited to
}
}
+ # also run exports if removing locationnum?
+ # doesn't seem to happen, and we don't export blank locationnum on insert...
+ if ($new->locationnum and ($new->locationnum != $old->locationnum)) {
+ my $conf = new FS::Conf;
+ my @part_export =
+ map qsearch( 'part_export', {exportnum=>$_} ),
+ $conf->config('cust_location-exports'); #, $agentnum
+
+ foreach my $part_export ( @part_export ) {
+ my $error = $part_export->export_pkg_location($new); #, @$export_args);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "exporting to ". $part_export->exporttype.
+ " (transaction rolled back): $error";
+ }
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
$self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
- if ( $self->dbdef_table->column('manual_flag') ) {
- $self->manual_flag('') if $self->manual_flag eq ' ';
- $self->manual_flag =~ /^([01]?)$/
- or return "Illegal manual_flag ". $self->manual_flag;
- $self->manual_flag($1);
- }
-
$self->SUPER::check;
}
}
}
+ # if a reasonnum was passed, get the actual reason object so we can check
+ # unused_credit
+
+ my $reason;
+ if ($options{'reason'} =~ /^\d+$/) {
+ $reason = FS::reason->by_key($options{'reason'});
+ }
+
unless ($date) {
- # credit remaining time if appropriate
+ # credit remaining time if any of these are true:
+ # - unused_credit => 1 was passed (this happens when canceling a package
+ # for a package change when unused_credit_change is set)
+ # - no unused_credit option, and there is a cancel reason, and the cancel
+ # reason says to credit the package
+ # - no unused_credit option, and the package definition says to credit the
+ # package on cancellation
my $do_credit;
if ( exists($options{'unused_credit'}) ) {
$do_credit = $options{'unused_credit'};
- }
- else {
+ } elsif ( defined($reason) && $reason->unused_credit ) {
+ $do_credit = 1;
+ } else {
$do_credit = $self->part_pkg->option('unused_credit_cancel', 1);
}
if ( $do_credit ) {
'';
}
+=item uncancel_svc_x
+
+For cancelled cust_pkg, returns a list of new, uninserted FS::svc_X records
+for services that would be inserted by L</uncancel>. Returned objects also
+include the field _h_svc_x, which contains the service history object.
+
+Set pkgnum before inserting.
+
+Accepts the following options:
+
+only_svcnum - arrayref of svcnum, only returns objects for these svcnum
+(and only if they would otherwise be returned by this)
+
+=cut
+
+sub uncancel_svc_x {
+ my ($self, %opt) = @_;
+
+ die 'uncancel_svc_x called on a non-cancelled cust_pkg' unless $self->get('cancel');
+
+ #find historical services within this timeframe before the package cancel
+ # (incompatible with "time" option to cust_pkg->cancel?)
+ my $fuzz = 2 * 60; #2 minutes? too much? (might catch separate unprovision)
+ # too little? (unprovisioing export delay?)
+ my($end, $start) = ( $self->get('cancel'), $self->get('cancel') - $fuzz );
+ my @h_cust_svc = $self->h_cust_svc( $end, $start );
+
+ my @svc_x;
+ foreach my $h_cust_svc (@h_cust_svc) {
+ next if $opt{'only_svcnum'} && !(grep { $_ == $h_cust_svc->svcnum } @{$opt{'only_svcnum'}});
+ # filter out services that still exist on this package (ie preserved svcs)
+ # but keep services that have since been provisioned on another package (for informational purposes)
+ next if qsearchs('cust_svc',{ 'svcnum' => $h_cust_svc->svcnum, 'pkgnum' => $self->pkgnum });
+ my $h_svc_x = $h_cust_svc->h_svc_x( $end, $start );
+ next unless $h_svc_x; # this probably doesn't happen, but just in case
+ (my $table = $h_svc_x->table) =~ s/^h_//;
+ require "FS/$table.pm";
+ my $class = "FS::$table";
+ my $svc_x = $class->new( {
+ 'svcpart' => $h_cust_svc->svcpart,
+ '_h_svc_x' => $h_svc_x,
+ map { $_ => $h_svc_x->get($_) } fields($table)
+ } );
+
+ # radius_usergroup
+ if ( $h_svc_x->isa('FS::h_svc_Radius_Mixin') ) {
+ $svc_x->usergroup( [ $h_svc_x->h_usergroup($end, $start) ] );
+ }
+
+ #these are pretty rare, but should handle them
+ # - dsl_device (mac addresses)
+ # - phone_device (mac addresses)
+ # - dsl_note (ikano notes)
+ # - domain_record (i.e. restore DNS information w/domains)
+ # - inventory_item(?) (inventory w/un-cancelling service?)
+ # - nas (svc_broaband nas stuff)
+ #this stuff is unused in the wild afaik
+ # - mailinglistmember
+ # - router.svcnum?
+ # - svc_domain.parent_svcnum?
+ # - acct_snarf (ancient mail fetching config)
+ # - cgp_rule (communigate)
+ # - cust_svc_option (used by our Tron stuff)
+ # - acct_rt_transaction (used by our time worked stuff)
+
+ push @svc_x, $svc_x;
+ }
+ return @svc_x;
+}
+
+=item uncancel_svc_summary
+
+Returns an array of hashrefs, one for each service that could
+potentially be reprovisioned by L</uncancel>, with the following keys:
+
+svcpart
+
+svc
+
+uncancel_svcnum
+
+label - from history table if not currently calculable, undefined if it can't be loaded
+
+reprovisionable - 1 if test reprovision succeeded, otherwise 0
+
+num_cust_svc - number of svcs for this svcpart, only if summarizing (see below)
+
+Cannot be run from within a transaction. Performs inserts
+to test the results, and then rolls back the transaction.
+Does not perform exports, so does not catch if export would fail.
+
+Also accepts the following options:
+
+no_test_reprovision - skip the test inserts (reprovisionable field will not exist)
+
+summarize_size - if true, returns a single summary record for svcparts with at
+least this many svcs, will have key num_cust_svc but not uncancel_svcnum, label or reprovisionable
+
+=cut
+
+sub uncancel_svc_summary {
+ my ($self, %opt) = @_;
+
+ die 'uncancel_svc_summary called on a non-cancelled cust_pkg' unless $self->get('cancel');
+ die 'uncancel_svc_summary called from within a transaction' unless $FS::UID::AutoCommit;
+
+ local $FS::svc_Common::noexport_hack = 1; # very important not to run exports!!!
+ local $FS::UID::AutoCommit = 0;
+
+ # sort by svcpart, to check summarize_size
+ my $uncancel_svc_x = {};
+ foreach my $svc_x (sort { $a->{'svcpart'} <=> $b->{'svcpart'} } $self->uncancel_svc_x) {
+ $uncancel_svc_x->{$svc_x->svcpart} = [] unless $uncancel_svc_x->{$svc_x->svcpart};
+ push @{$uncancel_svc_x->{$svc_x->svcpart}}, $svc_x;
+ }
+
+ my @out;
+ foreach my $svcpart (keys %$uncancel_svc_x) {
+ my @svcpart_svc_x = @{$uncancel_svc_x->{$svcpart}};
+ if ($opt{'summarize_size'} && (@svcpart_svc_x >= $opt{'summarize_size'})) {
+ my $svc_x = $svcpart_svc_x[0]; #grab first one for access to $part_svc
+ my $part_svc = $svc_x->part_svc;
+ push @out, {
+ 'svcpart' => $part_svc->svcpart,
+ 'svc' => $part_svc->svc,
+ 'num_cust_svc' => scalar(@svcpart_svc_x),
+ };
+ } else {
+ foreach my $svc_x (@svcpart_svc_x) {
+ my $part_svc = $svc_x->part_svc;
+ my $out = {
+ 'svcpart' => $part_svc->svcpart,
+ 'svc' => $part_svc->svc,
+ 'uncancel_svcnum' => $svc_x->get('_h_svc_x')->svcnum,
+ };
+ $svc_x->pkgnum($self->pkgnum); # provisioning services on a canceled package, will be rolled back
+ my $insert_error;
+ unless ($opt{'no_test_reprovision'}) {
+ # avoid possibly fatal errors from missing linked records
+ eval { $insert_error = $svc_x->insert };
+ $insert_error ||= $@;
+ }
+ if ($opt{'no_test_reprovision'} or $insert_error) {
+ # avoid possibly fatal errors from missing linked records
+ eval { $out->{'label'} = $svc_x->label };
+ eval { $out->{'label'} = $svc_x->get('_h_svc_x')->label } unless defined($out->{'label'});
+ $out->{'reprovisionable'} = 0 unless $opt{'no_test_reprovision'};
+ } else {
+ $out->{'label'} = $svc_x->label;
+ $out->{'reprovisionable'} = 1;
+ }
+ push @out, $out;
+ }
+ }
+ }
+
+ dbh->rollback;
+ return @out;
+}
+
=item uncancel
"Un-cancels" this package: Orders a new package with the same custnum, pkgpart,
svc_errors: pass an array reference, will be filled in with any provisioning errors
+only_svcnum: arrayref, only attempt to re-provision these cancelled services
+
main_pkgnum: link the package as a supplemental package of this one. For
internal use only.
setup
susp adjourn resume expire start_date contract_end dundate
change_date change_pkgpart change_locationnum
- manual_flag no_auto separate_bill quantity agent_pkgid
+ no_auto separate_bill quantity agent_pkgid
recur_show_zero setup_show_zero
),
};
# insert services
##
- #find historical services within this timeframe before the package cancel
- # (incompatible with "time" option to cust_pkg->cancel?)
- my $fuzz = 2 * 60; #2 minutes? too much? (might catch separate unprovision)
- # too little? (unprovisioing export delay?)
- my($end, $start) = ( $self->get('cancel'), $self->get('cancel') - $fuzz );
- my @h_cust_svc = $self->h_cust_svc( $end, $start );
-
my @svc_errors;
- foreach my $h_cust_svc (@h_cust_svc) {
- my $h_svc_x = $h_cust_svc->h_svc_x( $end, $start );
- #next unless $h_svc_x; #should this happen?
- (my $table = $h_svc_x->table) =~ s/^h_//;
- require "FS/$table.pm";
- my $class = "FS::$table";
- my $svc_x = $class->new( {
- 'pkgnum' => $cust_pkg->pkgnum,
- 'svcpart' => $h_cust_svc->svcpart,
- map { $_ => $h_svc_x->get($_) } fields($table)
- } );
-
- # radius_usergroup
- if ( $h_svc_x->isa('FS::h_svc_Radius_Mixin') ) {
- $svc_x->usergroup( [ $h_svc_x->h_usergroup($end, $start) ] );
- }
+ foreach my $svc_x ($self->uncancel_svc_x('only_svcnum' => $options{'only_svcnum'})) {
+ $svc_x->pkgnum($cust_pkg->pkgnum);
my $svc_error = $svc_x->insert;
+
if ( $svc_error ) {
if ( $options{svc_fatal} ) {
$dbh->rollback if $oldAutoCommit;
}
} # svc_fatal
} # svc_error
- } #foreach $h_cust_svc
-
- #these are pretty rare, but should handle them
- # - dsl_device (mac addresses)
- # - phone_device (mac addresses)
- # - dsl_note (ikano notes)
- # - domain_record (i.e. restore DNS information w/domains)
- # - inventory_item(?) (inventory w/un-cancelling service?)
- # - nas (svc_broaband nas stuff)
- #this stuff is unused in the wild afaik
- # - mailinglistmember
- # - router.svcnum?
- # - svc_domain.parent_svcnum?
- # - acct_snarf (ancient mail fetching config)
- # - cgp_rule (communigate)
- # - cust_svc_option (used by our Tron stuff)
- # - acct_rt_transaction (used by our time worked stuff)
+ } #foreach uncancel_svc_x
##
# also move over any services that didn't unprovision at cancellation
=item unexpire
-Cancels any pending expiration (sets the expire field to null).
+Cancels any pending expiration (sets the expire field to null)
+for this package and any supplemental packages.
If there is an error, returns the error, otherwise returns false.
=cut
sub unexpire {
- my( $self, %options ) = @_;
+ my( $self ) = @_;
my $error;
my $oldAutoCommit = $FS::UID::AutoCommit;
return $error;
}
+ foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+ $error = $supp_pkg->unexpire;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "unexpiring supplemental pkg#".$supp_pkg->pkgnum.": $error";
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
''; #no errors
=item unadjourn
-Cancels any pending suspension (sets the adjourn field to null).
+Cancels any pending suspension (sets the adjourn field to null)
+for this package and any supplemental packages.
If there is an error, returns the error, otherwise returns false.
=cut
sub unadjourn {
- my( $self, %options ) = @_;
+ my( $self ) = @_;
my $error;
my $oldAutoCommit = $FS::UID::AutoCommit;
return $error;
}
+ foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+ $error = $supp_pkg->unadjourn;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "unadjourning supplemental pkg#".$supp_pkg->pkgnum.": $error";
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
''; #no errors
my $time = time;
- $hash{'setup'} = $time if $self->setup;
+ $hash{'setup'} = $time if $self->get('setup');
$hash{'change_date'} = $time;
$hash{"change_$_"} = $self->$_()
my $unused_credit = 0;
my $keep_dates = $opt->{'keep_dates'};
- # Special case. If the pkgpart is changing, and the customer is
- # going to be credited for remaining time, don't keep setup, bill,
- # or last_bill dates, and DO pass the flag to cancel() to credit
- # the customer.
+ # Special case. If the pkgpart is changing, and the customer is going to be
+ # credited for remaining time, don't keep setup, bill, or last_bill dates,
+ # and DO pass the flag to cancel() to credit the customer. If the old
+ # package had a setup date, set the new package's setup to the package
+ # change date so that it has the same status as before.
if ( $opt->{'pkgpart'}
and $opt->{'pkgpart'} != $self->pkgpart
and $self->part_pkg->option('unused_credit_change', 1) ) {
$unused_credit = 1;
$keep_dates = 0;
- $hash{$_} = '' foreach qw(setup bill last_bill);
+ $hash{'last_bill'} = '';
+ $hash{'bill'} = '';
}
if ( $keep_dates ) {
return "transferring package notes: $error";
}
}
+
+ # transfer scheduled expire/adjourn reasons
+ foreach my $action ('expire', 'adjourn') {
+ if ( $cust_pkg->get($action) ) {
+ my $reason = $self->last_cust_pkg_reason($action);
+ if ( $reason ) {
+ $reason->set('pkgnum', $cust_pkg->pkgnum);
+ $error = $reason->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "transferring $action reason: $error";
+ }
+ }
+ }
+ }
my @new_supp_pkgs;
return "start_date $date is in the past";
}
+ # If the user entered a new location, set it up now.
+ if ( $opt->{'cust_location'} ) {
+ $error = $opt->{'cust_location'}->find_or_insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "creating location record: $error";
+ }
+ $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
+ }
+
if ( $self->change_to_pkgnum ) {
my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
my $new_pkgpart = $opt->{'pkgpart'}
}
my %search = (
- 'table' => 'cust_svc',
- 'hashref' => { 'pkgnum' => $self->pkgnum },
+ 'select' => 'cust_svc.*, part_svc.*',
+ 'table' => 'cust_svc',
+ 'hashref' => { 'pkgnum' => $self->pkgnum },
+ 'addl_from' => 'LEFT JOIN part_svc USING ( svcpart )',
);
- if ( $opt{svcpart} ) {
- $search{hashref}->{svcpart} = $opt{'svcpart'};
- }
- if ( $opt{'svcdb'} ) {
- $search{addl_from} = ' LEFT JOIN part_svc USING ( svcpart ) ';
- $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{'svcdb'} );
- }
+ $search{hashref}->{svcpart} = $opt{svcpart}
+ if $opt{svcpart};
+ $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{svcdb} )
+ if $opt{svcdb};
[ qsearch(\%search) ];
map { [ $_->label ] } $self->cust_svc;
}
-=item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
+=item h_labels END_TIMESTAMP [, START_TIMESTAMP [, MODE [, LOCALE ] ] ]
Like the labels method, but returns historical information on services that
were active as of END_TIMESTAMP and (optionally) not cancelled before
START_TIMESTAMP. If MODE is 'I' (for 'invoice'), services with the
I<pkg_svc.hidden> flag will be omitted.
-Returns a list of lists, calling the label method for all (historical) services
-(see L<FS::h_cust_svc>) of this billing item.
+If LOCALE is passed, service definition names will be localized.
+
+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;
- warn "$me _h_labels called on $self\n"
+ my ($end, $start, $mode, $locale) = @_;
+ warn "$me h_labels\n"
if $DEBUG;
- map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
+ map { [ $_->label($end, $start, $locale) ] }
+ $self->h_cust_svc($end, $start, $mode);
}
=item labels_short
=cut
sub labels_short {
- shift->_labels_short( 'labels', @_ );
+ shift->_labels_short( 'labels' ); # 'labels' takes no further arguments
}
-=item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
+=item h_labels_short END_TIMESTAMP [, START_TIMESTAMP [, MODE [, LOCALE ] ] ]
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.
+(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
shift->_labels_short( 'h_labels', @_ );
}
+# takes a method name ('labels' or 'h_labels') and all its arguments;
+# maybe should be "shorten($self->h_labels( ... ) )"
+
sub _labels_short {
my( $self, $method ) = ( shift, shift );
projects / freeside.git / blobdiff