X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fpart_pkg.pm;h=332bb62be621540f9e43316be237089e018324fa;hb=6787fbfb87bcfd7ddde8c0e1ba125cf7fdaee93f;hp=1dfa1ef03f8958b436fde7f5298ecaf56596eae9;hpb=5226903b423e42e7e8ee135b2b445d362241102a;p=freeside.git diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 1dfa1ef03..332bb62be 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -4,7 +4,7 @@ use strict; use vars qw( @ISA %plans $DEBUG $setup_hack $skip_pkg_svc_hack ); use Carp qw(carp cluck confess); use Scalar::Util qw( blessed ); -use Time::Local qw( timelocal_nocheck ); +use Time::Local qw( timelocal timelocal_nocheck ); use Tie::IxHash; use FS::Conf; use FS::Record qw( qsearch qsearchs dbh dbdef ); @@ -103,6 +103,11 @@ inherits from FS::Record. The following fields are currently supported: =item fcc_ds0s - Optional DS0 equivalency number for FCC form 477 +=item fcc_voip_class - Which column of FCC form 477 part II.B this package +belongs in. + +=item delay_start - Number of days to delay package start, by default + =back =head1 METHODS @@ -277,19 +282,20 @@ sub insert { } if ( $options{'part_pkg_vendor'} ) { - my($exportnum,$vendor_pkg_id); - my %options_part_pkg_vendor = $options{'part_pkg_vendor'}; - while(($exportnum,$vendor_pkg_id) = each %options_part_pkg_vendor){ - my $ppv = new FS::part_pkg_vendor( { - 'pkgpart' => $self->pkgpart, - 'exportnum' => $exportnum, - 'vendor_pkg_id' => $vendor_pkg_id, - } ); - my $error = $ppv->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error inserting part_pkg_vendor record: $error"; - } + while ( my ($exportnum, $vendor_pkg_id) = + each %{ $options{part_pkg_vendor} } + ) + { + my $ppv = new FS::part_pkg_vendor( { + 'pkgpart' => $self->pkgpart, + 'exportnum' => $exportnum, + 'vendor_pkg_id' => $vendor_pkg_id, + } ); + my $error = $ppv->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error inserting part_pkg_vendor record: $error"; + } } } @@ -456,48 +462,48 @@ sub replace { if ( $options->{'part_pkg_vendor'} ) { my($exportnum,$vendor_pkg_id); while ( ($exportnum,$vendor_pkg_id) - = each %{$options->{'part_pkg_vendor'}} ) { - my $noinsert = 0; - foreach my $part_pkg_vendor ( @part_pkg_vendor ) { - if($exportnum == $part_pkg_vendor->exportnum - && $vendor_pkg_id ne $part_pkg_vendor->vendor_pkg_id) { - $part_pkg_vendor->vendor_pkg_id($vendor_pkg_id); - my $error = $part_pkg_vendor->replace; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error replacing part_pkg_vendor record: $error"; - } - $noinsert = 1; - last; - } - elsif($exportnum == $part_pkg_vendor->exportnum - && $vendor_pkg_id eq $part_pkg_vendor->vendor_pkg_id) { - $noinsert = 1; - last; - } - } - unless ( $noinsert ) { - my $ppv = new FS::part_pkg_vendor( { - 'pkgpart' => $new->pkgpart, - 'exportnum' => $exportnum, - 'vendor_pkg_id' => $vendor_pkg_id, - } ); - my $error = $ppv->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error inserting part_pkg_vendor record: $error"; - } - } - push @current_exportnum, $exportnum; + = each %{$options->{'part_pkg_vendor'}} ) { + my $noinsert = 0; + foreach my $part_pkg_vendor ( @part_pkg_vendor ) { + if($exportnum == $part_pkg_vendor->exportnum + && $vendor_pkg_id ne $part_pkg_vendor->vendor_pkg_id) { + $part_pkg_vendor->vendor_pkg_id($vendor_pkg_id); + my $error = $part_pkg_vendor->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error replacing part_pkg_vendor record: $error"; + } + $noinsert = 1; + last; + } + elsif($exportnum == $part_pkg_vendor->exportnum + && $vendor_pkg_id eq $part_pkg_vendor->vendor_pkg_id) { + $noinsert = 1; + last; + } + } + unless ( $noinsert ) { + my $ppv = new FS::part_pkg_vendor( { + 'pkgpart' => $new->pkgpart, + 'exportnum' => $exportnum, + 'vendor_pkg_id' => $vendor_pkg_id, + } ); + my $error = $ppv->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error inserting part_pkg_vendor record: $error"; + } + } + push @current_exportnum, $exportnum; } } foreach my $part_pkg_vendor ( @part_pkg_vendor ) { unless ( grep($_ eq $part_pkg_vendor->exportnum, @current_exportnum) ) { - my $error = $part_pkg_vendor->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error deleting part_pkg_vendor record: $error"; - } + my $error = $part_pkg_vendor->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error deleting part_pkg_vendor record: $error"; + } } } @@ -552,6 +558,8 @@ sub check { || $self->ut_enum('disabled', [ '', 'Y' ] ) || $self->ut_enum('custom', [ '', 'Y' ] ) || $self->ut_enum('no_auto', [ '', 'Y' ]) + || $self->ut_enum('recur_show_zero', [ '', 'Y' ]) + || $self->ut_enum('setup_show_zero', [ '', 'Y' ]) #|| $self->ut_moneyn('setup_cost') #|| $self->ut_moneyn('recur_cost') || $self->ut_floatn('setup_cost') @@ -570,6 +578,8 @@ sub check { : $self->ut_agentnum_acl('agentnum', \@null_agentnum_right) ) || $self->ut_numbern('fcc_ds0s') + || $self->ut_numbern('fcc_voip_class') + || $self->ut_numbern('delay_start') || $self->SUPER::check ; return $error if $error; @@ -848,10 +858,7 @@ Returns true if this package is free. sub is_free { my $self = shift; - unless ( $self->plan ) { - $self->setup =~ /^\s*0+(\.0*)?\s*$/ - && $self->recur =~ /^\s*0+(\.0*)?\s*$/; - } elsif ( $self->can('is_free_options') ) { + if ( $self->can('is_free_options') ) { not grep { $_ !~ /^\s*0*(\.0*)?\s*$/ } map { $self->option($_) } $self->is_free_options; @@ -862,8 +869,23 @@ sub is_free { } } +# whether the plan allows discounts to be applied to this package sub can_discount { 0; } +# whether the plan allows changing the start date +sub can_start_date { 1; } + +# the delay start date if present +sub delay_start_date { + my $self = shift; + + my $delay = $self->delay_start or return ''; + + my ($mday,$mon,$year) = (localtime(time))[3,4,5]; + timelocal(0,0,0,$mday,$mon,$year) + 86400 * $delay; + +} + sub freqs_href { # moved to FS::Misc to make this accessible to other packages # at initialization @@ -921,6 +943,9 @@ sub add_freq { if ( $freq =~ /^\d+$/ ) { $mon += $freq; until ( $mon < 12 ) { $mon -= 12; $year++; } + + $mday = 28 if $mday > 28 && FS::Conf->new->exists('anniversary-rollback'); + } elsif ( $freq =~ /^(\d+)w$/ ) { my $weeks = $1; $mday += $weeks * 7; @@ -1064,6 +1089,10 @@ sub self_and_bill_linked { shift->_self_and_linked('bill', @_); } +sub self_and_svc_linked { + shift->_self_and_linked('svc', @_); +} + sub _self_and_linked { my( $self, $type, $hidden ) = @_; $hidden ||= ''; @@ -1278,45 +1307,24 @@ sub _rebless { $self; } -#fallbacks that eval the setup and recur fields, for backwards compat - -sub calc_setup { - my $self = shift; - warn 'no price plan class for '. $self->plan. ", eval-ing setup\n"; - $self->_calc_eval('setup', @_); -} - -sub calc_recur { - my $self = shift; - warn 'no price plan class for '. $self->plan. ", eval-ing recur\n"; - $self->_calc_eval('recur', @_); -} - -use vars qw( $sdate @details ); -sub _calc_eval { - #my( $self, $field, $cust_pkg ) = @_; - my( $self, $field, $cust_pkg, $sdateref, $detailsref ) = @_; - *sdate = $sdateref; - *details = $detailsref; - $self->$field() =~ /^(.*)$/ - or die "Illegal $field (pkgpart ". $self->pkgpart. '): '. - $self->$field(). "\n"; - my $prog = $1; - return 0 if $prog =~ /^\s*$/; - my $value = eval $prog; - die $@ if $@; - $value; -} +#fatal fallbacks +sub calc_setup { die 'no calc_setup for '. shift->plan. "\n"; } +sub calc_recur { die 'no calc_recur for '. shift->plan. "\n"; } #fallback that return 0 for old legacy packages with no plan - sub calc_remain { 0; } -sub calc_cancel { 0; } sub calc_units { 0; } +#fallback for everything not based on flat.pm +sub recur_temporality { 'upcoming'; } +sub calc_cancel { 0; } + #fallback for everything except bulk.pm sub hide_svc_detail { 0; } +#fallback for packages that can't/won't summarize usage +sub sum_usage { 0; } + =item recur_cost_permonth CUST_PKG recur_cost divided by freq (only supported for monthly and longer frequencies) @@ -1329,6 +1337,29 @@ sub recur_cost_permonth { sprintf('%.2f', $self->recur_cost / $self->freq ); } +=item cust_bill_pkg_recur CUST_PKG + +Actual recurring charge for the specified customer package from customer's most +recent invoice + +=cut + +sub cust_bill_pkg_recur { + my($self, $cust_pkg) = @_; + my $cust_bill_pkg = qsearchs({ + 'table' => 'cust_bill_pkg', + 'addl_from' => 'LEFT JOIN cust_bill USING ( invnum )', + 'hashref' => { 'pkgnum' => $cust_pkg->pkgnum, + 'recur' => { op=>'>', value=>'0' }, + }, + 'order_by' => 'ORDER BY cust_bill._date DESC, + cust_bill_pkg.sdate DESC + LIMIT 1 + ', + }) or return 0; #die "use cust_bill_pkg_recur credits with once_perinv condition"; + $cust_bill_pkg->recur; +} + =item format OPTION DATA Returns data formatted according to the function 'format' described @@ -1482,6 +1513,117 @@ sub _upgrade_data { # class method die $error if $error; } } + + # migrate use_disposition_taqua and use_disposition to disposition_in + @part_pkg_option = qsearch('part_pkg_option', + { 'optionname' => { op => 'LIKE', + value => 'use_disposition%', + }, + 'optionvalue' => 1, + }); + my %newopts = map { $_->pkgpart => $_ } + qsearch('part_pkg_option', { 'optionname' => 'disposition_in', } ); + foreach my $old_opt (@part_pkg_option) { + my $pkgpart = $old_opt->pkgpart; + my $newval = $old_opt->optionname eq 'use_disposition_taqua' ? '100' + : 'ANSWERED'; + my $error = $old_opt->delete; + die $error if $error; + + if ( exists($newopts{$pkgpart}) ) { + my $opt = $newopts{$pkgpart}; + $opt->optionvalue($opt->optionvalue.",$newval"); + $error = $opt->replace; + die $error if $error; + } else { + my $new_opt = new FS::part_pkg_option { + 'pkgpart' => $pkgpart, + 'optionname' => 'disposition_in', + 'optionvalue' => $newval, + }; + $error = $new_opt->insert; + die $error if $error; + $newopts{$pkgpart} = $new_opt; + } + } + + # set any package with FCC voice lines to the "VoIP with broadband" category + # for backward compatibility + # + # recover from a bad upgrade bug + my $upgrade = 'part_pkg_fcc_voip_class_FIX'; + if (!FS::upgrade_journal->is_done($upgrade)) { + my $bad_upgrade = qsearchs('upgrade_journal', + { upgrade => 'part_pkg_fcc_voip_class' } + ); + if ( $bad_upgrade ) { + my $where = 'WHERE history_date <= '.$bad_upgrade->_date. + ' AND history_date > '.($bad_upgrade->_date - 3600); + my @h_part_pkg_option = map { FS::part_pkg_option->new($_->hashref) } + qsearch({ + 'select' => '*', + 'table' => 'h_part_pkg_option', + 'hashref' => {}, + 'extra_sql' => "$where AND history_action = 'delete'", + 'order_by' => 'ORDER BY history_date ASC', + }); + my @h_pkg_svc = map { FS::pkg_svc->new($_->hashref) } + qsearch({ + 'select' => '*', + 'table' => 'h_pkg_svc', + 'hashref' => {}, + 'extra_sql' => "$where AND history_action = 'replace_old'", + 'order_by' => 'ORDER BY history_date ASC', + }); + my %opt; + foreach my $deleted (@h_part_pkg_option, @h_pkg_svc) { + my $pkgpart ||= $deleted->pkgpart; + $opt{$pkgpart} ||= { + options => {}, + pkg_svc => {}, + primary_svc => '', + hidden_svc => {}, + }; + if ( $deleted->isa('FS::part_pkg_option') ) { + $opt{$pkgpart}{options}{ $deleted->optionname } = $deleted->optionvalue; + } else { # pkg_svc + my $svcpart = $deleted->svcpart; + $opt{$pkgpart}{pkg_svc}{$svcpart} = $deleted->quantity; + $opt{$pkgpart}{hidden_svc}{$svcpart} ||= $deleted->hidden; + $opt{$pkgpart}{primary_svc} = $svcpart if $deleted->primary_svc; + } + } + foreach my $pkgpart (keys %opt) { + my $part_pkg = FS::part_pkg->by_key($pkgpart); + my $error = $part_pkg->replace( $part_pkg->replace_old, $opt{$pkgpart} ); + if ( $error ) { + die "error recovering damaged pkgpart $pkgpart:\n$error\n"; + } + } + } # $bad_upgrade exists + else { # do the original upgrade, but correctly this time + @part_pkg = qsearch('part_pkg', { + fcc_ds0s => { op => '>', value => 0 }, + fcc_voip_class => '' + }); + foreach my $part_pkg (@part_pkg) { + $part_pkg->set(fcc_voip_class => 2); + my @pkg_svc = $part_pkg->pkg_svc; + my %quantity = map {$_->svcpart, $_->quantity} @pkg_svc; + my %hidden = map {$_->svcpart, $_->hidden } @pkg_svc; + my $error = $part_pkg->replace( + $part_pkg->replace_old, + options => { $part_pkg->options }, + pkg_svc => \%quantity, + hidden_svc => \%hidden, + primary_svc => ($part_pkg->svcpart || ''), + ); + die $error if $error; + } + } + FS::upgrade_journal->set_done($upgrade); + } + } =item curuser_pkgs_sql @@ -1594,6 +1736,10 @@ foreach my $name (keys(%info)) { my $parents = $info{$name}->{'inherit_fields'} || []; my (%fields, %field_exists, @fieldorder); foreach my $parent ($name, @$parents) { + if ( !exists($info{$parent}) ) { + warn "$name tried to inherit from nonexistent '$parent'\n"; + next; + } %fields = ( # avoid replacing existing fields %{ $info{$parent}->{'fields'} || {} }, %fields @@ -1603,7 +1749,8 @@ foreach my $name (keys(%info)) { next if $field_exists{$_}; $field_exists{$_} = 1; # allow inheritors to remove inherited fields from the fieldorder - push @fieldorder, $_ if !exists($fields{$_}->{'disabled'}); + push @fieldorder, $_ if !exists($fields{$_}) or + !exists($fields{$_}->{'disabled'}); } } $plans{$name}->{'fields'} = \%fields;