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';
my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
- 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?
}
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
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 = ();
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
specifies the user for agent virtualization
+=item fcc_line
+
+ boolean selects packages containing fcc form 477 telco lines
+
=back
=cut
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
###
'' => {},
);
- 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';
}
+=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) {
projects / freeside.git / blobdiff