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;
# 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;
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';
#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
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
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)
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 = ();
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' ) {
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 ($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 $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
- my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
- 'LEFT JOIN part_pkg USING ( pkgpart ) '.
- 'LEFT JOIN pkg_class USING ( classnum ) ';
+ my $addl_from = 'LEFT JOIN part_pkg USING ( pkgpart ) '.
+ 'LEFT JOIN pkg_class USING ( classnum ) '.
+ 'LEFT JOIN cust_main USING ( custnum ) ';
my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
}
+=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 $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) {