X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=9b023fda7af70a410220f415e91c2d3a99d1ff0f;hp=5cdca09ac8587cbbc1751f3be90f899bcf613cf1;hb=f839709351aee1f9488e9a26496adc564aa5b8e5;hpb=2d5f9e43a60773a9b079e96c330cb9e0e089800a diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 5cdca09ac..9b023fda7 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,17 +1,19 @@ package FS::cust_pkg; use strict; -use vars qw(@ISA $disable_agentcheck $DEBUG $me); +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::CurrentUser; use FS::cust_svc; use FS::part_pkg; use FS::cust_main; @@ -40,8 +42,6 @@ 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]'; @@ -153,13 +153,17 @@ date date +=item contract_end + +date + =item cancel date -=item otaker +=item usernum -order taker (assigned automatically if null, see L) +order taker (see L) =item manual_flag @@ -252,6 +256,21 @@ an optional queue name for ticket additions 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) ); + } + + foreach my $action ( qw(expire adjourn contract_end) ) { + my $months = $self->part_pkg->option("${action}_months",1); + if($months and !$self->$action) { + my $start = $self->start_date || $self->setup || time; + $self->$action( $self->part_pkg->add_freq($start, $months) ); + } + } + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -277,15 +296,7 @@ sub insert { ); if ( $self->discountnum ) { - #XXX new/custom discount case - my $cust_pkg_discount = new FS::cust_pkg_discount { - 'pkgnum' => $self->pkgnum, - 'discountnum' => $self->discountnum, - 'months_used' => 0, - 'end_date' => '', #XXX - 'otaker' => $self->otaker, - }; - my $error = $cust_pkg_discount->insert; + my $error = $self->insert_discount(); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -304,14 +315,18 @@ 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(); + + #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); @@ -409,7 +424,7 @@ sub replace { : { @_ }; #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!" @@ -509,6 +524,7 @@ sub check { || $self->ut_numbern('cancel') || $self->ut_numbern('adjourn') || $self->ut_numbern('expire') + || $self->ut_enum('no_auto', [ '', 'Y' ]) ; return $error if $error; @@ -547,9 +563,7 @@ sub check { } - $self->otaker(getotaker) unless $self->otaker; - $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker"; - $self->otaker($1); + $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum; if ( $self->dbdef_table->column('manual_flag') ) { $self->manual_flag('') if $self->manual_flag eq ' '; @@ -694,12 +708,21 @@ sub cancel { 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? } @@ -1000,10 +1023,16 @@ sub unsuspend { my $conf = new FS::Conf; - $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive - if ( $opt{'adjust_next_bill'} - || $conf->exists('unsuspend-always_adjust_next_bill_date') ) - && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} ); + if ( $inactive > 0 && + ( $hash{'bill'} || $hash{'setup'} ) && + ( $opt{'adjust_next_bill'} || + $conf->exists('unsuspend-always_adjust_next_bill_date') || + $self->part_pkg->option('unsuspend_adjust_bill', 1) ) + ) { + + $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive; + + } $hash{'susp'} = ''; $hash{'adjourn'} = '' if $hash{'adjourn'} < time; @@ -1346,6 +1375,18 @@ sub calc_recur { $self->part_pkg->calc_recur($self, @_); } +=item base_recur + +Calls the I of the FS::part_pkg object associated with this billing +item. + +=cut + +sub base_recur { + my $self = shift; + $self->part_pkg->base_recur($self, @_); +} + =item calc_remain Calls the I of the FS::part_pkg object associated with this @@ -1701,7 +1742,9 @@ sub extra_part_svc { #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 @@ -1749,6 +1792,16 @@ sub status { 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 @@ -1904,7 +1957,7 @@ sub _labels_short { 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 = (); @@ -1943,41 +1996,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). -=cut - -sub cust_location_or_main { - my $self = shift; - $self->cust_location || $self->cust_main; -} - =item location_label [ OPTION => VALUE ... ] Returns the label of the location object (see L). =cut -sub location_label { - my $self = shift; - my $object = $self->cust_location_or_main; - $object->location_label(@_); -} +#end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin =item seconds_since TIMESTAMP @@ -2303,6 +2339,44 @@ sub insert_reason { $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 @@ -2358,10 +2432,7 @@ sub cust_pkg_discount { sub cust_pkg_discount_active { my $self = shift; - grep { my $d = $_->discount; - ! $d->months || $_->months_used < $d->months; # XXX also end date - } - $self->cust_pkg_discount; + grep { $_->status eq 'active' } $self->cust_pkg_discount; } =back @@ -2392,14 +2463,25 @@ sub onetime_sql { " 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 ) @@ -2460,6 +2542,22 @@ sub cancel_sql { "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0"; } +=item status_sql + +Returns an SQL expression to give the package status as a string. + +=cut + +sub status_sql { +"CASE + WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled' + WHEN cust_pkg.susp IS NOT NULL THEN 'suspended' + WHEN cust_pkg.setup IS NULL THEN 'not yet billed' + WHEN ".onetime_sql()." THEN 'one-time charge' + ELSE 'active' +END" +} + =item search HASHREF (Class method) @@ -2529,6 +2627,10 @@ a value suited to passing to FS::UI::Web::cust_header specifies the user for agent virtualization +=item fcc_line + + boolean selects packages containing fcc form 477 telco lines + =back =cut @@ -2556,6 +2658,15 @@ sub search { } ## + # custbatch + ## + + if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) { + push @where, + "cust_pkg.pkgbatch = '$1'"; + } + + ## # parse status ## @@ -2650,6 +2761,12 @@ sub search { 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 ### @@ -2699,21 +2816,32 @@ sub search { '' => {}, ); - 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 contract_end 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'; @@ -2796,6 +2924,35 @@ sub search { } +=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 @@ -3090,6 +3247,12 @@ sub bulk_change { ''; } +# Used by FS::Upgrade to migrate to a new database. +sub _upgrade_data { # class method + my ($class, %opts) = @_; + $class->_upgrade_otaker(%opts); +} + =back =head1 BUGS