X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=e2d337546cb5b624a5f72c9bdc04453db740c5e5;hb=5bb3332639ffadd71b00ad41fd2a7cbb038092ab;hp=07b71dc113afb448e5dceb7cce854239f340c936;hpb=077bb34b3467c3320440c49b76064f664c0eee98;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 07b71dc11..e2d337546 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -8,11 +8,11 @@ use Carp qw(cluck); 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; @@ -242,7 +242,8 @@ The following options are available: =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 @@ -266,21 +267,38 @@ sub insert { 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'; @@ -543,9 +561,12 @@ sub replace { } - 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; @@ -595,6 +616,7 @@ sub check { || $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' ]) @@ -608,6 +630,9 @@ sub check { 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') ) { @@ -765,7 +790,7 @@ sub cancel { #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; @@ -869,6 +894,163 @@ sub cancel_if_expired { ''; } +=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). @@ -930,9 +1112,21 @@ Available options are: =over 4 -=item reason - can be set to a cancellation reason (see L), 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, reason - Text of the new reason. +=item reason - can be set to a cancellation reason (see L), +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 +- 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 +separately. =back @@ -968,16 +1162,16 @@ sub suspend { 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', @@ -990,6 +1184,30 @@ sub 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 = (); @@ -1045,19 +1263,6 @@ sub suspend { } - 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 @@ -1067,12 +1272,18 @@ sub suspend { Unsuspends all services (see L and L) 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 @@ -1107,15 +1318,40 @@ sub unsuspend { 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 } ) ) { @@ -1135,10 +1371,15 @@ sub unsuspend { $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'}; @@ -1156,7 +1397,8 @@ sub unsuspend { } $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 ) { @@ -1164,6 +1406,61 @@ sub unsuspend { 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 @@ -1214,6 +1511,7 @@ sub unadjourn { my %hash = $self->hash; $hash{'adjourn'} = ''; + $hash{'resume'} = ''; my $new = new FS::cust_pkg ( \%hash ); $error = $new->replace( $self, options => { $self->options } ); if ( $error ) { @@ -1325,7 +1623,7 @@ sub change { 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); } } @@ -1340,12 +1638,16 @@ sub change { $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, }; @@ -1726,33 +2028,59 @@ sub num_cust_event { $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). If a svcpart is specified, return only the matching -services. +L). 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) ]; } @@ -1791,7 +2119,7 @@ sub h_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 { @@ -1819,10 +2147,12 @@ sub _sort_cust_svc { } -=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 @@ -1837,11 +2167,31 @@ sub num_cust_svc { 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]; } @@ -1872,7 +2222,7 @@ sub available_part_svc { $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 @@ -1886,15 +2236,20 @@ following extra fields: =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 { @@ -1905,7 +2260,9 @@ sub part_svc { $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; @@ -1937,7 +2294,7 @@ sub extra_part_svc { my $self = shift; my $pkgnum = $self->pkgnum; - my $pkgpart = $self->pkgpart; + #my $pkgpart = $self->pkgpart; # qsearch( { # 'table' => 'part_svc', @@ -1956,23 +2313,27 @@ sub extra_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'] ], } ); } @@ -2237,6 +2598,18 @@ sub cust_main { 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 @@ -2302,7 +2675,7 @@ sub seconds_since_sqlradacct { 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); @@ -2334,7 +2707,7 @@ sub attribute_since_sqlradacct { 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); @@ -2506,6 +2879,39 @@ sub reexport { } +=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 @@ -2631,7 +3037,8 @@ All svc_accts which are part of this package have their values reset. 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"); @@ -2651,7 +3058,8 @@ All svc_accts which are part of this package have their values incremented. 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"); @@ -2870,7 +3278,14 @@ specifies the user for agent virtualization =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 @@ -2942,45 +3357,55 @@ sub search { # 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) { @@ -2993,7 +3418,27 @@ sub search { } @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 @@ -3005,7 +3450,8 @@ sub search { # 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 @@ -3019,6 +3465,35 @@ sub search { } ### + # 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 ### @@ -3067,7 +3542,7 @@ sub search { "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}); @@ -3142,23 +3617,38 @@ sub search { 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 $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(*)'; + } - my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql"; + $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, }; @@ -3211,7 +3701,13 @@ sub location_sql { # '?' 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; @@ -3270,16 +3766,19 @@ sub _location_sql_where { $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 = ? "; }