X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=a510c52452d016e14d377fd927e7c40e8796ecac;hb=04a69f9d197efee6fa396bd35d04ae553e669978;hp=25985ce1f2bc0972bf9305ae1aaa33efe7b97365;hpb=a661ced3f9f678a645780eaa0b183d2de5f100fa;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 25985ce1f..a510c5245 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -2,9 +2,11 @@ package FS::cust_pkg; use strict; use vars qw(@ISA $disable_agentcheck $DEBUG); +use Carp qw(cluck); use Scalar::Util qw( blessed ); use List::Util qw(max); use Tie::IxHash; +use MIME::Entity; use FS::UID qw( getotaker dbh ); use FS::Misc qw( send_email ); use FS::Record qw( qsearch qsearchs ); @@ -14,7 +16,6 @@ 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; @@ -174,6 +175,10 @@ Previous pkgnum Previous pkgpart +=item change_locationnum + +Previous locationnum + =back Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date @@ -225,6 +230,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 @@ -267,6 +280,29 @@ 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(); + 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', @@ -436,7 +472,7 @@ 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') @@ -476,10 +512,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' ); @@ -620,7 +656,7 @@ sub cancel { if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) { my $conf = new FS::Conf; my $error = send_email( - 'from' => $conf->config('invoice_from'), + 'from' => $conf->config('invoice_from', $self->cust_main->agentnum), 'to' => \@invoicing_list, 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ), 'body' => [ map "$_\n", $conf->config('cancelmessage') ], @@ -803,7 +839,8 @@ sub suspend { if ( $conf->config('suspend_email_admin') ) { my $error = send_email( - 'from' => $conf->config('invoice_from'), #??? well as good as any + 'from' => $conf->config('invoice_from', $self->cust_main->agentnum), + #invoice_from ??? well as good as any 'to' => $conf->config('suspend_email_admin'), 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended', 'body' => [ @@ -926,7 +963,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'} = ''; @@ -1001,6 +1038,163 @@ sub unadjourn { } + +=item change HASHREF | OPTION => VALUE ... + +Changes this package: cancels it and creates a new one, with a different +pkgpart or locationnum or both. All services are transferred to the new +package (no change will be made if this is not possible). + +Options may be passed as a list of key/value pairs or as a hash reference. +Options are: + +=over 4 + +=item locaitonnum + +New locationnum, to change the location for this package. + +=item cust_location + +New FS::cust_location object, to create a new location and assign it +to this package. + +=item pkgpart + +New pkgpart (see L). + +=item refnum + +New refnum (see L). + +=back + +At least one option must be specified (otherwise, what's the point?) + +Returns either the new FS::cust_pkg object or a scalar error. + +For example: + + my $err_or_new_cust_pkg = $old_cust_pkg->change + +=cut + +#some false laziness w/order +sub change { + my $self = shift; + my $opt = ref($_[0]) ? shift : { @_ }; + +# my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_; +# + + my $conf = new FS::Conf; + + # Transactionize this whole mess + 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; + + my $error; + + my %hash = (); + + my $time = time; + + #$hash{$_} = $self->$_() foreach qw( last_bill bill ); + + #$hash{$_} = $self->$_() foreach qw( setup ); + + $hash{'setup'} = $time if $self->setup; + + $hash{'change_date'} = $time; + $hash{"change_$_"} = $self->$_() + foreach qw( pkgnum pkgpart locationnum ); + + if ( $opt->{'cust_location'} && + ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) { + $error = $opt->{'cust_location'}->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_location (transaction rolled back): $error"; + } + $opt->{'locationnum'} = $opt->{'cust_location'}->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 ), + %hash, + }; + + $error = $cust_pkg->insert( 'change' => 1 ); + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + # Transfer services and cancel old package. + + $error = $self->transfer($cust_pkg); + if ($error and $error == 0) { + # $old_pkg->transfer failed. + $dbh->rollback if $oldAutoCommit; + return $error; + } + + if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) { + warn "trying transfer again with change_svcpart option\n" if $DEBUG; + $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 ); + if ($error and $error == 0) { + # $old_pkg->transfer failed. + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + if ($error > 0) { + # Transfers were successful, but we still had services left on the old + # package. We can't change the package under this circumstances, so abort. + $dbh->rollback if $oldAutoCommit; + return "Unable to transfer all services from package ". $self->pkgnum; + } + + #reset usage if changing pkgpart + 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 ($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; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + $cust_pkg; + +} + =item last_bill Returns the last bill date, or if there is no last bill date, the setup date. @@ -1061,10 +1255,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 @@ -1254,11 +1447,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 { @@ -1279,7 +1476,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 ] @@ -1328,9 +1526,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]; } @@ -1387,7 +1595,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; @@ -1397,7 +1606,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; @@ -1419,20 +1629,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'] ], } ); } @@ -1487,8 +1715,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; } @@ -1891,6 +2119,18 @@ sub active_sql { " 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 ) +"; } + =item inactive_sql Returns an SQL expression identifying inactive packages (one-time packages @@ -1900,6 +2140,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 ) "; } @@ -1952,6 +2193,10 @@ 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 @@ -2024,8 +2269,13 @@ sub search_sql { push @where, FS::cust_pkg->active_sql(); - } elsif ( $params->{'magic'} eq 'inactive' - || $params->{'status'} eq 'inactive' ) { + } elsif ( $params->{'magic'} eq 'not yet billed' + || $params->{'status'} eq '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(); @@ -2039,10 +2289,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(); - } ### @@ -2079,6 +2325,12 @@ sub search_sql { #eslaf ### + # parse custom + ### + + push @where, "part_pkg.custom = 'Y'" if $params->{custom}; + + ### # parse part_pkg ### @@ -2199,6 +2451,97 @@ 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 @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 $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_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) "; + my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) "; + + " + ( $table.${prefix}county = ? $or_empty_county $ornull ) + AND ( $table.${prefix}state = ? $or_empty_state $ornull ) + AND $table.${prefix}country = ? + "; +} + =head1 SUBROUTINES =over 4 @@ -2246,8 +2589,8 @@ sub order { my $dbh = dbh; my $error; - my $cust_main = qsearchs('cust_main', { custnum => $custnum }); - return "Customer not found: $custnum" unless $cust_main; +# my $cust_main = qsearchs('cust_main', { custnum => $custnum }); +# return "Customer not found: $custnum" unless $cust_main; my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) } @$remove_pkgnum; @@ -2257,15 +2600,19 @@ sub order { my %hash = (); if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) { - my $time = time; + my $err_or_cust_pkg = + $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0], + 'refnum' => $refnum, + ); - #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill ); - - #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( setup ); - $hash{'setup'} = $time if $old_cust_pkg[0]->setup; + unless (ref($err_or_cust_pkg)) { + $dbh->rollback if $oldAutoCommit; + return $err_or_cust_pkg; + } + + push @$return_cust_pkg, $err_or_cust_pkg; + return ''; - $hash{'change_date'} = $time; - $hash{"change_$_"} = $old_cust_pkg[0]->$_() foreach qw( pkgnum pkgpart ); } # Create the new packages. @@ -2328,8 +2675,10 @@ sub order { =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] +A bulk change method to change packages for multiple customers. + PKGPARTS is a list of pkgparts specifying the the billing item definitions (see -L) to order for this customer. Duplicates are of course +L) to order for each customer. Duplicates are of course permitted. REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to @@ -2469,11 +2818,11 @@ All svc_accts which are part of this package have their values reset. =cut sub set_usage { - my ($self, $valueref) = @_; + my ($self, $valueref, %opt) = @_; foreach my $cust_svc ($self->cust_svc){ my $svc_x = $cust_svc->svc_x; - $svc_x->set_usage($valueref) + $svc_x->set_usage($valueref, %opt) if $svc_x->can("set_usage"); } }