use Scalar::Util qw( blessed );
use List::Util qw(max);
use Tie::IxHash;
-use Time::Local qw( timelocal_nocheck );
+use Time::Local qw( timelocal timelocal_nocheck );
use MIME::Entity;
-use FS::UID qw( getotaker dbh );
+use FS::UID qw( getotaker dbh driver_name );
use FS::Misc qw( send_email );
-use FS::Record qw( qsearch qsearchs );
+use FS::Record qw( qsearch qsearchs fields );
use FS::CurrentUser;
use FS::cust_svc;
use FS::part_pkg;
use FS::cust_pkg_discount;
use FS::discount;
use FS::UI::Web;
+use Data::Dumper;
# need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
# setup }
Previous locationnum
+=item waive_setup
+
=back
Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
=item change
-If set true, supresses any referral credit to a referring customer.
+If set true, supresses actions that should only be taken for new package
+orders. (Currently this includes: intro periods when delay_setup is on.)
=item options
my $error = $self->check_pkgpart;
return $error if $error;
- if ( $self->part_pkg->option('start_1st', 1) && !$self->start_date ) {
+ my $part_pkg = $self->part_pkg;
+
+ # if the package def says to start only on the first of the month:
+ if ( $part_pkg->option('start_1st', 1) && !$self->start_date ) {
my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5];
$mon += 1 unless $mday == 1;
until ( $mon < 12 ) { $mon -= 12; $year++; }
$self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
}
+ # set up any automatic expire/adjourn/contract_end timers
+ # based on the start date
foreach my $action ( qw(expire adjourn contract_end) ) {
- my $months = $self->part_pkg->option("${action}_months",1);
+ my $months = $part_pkg->option("${action}_months",1);
if($months and !$self->$action) {
my $start = $self->start_date || $self->setup || time;
- $self->$action( $self->part_pkg->add_freq($start, $months) );
+ $self->$action( $part_pkg->add_freq($start, $months) );
}
}
+ # if this package has "free days" and delayed setup fee, tehn
+ # set start date that many days in the future.
+ # (this should have been set in the UI, but enforce it here)
+ if ( ! $options{'change'}
+ && ( my $free_days = $part_pkg->option('free_days',1) )
+ && $part_pkg->option('delay_setup',1)
+ #&& ! $self->start_date
+ )
+ {
+ $self->start_date( $part_pkg->default_start_date );
+ }
+
$self->order_date(time);
local $SIG{HUP} = 'IGNORE';
}
- my $error = $new->SUPER::replace($old,
- $options->{options} ? $options->{options} : ()
- );
+ my $error = $new->export_pkg_change($old)
+ || $new->SUPER::replace( $old,
+ $options->{options}
+ ? $options->{options}
+ : ()
+ );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
|| $self->ut_numbern('susp')
|| $self->ut_numbern('cancel')
|| $self->ut_numbern('adjourn')
+ || $self->ut_numbern('resume')
|| $self->ut_numbern('expire')
+ || $self->ut_numbern('dundate')
|| $self->ut_enum('no_auto', [ '', 'Y' ])
+ || $self->ut_enum('waive_setup', [ '', 'Y' ])
+ || $self->ut_numbern('agent_pkgid')
+ || $self->ut_enum('recur_show_zero', [ '', 'Y', 'N', ])
+ || $self->ut_enum('setup_show_zero', [ '', 'Y', 'N', ])
;
return $error if $error;
+ return "A package with both start date (future start) and setup date (already started) will never bill"
+ if $self->start_date && $self->setup;
+
+ return "A future unsuspend date can only be set for a package with a suspend date"
+ if $self->resume and !$self->susp and !$self->adjourn;
+
$self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
if ( $self->dbdef_table->column('manual_flag') ) {
#schwartz
map { $_->[0] }
sort { $a->[1] <=> $b->[1] }
- map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
+ map { [ $_, $_->svc_x ? $_->svc_x->table_info->{'cancel_weight'} : -1 ]; }
qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
) {
+ my $part_svc = $cust_svc->part_svc;
+ next if ( defined($part_svc) and $part_svc->preserve );
my $error = $cust_svc->cancel( %svc_cancel_opt );
if ( $error ) {
'';
}
+=item uncancel
+
+"Un-cancels" this package: Orders a new package with the same custnum, pkgpart,
+locationnum, (other fields?). Attempts to re-provision cancelled services
+using history information (errors at this stage are not fatal).
+
+cust_pkg: pass a scalar reference, will be filled in with the new cust_pkg object
+
+svc_fatal: service provisioning errors are fatal
+
+svc_errors: pass an array reference, will be filled in with any provisioning errors
+
+=cut
+
+sub uncancel {
+ my( $self, %options ) = @_;
+
+ #in case you try do do $uncancel-date = $cust_pkg->uncacel
+ return '' unless $self->get('cancel');
+
+ ##
+ # Transaction-alize
+ ##
+
+ 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;
+
+ ##
+ # insert the new package
+ ##
+
+ my $cust_pkg = new FS::cust_pkg {
+ last_bill => ( $options{'last_bill'} || $self->get('last_bill') ),
+ bill => ( $options{'bill'} || $self->get('bill') ),
+ uncancel => time,
+ uncancel_pkgnum => $self->pkgnum,
+ map { $_ => $self->get($_) } qw(
+ custnum pkgpart locationnum
+ setup
+ susp adjourn resume expire start_date contract_end dundate
+ change_date change_pkgpart change_locationnum
+ manual_flag no_auto quantity agent_pkgid recur_show_zero setup_show_zero
+ ),
+ };
+
+ my $error = $cust_pkg->insert(
+ 'change' => 1, #supresses any referral credit to a referring customer
+ );
+ if ($error) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ ##
+ # 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) ] );
+ }
+
+ my $svc_error = $svc_x->insert;
+ if ( $svc_error ) {
+ if ( $options{svc_fatal} ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $svc_error;
+ } else {
+ # if we've failed to insert the svc_x object, svc_Common->insert
+ # will have removed the cust_svc already. if not, then both records
+ # were inserted but we failed for some other reason (export, most
+ # likely). in that case, report the error and delete the records.
+ push @svc_errors, $svc_error;
+ my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_x->svcnum });
+ if ( $cust_svc ) {
+ # except if export_insert failed, export_delete probably won't be
+ # much better
+ local $FS::svc_Common::noexport_hack = 1;
+ my $cleanup_error = $svc_x->delete; # also deletes cust_svc
+ if ( $cleanup_error ) { # and if THAT fails, then run away
+ $dbh->rollback if $oldAutoCommit;
+ return $cleanup_error;
+ }
+ }
+ } # 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)
+
+ ##
+ # also move over any services that didn't unprovision at cancellation
+ ##
+
+ foreach my $cust_svc ( qsearch('cust_svc', { pkgnum => $self->pkgnum } ) ) {
+ $cust_svc->pkgnum( $cust_pkg->pkgnum );
+ my $error = $cust_svc->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ ##
+ # Finish
+ ##
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ ${ $options{cust_pkg} } = $cust_pkg if ref($options{cust_pkg});
+ @{ $options{svc_errors} } = @svc_errors if ref($options{svc_errors});
+
+ '';
+}
+
=item unexpire
Cancels any pending expiration (sets the expire field to null).
=over 4
-=item reason - 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.
+=item reason - 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.
+
+=item date - can be set to a unix style timestamp to specify when to
+suspend (adjourn)
-=item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
+=item time - can be set to override the current time, for calculation
+of final invoices or unused-time credits
+
+=item resume_date - can be set to a time when the package should be
+unsuspended. This may be more convenient than calling C<unsuspend()>
+separately.
=back
return ""; # no error # complain on adjourn?
}
+ my $suspend_time = $options{'time'} || time;
+
my $date = $options{date} if $options{date}; # adjourn/suspend later
- $date = '' if ($date && $date <= time); # complain instead?
+ $date = '' if ($date && $date <= $suspend_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',
}
}
+ my %hash = $self->hash;
+ if ( $date ) {
+ $hash{'adjourn'} = $date;
+ } else {
+ $hash{'susp'} = $suspend_time;
+ }
+
+ my $resume_date = $options{'resume_date'} || 0;
+ if ( $resume_date > ($date || $suspend_time) ) {
+ $hash{'resume'} = $resume_date;
+ }
+
+ $options{options} ||= {};
+
+ my $new = new FS::cust_pkg ( \%hash );
+ $error = $new->replace( $self, options => { $self->options,
+ %{ $options{options} },
+ }
+ );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
unless ( $date ) {
my @labels = ();
}
- 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
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).
+adjourn field if it is in the past). If the suspend reason includes an
+unsuspension package, that package will be ordered.
Available options are:
=over 4
+=item date
+
+Can be set to a date to unsuspend the package in the future (the 'resume'
+field).
+
=item adjust_next_bill
Can be set true to adjust the next bill date forward by
my $pkgnum = $old->pkgnum;
if ( $old->get('cancel') || $self->get('cancel') ) {
- dbh->rollback if $oldAutoCommit;
+ $dbh->rollback if $oldAutoCommit;
return "Can't unsuspend cancelled package $pkgnum";
}
unless ( $old->get('susp') && $self->get('susp') ) {
- dbh->rollback if $oldAutoCommit;
+ $dbh->rollback if $oldAutoCommit;
return ""; # no error # complain instead?
}
+ my $date = $opt{'date'};
+ if ( $date and $date > time ) { # return an error if $date <= time?
+
+ if ( $old->get('expire') && $old->get('expire') < $date ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Package $pkgnum expires before it would be unsuspended.";
+ }
+
+ my $new = new FS::cust_pkg { $self->hash };
+ $new->set('resume', $date);
+ $error = $new->replace($self, options => $self->options);
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ else {
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ return '';
+ }
+
+ } #if $date
+
+ my @labels = ();
+
foreach my $cust_svc (
qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
+ my( $label, $value ) = $cust_svc->label;
+ push @labels, "$label: $value";
}
}
+ my $cust_pkg_reason = $self->last_cust_pkg_reason('susp');
+ my $reason = $cust_pkg_reason ? $cust_pkg_reason->reason : '';
+
my %hash = $self->hash;
my $inactive = time - $hash{'susp'};
}
$hash{'susp'} = '';
- $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
+ $hash{'adjourn'} = '' if $hash{'adjourn'} and $hash{'adjourn'} < time;
+ $hash{'resume'} = '' if !$hash{'adjourn'};
my $new = new FS::cust_pkg ( \%hash );
$error = $new->replace( $self, options => { $self->options } );
if ( $error ) {
return $error;
}
+ my $unsusp_pkg;
+
+ if ( $reason && $reason->unsuspend_pkgpart ) {
+ my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart)
+ or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart.
+ " not found.";
+ my $start_date = $self->cust_main->next_bill_date
+ if $reason->unsuspend_hold;
+
+ if ( $part_pkg ) {
+ $unsusp_pkg = FS::cust_pkg->new({
+ 'custnum' => $self->custnum,
+ 'pkgpart' => $reason->unsuspend_pkgpart,
+ 'start_date' => $start_date,
+ 'locationnum' => $self->locationnum,
+ # discount? probably not...
+ });
+
+ $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg );
+ }
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ if ( $conf->config('unsuspend_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('unsuspend_email_admin'),
+ 'subject' => 'FREESIDE NOTIFICATION: Customer package unsuspended', 'body' => [
+ "This is an automatic message from your Freeside installation\n",
+ "informing you that the following customer package has been unsuspended:\n",
+ "\n",
+ 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
+ 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
+ ( map { "Service : $_\n" } @labels ),
+ ($unsusp_pkg ?
+ "An unsuspension fee was charged: ".
+ $unsusp_pkg->part_pkg->pkg_comment."\n"
+ : ''
+ ),
+ ],
+ );
+
+ if ( $error ) {
+ warn "WARNING: can't send unsuspension admin email (unsuspending anyway): ".
+ "$error\n";
+ }
+
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
''; #no errors
my %hash = $self->hash;
$hash{'adjourn'} = '';
+ $hash{'resume'} = '';
my $new = new FS::cust_pkg ( \%hash );
$error = $new->replace( $self, options => { $self->options } );
if ( $error ) {
my $unused_credit = 0;
if ( $opt->{'keep_dates'} ) {
foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire
- start_date contract_end ) ) {
+ resume start_date contract_end ) ) {
$hash{$date} = $self->getfield($date);
}
}
$hash{$_} = '' foreach qw(setup bill last_bill);
}
+ # allow $opt->{'locationnum'} = '' to specifically set it to null
+ # (i.e. customer default location)
+ $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'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 ),
+ locationnum => ( $opt->{'locationnum'} ),
%hash,
};
}
-use Data::Dumper;
use Storable 'thaw';
use MIME::Base64;
sub process_bulk_cust_pkg {
$sth->fetchrow_arrayref->[0];
}
-=item cust_svc [ SVCPART ]
+=item cust_svc [ SVCPART ] (old, deprecated usage)
+
+=item cust_svc [ OPTION => VALUE ... ] (current usage)
+
+=item cust_svc_unsorted [ OPTION => VALUE ... ]
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.
+L<FS::cust_svc>). Available options are svcpart and svcdb. If either is
+spcififed, returns only the matching services.
+
+As an optimization, use the cust_svc_unsorted version if you are not displaying
+the results.
=cut
sub cust_svc {
my $self = shift;
+ cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
+ $self->_sort_cust_svc( $self->cust_svc_unsorted_arrayref(@_) );
+}
+
+sub cust_svc_unsorted {
+ my $self = shift;
+ @{ $self->cust_svc_unsorted_arrayref(@_) };
+}
+
+sub cust_svc_unsorted_arrayref {
+ my $self = shift;
return () unless $self->num_cust_svc(@_);
- if ( @_ ) {
- return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
- 'svcpart' => shift, } );
+ my %opt = ();
+ if ( @_ && $_[0] =~ /^\d+/ ) {
+ $opt{svcpart} = shift;
+ } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
+ %opt = %{ $_[0] };
+ } elsif ( @_ ) {
+ %opt = @_;
}
- cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
+ my %search = (
+ 'table' => 'cust_svc',
+ 'hashref' => { 'pkgnum' => $self->pkgnum },
+ );
+ 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'} );
+ }
- #if ( $self->{'_svcnum'} ) {
- # values %{ $self->{'_svcnum'}->cache };
- #} else {
- $self->_sort_cust_svc(
- [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
- );
- #}
+ [ qsearch(\%search) ];
}
sub h_cust_svc {
my $self = shift;
warn "$me _h_cust_svc called on $self\n"
- if $DEBUG > 1;
+ if $DEBUG;
my ($end, $start, $mode) = @_;
my @cust_svc = $self->_sort_cust_svc(
FS::h_cust_svc->sql_h_search(@_),
) ]
);
- if ( $mode eq 'I' ) {
+ if ( defined($mode) && $mode eq 'I' ) {
my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc;
return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc;
} else {
}
-=item num_cust_svc [ SVCPART ]
+=item num_cust_svc [ SVCPART ] (old, deprecated usage)
+
+=item num_cust_svc [ OPTION => VALUE ... ] (current usage)
-Returns the number of provisioned services for this package. If a svcpart is
-specified, counts only the matching services.
+Returns the number of services for this package. Available options are svcpart
+and svcdb. If either is spcififed, returns only the matching services.
=cut
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 %opt = ();
+ if ( @_ && $_[0] =~ /^\d+/ ) {
+ $opt{svcpart} = shift;
+ } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
+ %opt = %{ $_[0] };
+ } elsif ( @_ ) {
+ %opt = @_;
+ }
+
+ my $select = 'SELECT COUNT(*) FROM cust_svc ';
+ my $where = ' WHERE pkgnum = ? ';
+ my @param = ($self->pkgnum);
+
+ if ( $opt{'svcpart'} ) {
+ $where .= ' AND svcpart = ? ';
+ push @param, $opt{'svcpart'};
+ }
+ if ( $opt{'svcdb'} ) {
+ $select .= ' LEFT JOIN part_svc USING ( svcpart ) ';
+ $where .= ' AND svcdb = ? ';
+ push @param, $opt{'svcdb'};
+ }
- my $sth = dbh->prepare($sql) or die dbh->errstr;
- $sth->execute($self->pkgnum, @_) or die $sth->errstr;
+ my $sth = dbh->prepare("$select $where") or die dbh->errstr;
+ $sth->execute(@param) or die $sth->errstr;
$sth->fetchrow_arrayref->[0];
}
$self->part_pkg->pkg_svc;
}
-=item part_svc
+=item part_svc [ OPTION => VALUE ... ]
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
=item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
-svcnum
-label -> ($cust_svc->label)[1]
-
=back
+Accepts one option: summarize_size. If specified and non-zero, will omit the
+extra cust_pkg_svc option for objects where num_cust_svc is this size or
+greater.
+
=cut
+#svcnum
+#label -> ($cust_svc->label)[1]
+
sub part_svc {
my $self = shift;
+ my %opt = @_;
#XXX some sort of sort order besides numeric by svcpart...
my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
$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) ] : [];
+ $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []
+ unless exists($opt{summarize_size}) && $opt{summarize_size} > 0
+ && $num_cust_svc >= $opt{summarize_size};
$part_svc->{'Hash'}{'hidden'} = $pkg_svc->hidden;
$part_svc;
} $self->part_pkg->pkg_svc;
my $self = shift;
my $pkgnum = $self->pkgnum;
- my $pkgpart = $self->pkgpart;
+ #my $pkgpart = $self->pkgpart;
# qsearch( {
# 'table' => 'part_svc',
# 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
# } );
-#seems to benchmark slightly faster...
+#seems to benchmark slightly faster... (or did?)
+
+ my @pkgparts = map $_->pkgpart, $self->part_pkg->self_and_svc_linked;
+ my $pkgparts = join(',', @pkgparts);
+
qsearch( {
#'select' => 'DISTINCT ON (svcpart) part_svc.*',
#MySQL doesn't grok DISINCT ON
'select' => 'DISTINCT part_svc.*',
'table' => 'part_svc',
'addl_from' =>
- 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
- AND pkg_svc.pkgpart = ?
+ "LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
+ AND pkg_svc.pkgpart IN ($pkgparts)
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'] ],
+ 'extra_param' => [ [$self->pkgnum=>'int'] ],
} );
}
sub h_labels {
my $self = shift;
warn "$me _h_labels called on $self\n"
- if $DEBUG > 1;
+ if $DEBUG;
map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
}
my( $self, $method ) = ( shift, shift );
warn "$me _labels_short called on $self with $method method\n"
- if $DEBUG > 1;
+ if $DEBUG;
my $conf = new FS::Conf;
my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
warn "$me _labels_short populating \%labels\n"
- if $DEBUG > 1;
+ if $DEBUG;
my %labels;
#tie %labels, 'Tie::IxHash';
foreach $self->$method(@_);
warn "$me _labels_short populating \@labels\n"
- if $DEBUG > 1;
+ if $DEBUG;
my @labels;
foreach my $label ( keys %labels ) {
my %seen = ();
my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
my $num = scalar(@values);
+ warn "$me _labels_short $num items for $label\n"
+ if $DEBUG;
+
if ( $num > $max_same_services ) {
+ warn "$me _labels_short more than $max_same_services, so summarizing\n"
+ if $DEBUG;
push @labels, "$label ($num)";
} else {
if ( $conf->exists('cust_bill-consolidate_services') ) {
+ warn "$me _labels_short consolidating services\n"
+ if $DEBUG;
# push @labels, "$label: ". join(', ', @values);
while ( @values ) {
my $detail = "$label: ";
$detail .= shift(@values). ', '
- while @values && length($detail.$values[0]) < 78;
+ while @values
+ && ( length($detail.$values[0]) < 78 || $detail eq "$label: " );
$detail =~ s/, $//;
push @labels, $detail;
}
+ warn "$me _labels_short done consolidating services\n"
+ if $DEBUG;
} else {
+ warn "$me _labels_short adding service data\n"
+ if $DEBUG;
push @labels, map { "$label: $_" } @values;
}
}
qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
}
+=item balance
+
+Returns the balance for this specific package, when using
+experimental package balance.
+
+=cut
+
+sub balance {
+ my $self = shift;
+ $self->cust_main->balance_pkgnum( $self->pkgnum );
+}
+
#these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
=item cust_location
grep {
my $part_svc = $_->part_svc;
$part_svc->svcdb eq 'svc_acct'
- && scalar($part_svc->part_export('sqlradius'));
+ && scalar($part_svc->part_export_usage);
} $self->cust_svc
) {
$seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
grep {
my $part_svc = $_->part_svc;
$part_svc->svcdb eq 'svc_acct'
- && scalar($part_svc->part_export('sqlradius'));
+ && scalar($part_svc->part_export_usage);
} $self->cust_svc
) {
$sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
}
+=item export_pkg_change OLD_CUST_PKG
+
+Calls the "pkg_change" export action for all services attached to this package.
+
+=cut
+
+sub export_pkg_change {
+ my( $self, $old ) = ( shift, 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 $svc_x ( map $_->svc_x, $self->cust_svc ) {
+ my $error = $svc_x->export('pkg_change', $self, $old);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
=item insert_reason
Associates this package with a (suspension or cancellation) reason (see
'amount' => $self->discountnum_amount,
'percent' => $self->discountnum_percent,
'months' => $self->discountnum_months,
+ 'setup' => $self->discountnum_setup,
#'disabled' => $self->discountnum_disabled,
};
sub set_usage {
my ($self, $valueref, %opt) = @_;
- foreach my $cust_svc ($self->cust_svc){
+ #only svc_acct can set_usage for now
+ foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
my $svc_x = $cust_svc->svc_x;
$svc_x->set_usage($valueref, %opt)
if $svc_x->can("set_usage");
sub recharge {
my ($self, $valueref) = @_;
- foreach my $cust_svc ($self->cust_svc){
+ #only svc_acct can set_usage for now
+ foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
my $svc_x = $cust_svc->svc_x;
$svc_x->recharge($valueref)
if $svc_x->can("recharge");
=item fcc_line
- boolean selects packages containing fcc form 477 telco lines
+boolean; if true, returns only packages with more than 0 FCC phone lines
+
+=item state, country
+
+Limit to packages whose customer is located in the specified state and
+country. For FCC 477 reporting. This will use the customer's service
+address if there is one, but isn't yet smart enough to use the package
+address.
=back
# parse package class
###
- #false lazinessish w/graph/cust_bill_pkg.cgi
- my $classnum = 0;
- my @pkg_class = ();
- if ( exists($params->{'classnum'})
- && $params->{'classnum'} =~ /^(\d*)$/
- )
- {
- $classnum = $1;
- if ( $classnum ) { #a specific class
- push @where, "part_pkg.classnum = $classnum";
-
- #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
- #die "classnum $classnum not found!" unless $pkg_class[0];
- #$title .= $pkg_class[0]->classname.' ';
-
- } elsif ( $classnum eq '' ) { #the empty class
-
- push @where, "part_pkg.classnum IS NULL";
- #$title .= 'Empty class ';
- #@pkg_class = ( '(empty class)' );
- } elsif ( $classnum eq '0' ) {
- #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
- #push @pkg_class, '(empty class)';
- } else {
- die "illegal classnum";
+ if ( exists($params->{'classnum'}) ) {
+
+ my @classnum = ();
+ if ( ref($params->{'classnum'}) ) {
+
+ if ( ref($params->{'classnum'}) eq 'HASH' ) {
+ @classnum = grep $params->{'classnum'}{$_}, keys %{ $params->{'classnum'} };
+ } elsif ( ref($params->{'classnum'}) eq 'ARRAY' ) {
+ @classnum = @{ $params->{'classnum'} };
+ } else {
+ die 'unhandled classnum ref '. $params->{'classnum'};
+ }
+
+
+ } elsif ( $params->{'classnum'} =~ /^(\d*)$/ && $1 ne '0' ) {
+ @classnum = ( $1 );
}
+
+ if ( @classnum ) {
+
+ my @c_where = ();
+ my @nums = grep $_, @classnum;
+ push @c_where, 'part_pkg.classnum IN ('. join(',',@nums). ')' if @nums;
+ my $null = scalar( grep { $_ eq '' } @classnum );
+ push @c_where, 'part_pkg.classnum IS NULL' if $null;
+
+ if ( scalar(@c_where) == 1 ) {
+ push @where, @c_where;
+ } elsif ( @c_where ) {
+ push @where, ' ( '. join(' OR ', @c_where). ' ) ';
+ }
+
+ }
+
+
}
- #eslaf
###
# parse package report options
###
my @report_option = ();
- if ( exists($params->{'report_option'})
- && $params->{'report_option'} =~ /^([,\d]*)$/
- )
- {
- @report_option = split(',', $1);
+ if ( exists($params->{'report_option'}) ) {
+ if ( ref($params->{'report_option'}) eq 'ARRAY' ) {
+ @report_option = @{ $params->{'report_option'} };
+ } elsif ( $params->{'report_option'} =~ /^([,\d]*)$/ ) {
+ @report_option = split(',', $1);
+ }
+
}
if (@report_option) {
} @report_option;
}
- #eslaf
+ foreach my $any ( grep /^report_option_any/, keys %$params ) {
+
+ my @report_option_any = ();
+ if ( ref($params->{$any}) eq 'ARRAY' ) {
+ @report_option_any = @{ $params->{$any} };
+ } elsif ( $params->{$any} =~ /^([,\d]*)$/ ) {
+ @report_option_any = split(',', $1);
+ }
+
+ if (@report_option_any) {
+ # this will result in the empty set for the dangling comma case as it should
+ push @where, ' ( '. join(' OR ',
+ map{ "0 < ( SELECT count(*) FROM part_pkg_option
+ WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
+ AND optionname = 'report_option_$_'
+ AND optionvalue = '1' )"
+ } @report_option_any
+ ). ' ) ';
+ }
+
+ }
###
# parse custom
# parse fcc_line
###
- push @where, "part_pkg.fcc_ds0s > 0" if $params->{fcc_line};
+ push @where, "(part_pkg.fcc_ds0s > 0 OR pkg_class.fcc_ds0s > 0)"
+ if $params->{fcc_line};
###
# parse censustract
}
###
+ # parse censustract2
+ ###
+ if ( exists($params->{'censustract2'})
+ && $params->{'censustract2'} =~ /^(\d*)$/
+ )
+ {
+ if ($1) {
+ push @where, "cust_main.censustract LIKE '$1%'";
+ } else {
+ push @where,
+ "( cust_main.censustract = '' OR cust_main.censustract IS NULL )";
+ }
+ }
+
+ ###
+ # parse country/state
+ ###
+
+ for (qw(state country)) {
+ if ( exists($params->{$_})
+ && uc($params->{$_}) =~ /^([A-Z]{2})$/ )
+ {
+ push @where,
+ "COALESCE(cust_location.$_, cust_main.ship_$_, cust_main.$_) = '$1'";
+ }
+ }
+
+
+ ###
# parse part_pkg
###
"NOT (".FS::cust_pkg->onetime_sql . ")";
}
else {
- foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end cancel )) {
+ foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end change_date cancel )) {
next unless exists($params->{$field});
my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
'LEFT JOIN part_pkg USING ( pkgpart ) '.
- 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) ';
+ 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) '.
+ 'LEFT JOIN cust_location USING ( locationnum ) ';
- my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
+ my $select;
+ my $count_query;
+ if ( $params->{'select_zip5'} ) {
+ my $zip = 'COALESCE(cust_location.zip, cust_main.ship_zip, cust_main.zip)';
+
+ $select = "DISTINCT substr($zip,1,5) as zip";
+ $orderby = "ORDER BY substr($zip,1,5)";
+ $count_query = "SELECT COUNT( DISTINCT substr($zip,1,5) )";
+ } else {
+ $select = join(', ',
+ 'cust_pkg.*',
+ ( map "part_pkg.$_", qw( pkg freq ) ),
+ 'pkg_class.classname',
+ 'cust_main.custnum AS cust_main_custnum',
+ FS::UI::Web::cust_sql_fields(
+ $params->{'cust_fields'}
+ ),
+ );
+ $count_query = 'SELECT COUNT(*)';
+ }
+
+ $count_query .= " FROM cust_pkg $addl_from $extra_sql";
my $sql_query = {
'table' => 'cust_pkg',
'hashref' => {},
- 'select' => join(', ',
- 'cust_pkg.*',
- ( map "part_pkg.$_", qw( pkg freq ) ),
- 'pkg_class.classname',
- 'cust_main.custnum AS cust_main_custnum',
- FS::UI::Web::cust_sql_fields(
- $params->{'cust_fields'}
- ),
- ),
- 'extra_sql' => "$extra_sql $orderby",
+ 'select' => $select,
+ 'extra_sql' => $extra_sql,
+ 'order_by' => $orderby,
'addl_from' => $addl_from,
'count_query' => $count_query,
};
# '?' placeholders in _location_sql_where
my $x = $ornull ? 3 : 2;
- my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' );
+ my @bill_param = (
+ ('district')x3,
+ ('city')x3,
+ ('county')x$x,
+ ('state')x$x,
+ 'country'
+ );
my $main_where;
my @main_param;
$ornull = $ornull ? ' OR ? IS NULL ' : '';
- my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL ) ";
- my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
- my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) ";
+ my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL )";
+ my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL )";
+ my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL )";
+
+ my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
# ( $table.${prefix}city = ? $or_empty_city $ornull )
"
- ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS text) IS NULL )
- AND ( $table.${prefix}county = ? $or_empty_county $ornull )
- AND ( $table.${prefix}state = ? $or_empty_state $ornull )
- AND $table.${prefix}country = ?
+ ( $table.district = ? OR ? = '' OR CAST(? AS $text) IS NULL )
+ AND ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS $text) IS NULL )
+ AND ( $table.${prefix}county = ? $or_empty_county $ornull )
+ AND ( $table.${prefix}state = ? $or_empty_state $ornull )
+ AND $table.${prefix}country = ?
";
}
+sub _X_show_zero {
+ my( $self, $what ) = @_;
+
+ my $what_show_zero = $what. '_show_zero';
+ length($self->$what_show_zero())
+ ? ($self->$what_show_zero() eq 'Y')
+ : $self->part_pkg->$what_show_zero();
+}
+
=head1 SUBROUTINES
=over 4
projects / freeside.git / blobdiff