X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=b851ac7188fc0d9f22100ec9b258122397f72602;hb=7b125e587a4d1ee0aca692e23ea7897f671855ae;hp=29f699f5c842140731fbd85f4d985c18cd7c3fe2;hpb=8fda124d646333848b311c99263813c7d2466592;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 29f699f5c..b851ac718 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,17 +1,18 @@ package FS::cust_pkg; use strict; -use vars qw(@ISA $disable_agentcheck $DEBUG); +use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::location_Mixin + FS::m2m_Common FS::option_Common FS::Record ); +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::cust_svc; use FS::part_pkg; use FS::cust_main; @@ -25,6 +26,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, @@ -38,9 +41,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; @@ -154,9 +156,9 @@ date date -=item otaker +=item usernum -order taker (assigned automatically if null, see L) +order taker (see L) =item manual_flag @@ -249,6 +251,26 @@ 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) ); + } + + 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'; @@ -273,6 +295,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; @@ -285,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); @@ -390,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!" @@ -490,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; @@ -529,8 +564,6 @@ sub check { } $self->otaker(getotaker) unless $self->otaker; - $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker"; - $self->otaker($1); if ( $self->dbdef_table->column('manual_flag') ) { $self->manual_flag('') if $self->manual_flag eq ' '; @@ -1534,8 +1567,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 } ); @@ -1679,7 +1715,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 @@ -1921,41 +1959,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_short +=item location_label [ OPTION => VALUE ... ] -Returns the short label of the location object (see L). +Returns the label of the location object (see L). =cut -sub location_label_short { - my $self = shift; - my $object = $self->cust_location_or_main; - $object->location_label_short; -} +#end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin =item seconds_since TIMESTAMP @@ -2207,6 +2228,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 @@ -2372,6 +2563,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 @@ -2493,6 +2688,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 ### @@ -2542,21 +2743,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 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'; @@ -2627,7 +2839,7 @@ sub search { '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'} ), @@ -2639,6 +2851,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 @@ -2778,6 +3019,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; @@ -2786,6 +3030,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, @@ -2797,12 +3045,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, @@ -2821,6 +3073,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) { @@ -2919,118 +3174,10 @@ 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, %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"); - } +# Used by FS::Upgrade to migrate to a new database. +sub _upgrade_data { # class method + my ($class, %opts) = @_; + $class->_upgrade_otaker(%opts); } =back