X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fpart_pkg.pm;h=420ffcb3d9276cefad984c500844ceba821fc319;hp=d84b9c5b714d1b6c955e6f889e49945171326e75;hb=0e8861ca6b3b04b99ea9477e8c1555561b21c929;hpb=a6d3e4dc73803cffad96fd4b6270b2fb5f4b0568 diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index d84b9c5b7..420ffcb3d 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -2,8 +2,11 @@ package FS::part_pkg; use strict; use vars qw( @ISA ); -use FS::Record qw( qsearch ); +use FS::Record qw( qsearch qsearchs dbh ); use FS::pkg_svc; +use FS::agent_type; +use FS::type_pkgs; +use FS::Conf; @ISA = qw( FS::Record ); @@ -52,10 +55,18 @@ inherits from FS::Record. The following fields are currently supported: =item recur - Recurring fee expression +=item setuptax - Setup fee tax exempt flag, empty or `Y' + +=item recurtax - Recurring fee tax exempt flag, empty or `Y' + +=item taxclass - Tax class flag + =item plan - Price plan =item plandata - Price plan data +=item disabled - Disabled flag, empty or `Y' + =back setup and recur are evaluated as Safe perl expressions. You can use numbers @@ -99,6 +110,49 @@ sub clone { Adds this billing item definition to the database. If there is an error, returns the error, otherwise returns false. +=cut + +sub insert { + my $self = shift; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->SUPER::insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + my $conf = new FS::Conf; + + if ( $conf->exists('agent_defaultpkg') ) { + foreach my $agent_type ( qsearch('agent_type', {} ) ) { + my $type_pkgs = new FS::type_pkgs({ + 'typenum' => $agent_type->typenum, + 'pkgpart' => $self->pkgpart, + }); + my $error = $type_pkgs->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; +} + =item delete Currently unimplemented. @@ -126,15 +180,70 @@ insert and replace methods. sub check { my $self = shift; - $self->ut_numbern('pkgpart') - || $self->ut_text('pkg') - || $self->ut_text('comment') - || $self->ut_anything('setup') - || $self->ut_number('freq') - || $self->ut_anything('recur') - || $self->ut_alphan('plan') - || $self->ut_anything('plandata') - ; + my $conf = new FS::Conf; + if ( $conf->exists('safe-part_pkg') ) { + + my $error = $self->ut_anything('setup') + || $self->ut_anything('recur'); + return $error if $error; + + my $s = $self->setup; + + $s =~ /^\s*\d*\.?\d*\s*$/ + + or $s =~ /^my \$d = \$cust_pkg->bill || \$time; \$d += 86400 \* \s*\d+\s*; \$cust_pkg->bill\(\$d\); \$cust_pkg_mod_flag=1; \s*\d*\.?\d*\s*$/ + + or do { + #log! + return "illegal setup: $s"; + }; + + my $r = $self->recur; + + $r =~ /^\s*\d*\.?\d*\s*$/ + + #or $r =~ /^\$sdate += 86400 \* \s*\d+\s*; \s*\d*\.?\d*\s*$/ + + or $r =~ /^my \$mnow = \$sdate; my \(\$sec,\$min,\$hour,\$mday,\$mon,\$year\) = \(localtime\(\$sdate\) \)\[0,1,2,3,4,5\]; my \$mstart = timelocal\(0,0,0,1,\$mon,\$year\); my \$mend = timelocal\(0,0,0,1, \$mon == 11 \? 0 : \$mon\+1, \$year\+\(\$mon==11\)\); \$sdate = \$mstart; \( \$part_pkg->freq \- 1 \) \* \d*\.?\d* \/ \$part_pkg\-\>freq \+ \d*\.?\d* \/ \$part_pkg\-\>freq \* \(\$mend\-\$mnow\) \/ \(\$mend\-\$mstart\) ;\s*$/ + + or $r =~ /^my \$mnow = \$sdate; my \(\$sec,\$min,\$hour,\$mday,\$mon,\$year\) = \(localtime\(\$sdate\) \)\[0,1,2,3,4,5\]; \$sdate = timelocal\(0,0,0,1,\$mon,\$year\); \s*\d*\.?\d*\s*;\s*$/ + + or $r =~ /^my \$error = \$cust_pkg\->cust_main\->credit\( \s*\d*\.?\d*\s* \* scalar\(\$cust_pkg\->cust_main\->referral_cust_main_ncancelled\(\s*\d+\s*\)\), "commission" \); die \$error if \$error; \s*\d*\.?\d*\s*;\s*$/ + + or $r =~ /^my \$error = \$cust_pkg\->cust_main\->credit\( \s*\d*\.?\d*\s* \* scalar\(\$cust_pkg\->cust_main->referral_cust_pkg\(\s*\d+\s*\)\), "commission" \); die \$error if \$error; \s*\d*\.?\d*\s*;\s*$/ + + or $r =~ /^my \$error = \$cust_pkg\->cust_main\->credit\( \s*\d*\.?\d*\s* \* scalar\( grep \{ my \$pkgpart = \$_\->pkgpart; grep \{ \$_ == \$pkgpart \} \(\s*(\s*\d+,\s*)*\s*\) \} \$cust_pkg\->cust_main->referral_cust_pkg\(\s*\d+\s*\)\), "commission" \); die \$error if \$error; \s*\d*\.?\d*\s*;\s*$/ + + or $r =~ /^my \$hours = \$cust_pkg\->seconds_since\(\$cust_pkg\->bill \|\| 0\) \/ 3600 \- \s*\d*\.?\d*\s*; \$hours = 0 if \$hours < 0; \s*\d*\.?\d*\s* \+ \s*\d*\.?\d*\s* \* \$hours;\s*$/ + + or $r =~ /^my \$min = \$cust_pkg\->seconds_since\(\$cust_pkg\->bill \|\| 0\) \/ 60 \- \s*\d*\.?\d*\s*; \$min = 0 if \$min < 0; \s*\d*\.?\d*\s* \+ \s*\d*\.?\d*\s* \* \$min;\s*$/ + + or do { + #log! + return "illegal recur: $r"; + }; + + } + + if ($self->def_svcpart and my @pkg_svc = $self->pkg_svc) { + unless (grep { $_->svcpart == $self->def_svcpart } @pkg_svc) { + return "no svcparts for this package match def_svcpart ".$self->def_svcpart; + } + } + + $self->ut_numbern('pkgpart') + || $self->ut_text('pkg') + || $self->ut_text('comment') + || $self->ut_anything('setup') + || $self->ut_number('freq') + || $self->ut_anything('recur') + || $self->ut_alphan('plan') + || $self->ut_anything('plandata') + || $self->ut_enum('setuptax', [ '', 'Y' ] ) + || $self->ut_enum('recurtax', [ '', 'Y' ] ) + || $self->ut_textn('taxclass') + || $self->ut_enum('disabled', [ '', 'Y' ] ) + ; } =item pkg_svc @@ -156,11 +265,23 @@ associated with this billing item definition (see L). Returns false if there not exactly one service definition with quantity 1, or if SVCDB is specified and does not match the svcdb of the service definition, +If the part_pkg has a nonzero def_svcpart, it takes precedence, even if it has +quantity > 1 and/or there are other service definitions, UNLESS SVCDB is specified +and doesn't match the svcdb of the def_svcpart. + =cut sub svcpart { my $self = shift; my $svcdb = shift; + + if ($self->def_svcpart) { + if ((not $svcdb) or qsearchs('part_svc', { svcpart => $self->def_svcpart, + svcdb => $svcdb })) { + return $self->def_svcpart; + } + } + my @pkg_svc = $self->pkg_svc; return '' if scalar(@pkg_svc) != 1 || $pkg_svc[0]->quantity != 1 @@ -168,11 +289,33 @@ sub svcpart { $pkg_svc[0]->svcpart; } +=item payby + +Returns a list of the acceptable payment types for this package. Eventually +this should come out of a database table and be editable, but currently has the +following logic instead; + +If the package has B<0> setup and B<0> recur, the single item B is +returned, otherwise, the single item B is returned. + +=cut + +sub payby { + my $self = shift; + #if ( $self->setup == 0 && $self->recur == 0 ) { + if ( $self->setup =~ /^\s*0+(\.0*)?\s*$/ + && $self->recur =~ /^\s*0+(\.0*)?\s*$/ ) { + ( 'BILL' ); + } else { + ( 'CARD' ); + } +} + =back =head1 VERSION -$Id: part_pkg.pm,v 1.3 2001-10-15 10:42:28 ivan Exp $ +$Id: part_pkg.pm,v 1.15 2002-06-08 07:48:36 khoff Exp $ =head1 BUGS