package FS::cust_pkg;
use strict;
-use vars qw(@ISA $disable_agentcheck $DEBUG);
+use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::location_Mixin
+ FS::m2m_Common FS::option_Common );
+use vars qw($disable_agentcheck $DEBUG $me);
use Carp qw(cluck);
use Scalar::Util qw( blessed );
use List::Util qw(max);
use Tie::IxHash;
+use Time::Local qw( timelocal_nocheck );
use MIME::Entity;
use FS::UID qw( getotaker dbh );
use FS::Misc qw( send_email );
use FS::Record qw( qsearch qsearchs );
-use FS::m2m_Common;
-use FS::cust_main_Mixin;
use FS::cust_svc;
use FS::part_pkg;
use FS::cust_main;
use FS::part_svc;
use FS::cust_pkg_reason;
use FS::reason;
+use FS::cust_pkg_discount;
+use FS::discount;
use FS::UI::Web;
# need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
# for sending cancel emails in sub cancel
use FS::Conf;
-@ISA = qw( FS::m2m_Common FS::cust_main_Mixin FS::option_Common FS::Record );
-
$DEBUG = 0;
+$me = '[FS::cust_pkg]';
$disable_agentcheck = 0;
Optional link to package location (see L<FS::location>)
+=item start_date
+
+date
+
=item setup
date
date
-=item otaker
+=item usernum
-order taker (assigned automatically if null, see L<FS::UID>)
+order taker (see L<FS::access_user>)
=item manual_flag
sub insert {
my( $self, %options ) = @_;
+ if ( $self->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) );
+ }
+
+ my $expire_months = $self->part_pkg->option('expire_months', 1);
+ if ( $expire_months && !$self->expire ) {
+ my $start = $self->start_date || $self->setup || time;
+
+ #false laziness w/part_pkg::add_freq
+ my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($start) )[0,1,2,3,4,5];
+ $mon += $expire_months;
+ until ( $mon < 12 ) { $mon -= 12; $year++; }
+
+ #$self->expire( timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year) );
+ $self->expire( timelocal_nocheck(0,0,0,$mday,$mon,$year) );
+ }
+
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
'params' => $self->refnum,
);
+ if ( $self->discountnum ) {
+ my $error = $self->insert_discount();
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
#if ( $self->reg_code ) {
# my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
# $error = $reg_code->delete;
my $conf = new FS::Conf;
if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
- eval '
- use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
- use RT;
- ';
- die $@ if $@;
-
- RT::LoadConfig();
- RT::Init();
+
+ #eval '
+ # use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
+ # use RT;
+ #';
+ #die $@ if $@;
+ #
+ #RT::LoadConfig();
+ #RT::Init();
+ use FS::TicketSystem;
+ FS::TicketSystem->init();
+
my $q = new RT::Queue($RT::SystemUser);
$q->Load($options{ticket_queue}) if $options{ticket_queue};
my $t = new RT::Ticket($RT::SystemUser);
: { @_ };
#return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
- return "Can't change otaker!" if $old->otaker ne $new->otaker;
+ #return "Can't change otaker!" if $old->otaker ne $new->otaker;
#allow this *sigh*
#return "Can't change setup once it exists!"
|| $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
|| $self->ut_numbern('pkgpart')
|| $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
+ || $self->ut_numbern('start_date')
|| $self->ut_numbern('setup')
|| $self->ut_numbern('bill')
|| $self->ut_numbern('susp')
|| $self->ut_numbern('cancel')
|| $self->ut_numbern('adjourn')
|| $self->ut_numbern('expire')
+ || $self->ut_enum('no_auto', [ '', 'Y' ])
;
return $error if $error;
}
$self->otaker(getotaker) unless $self->otaker;
- $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker";
- $self->otaker($1);
if ( $self->dbdef_table->column('manual_flag') ) {
$self->manual_flag('') if $self->manual_flag eq ' ';
=item date - can be set to a unix style timestamp to specify when to cancel (expire)
+=item nobill - can be set true to skip billing if it might otherwise be done.
+
=back
If there is an error, returns the error, otherwise returns false.
my( $self, %options ) = @_;
my $error;
+ my $conf = new FS::Conf;
+
warn "cust_pkg::cancel called with options".
join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
if $DEBUG;
my $date = $options{date} if $options{date}; # expire/cancel later
$date = '' if ($date && $date <= time); # complain instead?
+ #race condition: usage could be ongoing until unprovisioned
+ #resolved by performing a change package instead (which unprovisions) and
+ #later cancelling
+ if ( !$options{nobill} && !$date && $conf->exists('bill_usage_on_cancel') ) {
+ my $copy = $self->new({$self->hash});
+ my $error =
+ $copy->cust_main->bill( pkg_list => [ $copy ], cancel => 1 );
+ warn "Error billing during cancel, custnum ".
+ #$self->cust_main->custnum. ": $error"
+ ": $error"
+ if $error;
+ }
+
+
my $cancel_time = $options{'time'} || time;
if ( $options{'reason'} ) {
# Add a credit for remaining service
my $remaining_value = $self->calc_remain(time=>$cancel_time);
if ( $remaining_value > 0 && !$options{'no_credit'} ) {
- my $conf = new FS::Conf;
my $error = $self->cust_main->credit(
$remaining_value,
'Credit for unused time on '. $self->part_pkg->pkg,
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
return '' if $date; #no errors
- my $conf = new FS::Conf;
my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
- my $conf = new FS::Conf;
- my $error = send_email(
- 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
- 'to' => \@invoicing_list,
- 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
- 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
- );
+ my $msgnum = $conf->config('cancel_msgnum', $self->cust_main->agentnum);
+ my $error = '';
+ if ( $msgnum ) {
+ my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
+ $error = $msg_template->send( 'cust_main' => $self->cust_main,
+ 'object' => $self );
+ }
+ else {
+ $error = send_email(
+ 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
+ 'to' => \@invoicing_list,
+ 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
+ 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
+ );
+ }
#should this do something on errors?
}
}
#reset usage if changing pkgpart
+ # AND usage rollover is off (otherwise adds twice, now and at package bill)
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 $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover');
if ($error) {
$dbh->rollback if $oldAutoCommit;
#Good to go, cancel old package.
$error = $self->cancel( quiet=>1 );
if ($error) {
- $dbh->rollback;
+ $dbh->rollback if $oldAutoCommit;
return $error;
}
+ if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
+ #$self->cust_main
+ my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
$cust_pkg;
}
sub _sort_cust_svc {
my( $self, $arrayref ) = @_;
+ my $sort =
+ sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] };
+
map { $_->[0] }
- sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
+ sort $sort
map {
my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
'svcpart' => $_->svcpart } );
#seems to benchmark slightly faster...
qsearch( {
- 'select' => 'DISTINCT ON (svcpart) part_svc.*',
+ #'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
return 'active';
}
+=item ucfirst_status
+
+Returns the status with the first character capitalized.
+
+=cut
+
+sub ucfirst_status {
+ ucfirst(shift->status);
+}
+
=item statuses
Class method that returns the list of possible status strings for packages
$statuscolor{$self->status};
}
+=item pkg_label
+
+Returns a label for this package. (Currently "pkgnum: pkg - comment" or
+"pkg-comment" depending on user preference).
+
+=cut
+
+sub pkg_label {
+ my $self = shift;
+ my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
+ $label = $self->pkgnum. ": $label"
+ if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
+ $label;
+}
+
+=item pkg_label_long
+
+Returns a long label for this package, adding the primary service's label to
+pkg_label.
+
+=cut
+
+sub pkg_label_long {
+ my $self = shift;
+ my $label = $self->pkg_label;
+ my $cust_svc = $self->primary_cust_svc;
+ $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
+ $label;
+}
+
+=item primary_cust_svc
+
+Returns a primary service (as FS::cust_svc object) if one can be identified.
+
+=cut
+
+#for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
+
+sub primary_cust_svc {
+ my $self = shift;
+
+ my @cust_svc = $self->cust_svc;
+
+ return '' unless @cust_svc; #no serivces - irrelevant then
+
+ return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
+
+ # primary service as specified in the package definition
+ # or exactly one service definition with quantity one
+ my $svcpart = $self->part_pkg->svcpart;
+ @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
+ return $cust_svc[0] if scalar(@cust_svc) == 1;
+
+ #couldn't identify one thing..
+ return '';
+}
+
=item labels
Returns a list of lists, calling the label method for all services
map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
}
+=item labels_short
+
+Like 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 labels_short {
+ shift->_labels_short( 'labels', @_ );
+}
+
=item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
Like h_labels, except returns a simple flat list, and shortens long
=cut
sub h_labels_short {
- my $self = shift;
+ shift->_labels_short( 'h_labels', @_ );
+}
+
+sub _labels_short {
+ my( $self, $method ) = ( shift, 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(@_);
+ foreach $self->$method(@_);
my @labels;
foreach my $label ( keys %labels ) {
my %seen = ();
if ( $num > $max_same_services ) {
push @labels, "$label ($num)";
} else {
- push @labels, map { "$label: $_" } @values;
+ if ( $conf->exists('cust_bill-consolidate_services') ) {
+ # push @labels, "$label: ". join(', ', @values);
+ while ( @values ) {
+ my $detail = "$label: ";
+ $detail .= shift(@values). ', '
+ while @values && length($detail.$values[0]) < 78;
+ $detail =~ s/, $//;
+ push @labels, $detail;
+ }
+ } else {
+ push @labels, map { "$label: $_" } @values;
+ }
}
}
qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
}
+#these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
+
=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>).
+=item location_label [ OPTION => VALUE ... ]
+
+Returns the label of the location object (see L<FS::cust_location>).
+
=cut
-sub cust_location_or_main {
- my $self = shift;
- $self->cust_location || $self->cust_main;
-}
+#end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
=item seconds_since TIMESTAMP
}
+=item insert_reason
+
+Associates this package with a (suspension or cancellation) reason (see
+L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
+L<FS::reason>).
+
+Available options are:
+
+=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_otaker
+
+the access_user (see L<FS::access_user>) providing the reason
+
+=item date
+
+a unix timestamp
+
+=item action
+
+the action (cancel, susp, adjourn, expire) associated with the reason
+
+=back
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub insert_reason {
+ my ($self, %options) = @_;
+
+ my $otaker = $options{reason_otaker} ||
+ $FS::CurrentUser::CurrentUser->username;
+
+ my $reasonnum;
+ if ( $options{'reason'} =~ /^(\d+)$/ ) {
+
+ $reasonnum = $1;
+
+ } elsif ( ref($options{'reason'}) ) {
+
+ return 'Enter a new reason (or select an existing one)'
+ unless $options{'reason'}->{'reason'} !~ /^\s*$/;
+
+ my $reason = new FS::reason({
+ 'reason_type' => $options{'reason'}->{'typenum'},
+ 'reason' => $options{'reason'}->{'reason'},
+ });
+ my $error = $reason->insert;
+ return $error if $error;
+
+ $reasonnum = $reason->reasonnum;
+
+ } else {
+ return "Unparsable reason: ". $options{'reason'};
+ }
+
+ my $cust_pkg_reason =
+ new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
+ 'reasonnum' => $reasonnum,
+ 'otaker' => $otaker,
+ 'action' => substr(uc($options{'action'}),0,1),
+ 'date' => $options{'date'}
+ ? $options{'date'}
+ : time,
+ });
+
+ $cust_pkg_reason->insert;
+}
+
+=item insert_discount
+
+Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
+inserting a new discount on the fly (see L<FS::discount>).
+
+Available options are:
+
+=over 4
+
+=item discountnum
+
+=back
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub insert_discount {
+ #my ($self, %options) = @_;
+ my $self = shift;
+
+ my $cust_pkg_discount = new FS::cust_pkg_discount {
+ 'pkgnum' => $self->pkgnum,
+ 'discountnum' => $self->discountnum,
+ 'months_used' => 0,
+ 'end_date' => '', #XXX
+ 'otaker' => $self->otaker,
+ #for the create a new discount case
+ '_type' => $self->discountnum__type,
+ 'amount' => $self->discountnum_amount,
+ 'percent' => $self->discountnum_percent,
+ 'months' => $self->discountnum_months,
+ #'disabled' => $self->discountnum_disabled,
+ };
+
+ $cust_pkg_discount->insert;
+}
+
+=item set_usage USAGE_VALUE_HASHREF
+
+USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
+to which they should be set (see L<FS::svc_acct>). Currently seconds,
+upbytes, downbytes, and totalbytes are appropriate keys.
+
+All svc_accts which are part of this package have their values reset.
+
+=cut
+
+sub set_usage {
+ my ($self, $valueref, %opt) = @_;
+
+ foreach my $cust_svc ($self->cust_svc){
+ my $svc_x = $cust_svc->svc_x;
+ $svc_x->set_usage($valueref, %opt)
+ if $svc_x->can("set_usage");
+ }
+}
+
+=item recharge USAGE_VALUE_HASHREF
+
+USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
+to which they should be set (see L<FS::svc_acct>). Currently seconds,
+upbytes, downbytes, and totalbytes are appropriate keys.
+
+All svc_accts which are part of this package have their values incremented.
+
+=cut
+
+sub recharge {
+ my ($self, $valueref) = @_;
+
+ foreach my $cust_svc ($self->cust_svc){
+ my $svc_x = $cust_svc->svc_x;
+ $svc_x->recharge($valueref)
+ if $svc_x->can("recharge");
+ }
+}
+
+=item cust_pkg_discount
+
+=cut
+
+sub cust_pkg_discount {
+ my $self = shift;
+ qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } );
+}
+
+=item cust_pkg_discount_active
+
+=cut
+
+sub cust_pkg_discount_active {
+ my $self = shift;
+ grep { $_->status eq 'active' } $self->cust_pkg_discount;
+}
+
=back
=head1 CLASS METHODS
where cust_pkg.pkgpart = part_pkg.pkgpart )
"; }
+=item ordered_sql
+
+Returns an SQL expression identifying ordered packages (recurring packages not
+yet billed).
+
+=cut
+
+sub ordered_sql {
+ $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql;
+}
+
=item active_sql
Returns an SQL expression identifying active packages.
=cut
-sub active_sql { "
- ". $_[0]->recurring_sql(). "
+sub active_sql {
+ $_[0]->recurring_sql. "
+ AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
"; }
"cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
}
-=item search_sql HASHREF
+=item search HASHREF
(Class method)
=item pkgpart
-list specified how?
+pkgpart or arrayref or hashref of pkgparts
=item setup
specifies the user for agent virtualization
+=item fcc_line
+
+ boolean selects packages containing fcc form 477 telco lines
+
=back
=cut
-sub search_sql {
+sub search {
my ($class, $params) = @_;
my @where = ();
}
##
+ # parse custnum
+ ##
+
+ if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
+ push @where,
+ "cust_pkg.custnum = $1";
+ }
+
+ ##
+ # custbatch
+ ##
+
+ if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
+ push @where,
+ "cust_pkg.pkgbatch = '$1'";
+ }
+
+ ##
# parse status
##
push @where, FS::cust_pkg->active_sql();
- } elsif ( $params->{'magic'} eq 'not yet billed'
- || $params->{'status'} eq 'not yet billed' ) {
+ } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/
+ || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
push @where, FS::cust_pkg->not_yet_billed_sql();
{
$classnum = $1;
if ( $classnum ) { #a specific class
- push @where, "classnum = $classnum";
+ push @where, "part_pkg.classnum = $classnum";
#@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
#die "classnum $classnum not found!" unless $pkg_class[0];
} elsif ( $classnum eq '' ) { #the empty class
- push @where, "classnum IS NULL";
+ push @where, "part_pkg.classnum IS NULL";
#$title .= 'Empty class ';
#@pkg_class = ( '(empty class)' );
} elsif ( $classnum eq '0' ) {
#eslaf
###
+ # parse package report options
+ ###
+
+ my @report_option = ();
+ if ( exists($params->{'report_option'})
+ && $params->{'report_option'} =~ /^([,\d]*)$/
+ )
+ {
+ @report_option = split(',', $1);
+ }
+
+ if (@report_option) {
+ # this will result in the empty set for the dangling comma case as it should
+ push @where,
+ 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;
+ }
+
+ #eslaf
+
+ ###
# parse custom
###
push @where, "part_pkg.custom = 'Y'" if $params->{custom};
###
+ # parse fcc_line
+ ###
+
+ push @where, "part_pkg.fcc_ds0s > 0" if $params->{fcc_line};
+
+ ###
+ # parse censustract
+ ###
+
+ if ( exists($params->{'censustract'}) ) {
+ $params->{'censustract'} =~ /^([.\d]*)$/;
+ my $censustract = "cust_main.censustract = '$1'";
+ $censustract .= ' OR cust_main.censustract is NULL' unless $1;
+ push @where, "( $censustract )";
+ }
+
+ ###
# parse part_pkg
###
- my $pkgpart = join (' OR pkgpart=',
- grep {$_} map { /^(\d+)$/; } ($params->{'pkgpart'}));
- push @where, '(pkgpart=' . $pkgpart . ')' if $pkgpart;
+ if ( ref($params->{'pkgpart'}) ) {
+
+ my @pkgpart = ();
+ if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
+ @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
+ } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
+ @pkgpart = @{ $params->{'pkgpart'} };
+ } else {
+ die 'unhandled pkgpart ref '. $params->{'pkgpart'};
+ }
+
+ @pkgpart = grep /^(\d+)$/, @pkgpart;
+
+ push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
+
+ } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
+ push @where, "pkgpart = $1";
+ }
###
# parse dates
'' => {},
);
- foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
+ if( exists($params->{'active'} ) ) {
+ # This overrides all the other date-related fields
+ my($beginning, $ending) = @{$params->{'active'}};
+ push @where,
+ "cust_pkg.setup IS NOT NULL",
+ "cust_pkg.setup <= $ending",
+ "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
+ "NOT (".FS::cust_pkg->onetime_sql . ")";
+ }
+ else {
+ foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
- next unless exists($params->{$field});
+ next unless exists($params->{$field});
- my($beginning, $ending) = @{$params->{$field}};
+ my($beginning, $ending) = @{$params->{$field}};
- next if $beginning == 0 && $ending == 4294967295;
+ next if $beginning == 0 && $ending == 4294967295;
- push @where,
- "cust_pkg.$field IS NOT NULL",
- "cust_pkg.$field >= $beginning",
- "cust_pkg.$field <= $ending";
+ push @where,
+ "cust_pkg.$field IS NOT NULL",
+ "cust_pkg.$field >= $beginning",
+ "cust_pkg.$field <= $ending";
- $orderby ||= "ORDER BY cust_pkg.$field";
+ $orderby ||= "ORDER BY cust_pkg.$field";
+ }
}
$orderby ||= 'ORDER BY bill';
if ($access_user) {
push @where, $access_user->agentnums_sql('table'=>'cust_main');
- }else{
+ } else {
push @where, "1=0";
}
- }else{
+ } else {
push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
}
my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
'LEFT JOIN part_pkg USING ( pkgpart ) '.
- 'LEFT JOIN pkg_class USING ( classnum ) ';
+ 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) ';
my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
'cust_pkg.*',
( map "part_pkg.$_", qw( pkg freq ) ),
'pkg_class.classname',
- 'cust_main.custnum as cust_main_custnum',
+ 'cust_main.custnum AS cust_main_custnum',
FS::UI::Web::cust_sql_fields(
$params->{'cust_fields'}
),
}
+=item fcc_477_count
+
+Returns a list of two package counts. The first is a count of packages
+based on the supplied criteria and the second is the count of residential
+packages with those same criteria. Criteria are specified as in the search
+method.
+
+=cut
+
+sub fcc_477_count {
+ my ($class, $params) = @_;
+
+ my $sql_query = $class->search( $params );
+
+ my $count_sql = delete($sql_query->{'count_query'});
+ $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/
+ or die "couldn't parse count_sql";
+
+ my $count_sth = dbh->prepare($count_sql)
+ or die "Error preparing $count_sql: ". dbh->errstr;
+ $count_sth->execute
+ or die "Error executing $count_sql: ". $count_sth->errstr;
+ my $count_arrayref = $count_sth->fetchrow_arrayref;
+
+ return ( @$count_arrayref );
+
+}
+
+
=item location_sql
Returns a list: the first item is an SQL fragment identifying matching
my $conf = new FS::Conf;
# '?' placeholders in _location_sql_where
- my @bill_param;
- if ( $ornull ) {
- @bill_param = qw( county county state state state country );
- } else {
- @bill_param = qw( county state state country );
- }
- unshift @bill_param, 'county'; # unless $nec;
+ my $x = $ornull ? 3 : 2;
+ my @bill_param = ( ('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 ) ";
+# ( $table.${prefix}city = ? $or_empty_city $ornull )
"
- ( $table.${prefix}county = ? $or_empty_county $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 = ?
";
# my $cust_main = qsearchs('cust_main', { custnum => $custnum });
# return "Customer not found: $custnum" unless $cust_main;
+ warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
+ if $DEBUG;
+
my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
@$remove_pkgnum;
my %hash = ();
if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
+ warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
+ " to pkgpart ". $pkgparts->[0]. "\n"
+ if $DEBUG;
+
my $err_or_cust_pkg =
$old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
'refnum' => $refnum,
}
push @$return_cust_pkg, $err_or_cust_pkg;
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
return '';
}
# Create the new packages.
foreach my $pkgpart (@$pkgparts) {
+
+ warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
+
my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
pkgpart => $pkgpart,
refnum => $refnum,
# Transfer services and cancel old packages.
foreach my $old_pkg (@old_cust_pkg) {
+ warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
+ if $DEBUG;
+
foreach my $new_pkg (@$return_cust_pkg) {
$error = $old_pkg->transfer($new_pkg);
if ($error and $error == 0) {
'';
}
-=item insert_reason
-
-Associates this package with a (suspension or cancellation) reason (see
-L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
-L<FS::reason>).
-
-Available options are:
-
-=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_otaker
-
-the access_user (see L<FS::access_user>) providing the reason
-
-=item date
-
-a unix timestamp
-
-=item action
-
-the action (cancel, susp, adjourn, expire) associated with the reason
-
-=back
-
-If there is an error, returns the error, otherwise returns false.
-
-=cut
-
-sub insert_reason {
- my ($self, %options) = @_;
-
- my $otaker = $options{reason_otaker} ||
- $FS::CurrentUser::CurrentUser->username;
-
- my $reasonnum;
- if ( $options{'reason'} =~ /^(\d+)$/ ) {
-
- $reasonnum = $1;
-
- } elsif ( ref($options{'reason'}) ) {
-
- return 'Enter a new reason (or select an existing one)'
- unless $options{'reason'}->{'reason'} !~ /^\s*$/;
-
- my $reason = new FS::reason({
- 'reason_type' => $options{'reason'}->{'typenum'},
- 'reason' => $options{'reason'}->{'reason'},
- });
- my $error = $reason->insert;
- return $error if $error;
-
- $reasonnum = $reason->reasonnum;
-
- } else {
- return "Unparsable reason: ". $options{'reason'};
- }
-
- my $cust_pkg_reason =
- new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
- 'reasonnum' => $reasonnum,
- 'otaker' => $otaker,
- 'action' => substr(uc($options{'action'}),0,1),
- 'date' => $options{'date'}
- ? $options{'date'}
- : time,
- });
-
- $cust_pkg_reason->insert;
-}
-
-=item set_usage USAGE_VALUE_HASHREF
-
-USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
-to which they should be set (see L<FS::svc_acct>). Currently seconds,
-upbytes, downbytes, and totalbytes are appropriate keys.
-
-All svc_accts which are part of this package have their values reset.
-
-=cut
-
-sub set_usage {
- my ($self, $valueref, %opt) = @_;
-
- foreach my $cust_svc ($self->cust_svc){
- my $svc_x = $cust_svc->svc_x;
- $svc_x->set_usage($valueref, %opt)
- if $svc_x->can("set_usage");
- }
-}
-
-=item recharge USAGE_VALUE_HASHREF
-
-USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
-to which they should be set (see L<FS::svc_acct>). Currently seconds,
-upbytes, downbytes, and totalbytes are appropriate keys.
-
-All svc_accts which are part of this package have their values incremented.
-
-=cut
-
-sub recharge {
- my ($self, $valueref) = @_;
-
- foreach my $cust_svc ($self->cust_svc){
- my $svc_x = $cust_svc->svc_x;
- $svc_x->recharge($valueref)
- if $svc_x->can("recharge");
- }
+# Used by FS::Upgrade to migrate to a new database.
+sub _upgrade_data { # class method
+ my ($class, %opts) = @_;
+ $class->_upgrade_otaker(%opts);
}
=back
projects / freeside.git / blobdiff