X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=0094135ecf2e86da5b7d46ca949b3bd0aabed832;hp=e2ca871d052ca53a7b3526a956ee150b8b33d751;hb=e078ca418dcf3c7b92efcd371ce761df3314c369;hpb=705f7d564546e7211844773f3566a89f0ae87a2c diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index e2ca871d0..0094135ec 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,20 +1,23 @@ package FS::cust_pkg; use strict; -use vars qw(@ISA $disable_agentcheck $DEBUG); +use base qw( FS::cust_main_Mixin FS::location_Mixin + FS::m2m_Common FS::option_Common FS::Record + ); +use vars qw(@ISA $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::cust_location; -use FS::type_pkgs; use FS::pkg_svc; use FS::cust_bill_pkg; use FS::cust_pkg_detail; @@ -24,6 +27,8 @@ use FS::reg_code; 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, @@ -37,9 +42,8 @@ use FS::svc_forward; # 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; @@ -121,6 +125,10 @@ Billing item definition (see L) Optional link to package location (see L) +=item start_date + +date + =item setup date @@ -229,6 +237,14 @@ If set true, supresses any referral credit to a referring customer. cust_pkg_option records will be created +=item ticket_subject + +a ticket will be added to this customer with this subject + +=item ticket_queue + +an optional queue name for ticket additions + =back =cut @@ -236,6 +252,26 @@ cust_pkg_option records will be created 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'; @@ -260,6 +296,14 @@ sub insert { '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; @@ -271,6 +315,33 @@ sub insert { 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(); + 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); + my $mime = new MIME::Entity; + $mime->build( Type => 'text/plain', Data => $options{ticket_subject} ); + $t->Create( $options{ticket_queue} ? (Queue => $q) : (), + Subject => $options{ticket_subject}, + MIMEObj => $mime, + ); + $t->AddLink( Type => 'MemberOf', + Target => 'freeside://freeside/cust_main/'. $self->custnum, + ); + } + if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) { my $queue = new FS::queue { 'job' => 'FS::cust_main::queueable_print', @@ -440,19 +511,21 @@ replace methods. sub check { my $self = shift; - $self->locationnum('') if $self->locationnum == 0 || $self->locationnum == -1; + $self->locationnum('') if !$self->locationnum || $self->locationnum == -1; my $error = $self->ut_numbern('pkgnum') || $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; @@ -480,10 +553,10 @@ sub check { unless ( $disable_agentcheck ) { my $agent = qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } ); - my $pkgpart_href = $agent->pkgpart_hashref; - return "agent ". $agent->agentnum. + return "agent ". $agent->agentnum. ':'. $agent->agent. " can't purchase pkgpart ". $self->pkgpart - unless $pkgpart_href->{ $self->pkgpart }; + unless $agent->pkgpart_hashref->{ $self->pkgpart } + || $agent->agentnum == $self->part_pkg->agentnum; } $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' ); @@ -523,6 +596,8 @@ Available options are: =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. @@ -533,6 +608,8 @@ sub cancel { 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; @@ -558,6 +635,20 @@ sub cancel { 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'} ) { @@ -593,7 +684,6 @@ sub cancel { # 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, @@ -619,10 +709,8 @@ sub cancel { $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, @@ -931,7 +1019,7 @@ sub unsuspend { $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive if ( $opt{'adjust_next_bill'} - || $conf->config('unsuspend-always_adjust_next_bill_date') ) + || $conf->exists('unsuspend-always_adjust_next_bill_date') ) && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} ); $hash{'susp'} = ''; @@ -1136,14 +1224,40 @@ sub change { return "Unable to transfer all services from package ". $self->pkgnum; } + #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') && ! $part_pkg->option('usage_rollover'); + + if ($error) { + $dbh->rollback if $oldAutoCommit; + return "Error setting usage values: $error"; + } + } + #Good to go, cancel old package. $error = $self->cancel( quiet=>1 ); if ($error) { - $dbh->rollback; + $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; } @@ -1208,10 +1322,9 @@ L). sub part_pkg { my $self = shift; - #exists( $self->{'_pkgpart'} ) - $self->{'_pkgpart'} - ? $self->{'_pkgpart'} - : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); + return $self->{'_pkgpart'} if $self->{'_pkgpart'}; + cluck "cust_pkg->part_pkg called" if $DEBUG > 1; + qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); } =item old_cust_pkg @@ -1401,11 +1514,15 @@ services. sub cust_svc { my $self = shift; + return () unless $self->num_cust_svc(@_); + if ( @_ ) { return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum, 'svcpart' => shift, } ); } + cluck "cust_pkg->cust_svc called" if $DEBUG > 2; + #if ( $self->{'_svcnum'} ) { # values %{ $self->{'_svcnum'}->cache }; #} else { @@ -1426,7 +1543,8 @@ is specified, return only the matching services. sub overlimit { my $self = shift; - grep { $_->overlimit } $self->cust_svc; + return () unless $self->num_cust_svc(@_); + grep { $_->overlimit } $self->cust_svc(@_); } =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] @@ -1452,8 +1570,11 @@ sub h_cust_svc { 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 } ); @@ -1475,9 +1596,19 @@ specified, counts only the matching services. sub num_cust_svc { my $self = shift; + + return $self->{'_num_cust_svc'} + if !scalar(@_) + && exists($self->{'_num_cust_svc'}) + && $self->{'_num_cust_svc'} =~ /\d/; + + cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'} + if $DEBUG > 2; + my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?'; $sql .= ' AND svcpart = ?' if @_; - my $sth = dbh->prepare($sql) or die dbh->errstr; + + my $sth = dbh->prepare($sql) or die dbh->errstr; $sth->execute($self->pkgnum, @_) or die $sth->errstr; $sth->fetchrow_arrayref->[0]; } @@ -1534,7 +1665,8 @@ sub part_svc { $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil $part_svc->{'Hash'}{'num_avail'} = max( 0, $pkg_svc->quantity - $num_cust_svc ); - $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ]; + $part_svc->{'Hash'}{'cust_pkg_svc'} = + $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []; $part_svc; } $self->part_pkg->pkg_svc; @@ -1544,7 +1676,8 @@ sub part_svc { my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart); $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ? - $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ]; + $part_svc->{'Hash'}{'cust_pkg_svc'} = + $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []; $part_svc; } $self->extra_part_svc; @@ -1566,20 +1699,38 @@ sub extra_part_svc { my $pkgnum = $self->pkgnum; my $pkgpart = $self->pkgpart; +# qsearch( { +# 'table' => 'part_svc', +# 'hashref' => {}, +# 'extra_sql' => +# "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc +# WHERE pkg_svc.svcpart = part_svc.svcpart +# AND pkg_svc.pkgpart = ? +# AND quantity > 0 +# ) +# AND 0 < ( SELECT COUNT(*) FROM cust_svc +# LEFT JOIN cust_pkg USING ( pkgnum ) +# WHERE cust_svc.svcpart = part_svc.svcpart +# AND pkgnum = ? +# )", +# 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ], +# } ); + +#seems to benchmark slightly faster... qsearch( { - 'table' => 'part_svc', - 'hashref' => {}, - 'extra_sql' => "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc - WHERE pkg_svc.svcpart = part_svc.svcpart - AND pkg_svc.pkgpart = $pkgpart - AND quantity > 0 - ) - AND 0 < ( SELECT count(*) - FROM cust_svc - LEFT JOIN cust_pkg using ( pkgnum ) - WHERE cust_svc.svcpart = part_svc.svcpart - AND pkgnum = $pkgnum - )", + 'select' => 'DISTINCT ON (svcpart) part_svc.*', + 'table' => 'part_svc', + 'addl_from' => + 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart + AND pkg_svc.pkgpart = ? + AND quantity > 0 + ) + LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart ) + LEFT JOIN cust_pkg USING ( pkgnum ) + ', + 'hashref' => {}, + 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ", + 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ], } ); } @@ -1634,8 +1785,8 @@ tie my %statuscolor, 'Tie::IxHash', sub statuses { my $self = shift; #could be class... - grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway - # mayble split btw one-time vs. recur + #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway + # # mayble split btw one-time vs. recur keys %statuscolor; } @@ -1650,6 +1801,63 @@ sub statuscolor { $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 @@ -1678,6 +1886,19 @@ sub h_labels { 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 @@ -1688,7 +1909,11 @@ individual services rather than individual items. =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; @@ -1705,7 +1930,18 @@ sub h_labels_short { 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; + } } } @@ -1724,29 +1960,24 @@ sub cust_main { 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). -=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), otherwise returns the customer (see L). +=item location_label [ OPTION => VALUE ... ] + +Returns the label of the location object (see L). + =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 @@ -1998,6 +2229,176 @@ sub reexport { } +=item insert_reason + +Associates this package with a (suspension or cancellation) reason (see +L, possibly inserting a new reason on the fly (see +L). + +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_otaker + +the access_user (see L) 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, possibly +inserting a new discount on the fly (see L). + +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). 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). 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 @@ -2034,6 +2435,19 @@ Returns an SQL expression identifying active packages. 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 ) +"; } + +=item not_yet_billed_sql + +Returns an SQL expression identifying packages which have not yet been billed. + +=cut + +sub not_yet_billed_sql { " + ( cust_pkg.setup IS NULL OR 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 ) "; } @@ -2047,6 +2461,7 @@ that are otherwise unsuspended/uncancelled). sub inactive_sql { " ". $_[0]->onetime_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 ) "; } @@ -2080,7 +2495,7 @@ sub cancel_sql { "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0"; } -=item search_sql HASHREF +=item search HASHREF (Class method) @@ -2099,11 +2514,15 @@ active, inactive, suspended, cancel (or cancelled) active, inactive, suspended, one-time charge, inactive, cancel (or cancelled) +=item custom + + boolean selects custom packages + =item classnum =item pkgpart -list specified how? +pkgpart or arrayref or hashref of pkgparts =item setup @@ -2149,7 +2568,7 @@ specifies the user for agent virtualization =cut -sub search_sql { +sub search { my ($class, $params) = @_; my @where = (); @@ -2163,6 +2582,15 @@ sub search_sql { } ## + # parse custnum + ## + + if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) { + push @where, + "cust_pkg.custnum = $1"; + } + + ## # parse status ## @@ -2171,8 +2599,13 @@ sub search_sql { push @where, FS::cust_pkg->active_sql(); - } elsif ( $params->{'magic'} eq 'inactive' - || $params->{'status'} eq 'inactive' ) { + } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/ + || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) { + + push @where, FS::cust_pkg->not_yet_billed_sql(); + + } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/ + || $params->{'status'} =~ /^(one-time charge|inactive)/ ) { push @where, FS::cust_pkg->inactive_sql(); @@ -2186,10 +2619,6 @@ sub search_sql { push @where, FS::cust_pkg->cancelled_sql(); - } elsif ( $params->{'status'} =~ /^(one-time charge|inactive)$/ ) { - - push @where, FS::cust_pkg->inactive_sql(); - } ### @@ -2205,7 +2634,7 @@ sub search_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]; @@ -2213,7 +2642,7 @@ sub search_sql { } 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' ) { @@ -2226,12 +2655,68 @@ sub search_sql { #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 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 @@ -2312,10 +2797,10 @@ sub search_sql { 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'); } @@ -2323,7 +2808,7 @@ sub search_sql { 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"; @@ -2334,7 +2819,7 @@ sub search_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'} ), @@ -2346,6 +2831,95 @@ sub search_sql { } +=item location_sql + +Returns a list: the first item is an SQL fragment identifying matching +packages/customers via location (taking into account shipping and package +address taxation, if enabled), and subsequent items are the parameters to +substitute for the placeholders in that fragment. + +=cut + +sub location_sql { + my($class, %opt) = @_; + my $ornull = $opt{'ornull'}; + + my $conf = new FS::Conf; + + # '?' placeholders in _location_sql_where + my $x = $ornull ? 3 : 2; + my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' ); + + my $main_where; + my @main_param; + if ( $conf->exists('tax-ship_address') ) { + + $main_where = "( + ( ( ship_last IS NULL OR ship_last = '' ) + AND ". _location_sql_where('cust_main', '', $ornull ). " + ) + OR ( ship_last IS NOT NULL AND ship_last != '' + AND ". _location_sql_where('cust_main', 'ship_', $ornull ). " + ) + )"; + # AND payby != 'COMP' + + @main_param = ( @bill_param, @bill_param ); + + } else { + + $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP' + @main_param = @bill_param; + + } + + my $where; + my @param; + if ( $conf->exists('tax-pkg_address') ) { + + my $loc_where = _location_sql_where( 'cust_location', '', $ornull ); + + $where = " ( + ( cust_pkg.locationnum IS NULL AND $main_where ) + OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where ) + ) + "; + @param = ( @main_param, @bill_param ); + + } else { + + $where = $main_where; + @param = @main_param; + + } + + ( $where, @param ); + +} + +#subroutine, helper for location_sql +sub _location_sql_where { + my $table = shift; + my $prefix = @_ ? shift : ''; + my $ornull = @_ ? shift : ''; + +# $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : ''; + + $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}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 = ? + "; +} + =head1 SUBROUTINES =over 4 @@ -2396,6 +2970,9 @@ sub order { # 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; @@ -2404,6 +2981,10 @@ sub order { 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, @@ -2415,12 +2996,16 @@ sub order { } 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, @@ -2439,6 +3024,9 @@ sub order { # 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) { @@ -2537,120 +3125,6 @@ sub bulk_change { ''; } -=item insert_reason - -Associates this package with a (suspension or cancellation) reason (see -L, possibly inserting a new reason on the fly (see -L). - -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_otaker - -the access_user (see L) 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). 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) = @_; - - foreach my $cust_svc ($self->cust_svc){ - my $svc_x = $cust_svc->svc_x; - $svc_x->set_usage($valueref) - 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). 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"); - } -} - =back =head1 BUGS