diff options
44 files changed, 1483 insertions, 548 deletions
diff --git a/ANNOUNCE.1.5.0 b/ANNOUNCE.1.5.0 index 8748ffd..d9968dc 100644 --- a/ANNOUNCE.1.5.0 +++ b/ANNOUNCE.1.5.0 @@ -13,3 +13,10 @@ - proper payment receipts (not invoice copies) - expanded reseller interface - RADIUS session viewing +- modular price plans, rewrote package add/edit page +- fixed up tax report - should be correct for all edge cases with named taxes, + tax classes, etc. + +1.5.0pre7: +- historical late notice viewing in web interface + @@ -81,23 +81,23 @@ L<FS::part_export> - External provisioning export class L<FS::part_export_option> - Export option class -L<FS::part_pkg> - Package (billing item) definition class +L<FS::part_pkg> - Package definition class -L<FS::pkg_svc> - Class linking package (billing item) -definitions (see L<FS::part_pkg>) with service definitions -(see L<FS::part_svc>) +L<FS::part_pkg_option> - Package definition option class + +L<FS::pkg_svc> - Class linking package definitions (see L<FS::part_pkg>) with +service definitions (see L<FS::part_svc>) L<FS::agent> - Agent (reseller) class L<FS::agent_type> - Agent type class -L<FS::type_pkgs> - Class linking agent types (see -L<FS::agent_type>) with package (billing item) definitions -(see L<FS::part_pkg>) +L<FS::type_pkgs> - Class linking agent types (see L<FS::agent_type>) with +package definitions (see L<FS::part_pkg>) L<FS::cust_svc> - Service class -L<FS::cust_pkg> - Package (billing item) class +L<FS::cust_pkg> - Customer package class L<FS::cust_main> - Customer class diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index 1ddc62c..9b406d3 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -252,10 +252,11 @@ Returns HTML tag for beginning an (invisible) table. sub itable { my $col = shift; my $cellspacing = shift || 0; + my $width = ( scalar(@_) && shift ) ? '' : 'WIDTH="100%"'; #bah if ( $col ) { - qq!<TABLE BGCOLOR="$col" BORDER=0 CELLSPACING=$cellspacing WIDTH="100%">!; + qq!<TABLE BGCOLOR="$col" BORDER=0 CELLSPACING=$cellspacing $width>!; } else { - qq!<TABLE BORDER=0 CELLSPACING=$cellspacing WIDTH="100%">!; + qq!<TABLE BORDER=0 CELLSPACING=$cellspacing $width>!; } } diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index eb6c690..d676d4e 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -935,8 +935,8 @@ httemplate/docs/config.html { 'key' => 'safe-part_pkg', - 'section' => 'UI', - 'description' => 'Validates package definition setup and recur expressions against a preset list. Useful for webdemos, annoying to powerusers.', + 'section' => 'deprecated', + 'description' => '<b>DEPRECATED</b>, obsolete. Used to validate package definition setup and recur expressions against a preset list. Useful for webdemos, annoying to powerusers.', 'type' => 'checkbox', }, diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 4e5e18a..f0026d5 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -131,14 +131,18 @@ sub new { $self->{'Table'} = shift; carp "warning: FS::Record::new called with table name ". $self->{'Table'}; } + + $self->{'Hash'} = shift; - my $hashref = $self->{'Hash'} = shift; - - foreach my $field ( grep !defined($hashref->{$_}), $self->fields ) { - $hashref->{$field}=''; + foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) { + $self->{'Hash'}{$field}=''; } - $self->_cache($hashref, shift) if $self->can('_cache') && @_; + $self->_rebless if $self->can('_rebless'); + + $self->{'modified'} = 0; + + $self->_cache($self->{'Hash'}, shift) if $self->can('_cache') && @_; $self; } @@ -498,6 +502,7 @@ Sets the value of the column/field/key COLUMN to VALUE. Returns VALUE. sub set { my($self,$field,$value) = @_; + $self->{'modified'} = 1; $self->{'Hash'}->{$field} = $value; } sub setfield { @@ -559,7 +564,9 @@ sub hash { =item hashref -Returns a reference to the column/value hash. +Returns a reference to the column/value hash. This may be deprecated in the +future; if there's a reason you can't just use the autoloaded or get/set +methods, speak up. =cut @@ -568,6 +575,19 @@ sub hashref { $self->{'Hash'}; } +=item modified + +Returns true if any of this object's values have been modified with set (or via +an autoloaded method). Doesn't yet recognize when you retreive a hashref and +modify that. + +=cut + +sub modified { + my $self = shift; + $self->{'modified'}; +} + =item insert Inserts this record to the database. If there is an error, returns the error, @@ -1681,6 +1701,8 @@ L<DBIx::DBSchema>, L<FS::UID>, L<DBI> Adapter::DBI from Ch. 11 of Advanced Perl Programming by Sriram Srinivasan. +http://poop.sf.net/ + =cut 1; diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 075cce3..50cee48 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -9,7 +9,8 @@ BEGIN { eval "use Time::Local;"; die "Time::Local minimum version 1.05 required with Perl versions before 5.6" if $] < 5.006 && !defined($Time::Local::VERSION); - eval "use Time::Local qw(timelocal timelocal_nocheck);"; + #eval "use Time::Local qw(timelocal timelocal_nocheck);"; + eval "use Time::Local qw(timelocal_nocheck);"; } use Date::Format; #use Date::Manip; @@ -1116,6 +1117,8 @@ If there is an error, returns the error, otherwise returns false. sub bill { my( $self, %options ) = @_; + warn "bill customer ". $self->custnum if $DEBUG; + my $time = $options{'time'} || time; my $error; @@ -1153,14 +1156,14 @@ sub bill { #NO!! next if $cust_pkg->cancel; next if $cust_pkg->getfield('cancel'); + warn " bill package ". $cust_pkg->pkgnum if $DEBUG; + #? to avoid use of uninitialized value errors... ? $cust_pkg->setfield('bill', '') unless defined($cust_pkg->bill); my $part_pkg = $cust_pkg->part_pkg; - #so we don't modify cust_pkg record unnecessarily - my $cust_pkg_mod_flag = 0; my %hash = $cust_pkg->hash; my $old_cust_pkg = new FS::cust_pkg \%hash; @@ -1169,27 +1172,16 @@ sub bill { # bill setup my $setup = 0; if ( !$cust_pkg->setup || $options{'resetup'} ) { - my $setup_prog = $part_pkg->getfield('setup'); - $setup_prog =~ /^(.*)$/ or do { - $dbh->rollback if $oldAutoCommit; - return "Illegal setup for pkgpart ". $part_pkg->pkgpart. - ": $setup_prog"; - }; - $setup_prog = $1; - $setup_prog = '0' if $setup_prog =~ /^\s*$/; - - #my $cpt = new Safe; - ##$cpt->permit(); #what is necessary? - #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods? - #$setup = $cpt->reval($setup_prog); - $setup = eval $setup_prog; - unless ( defined($setup) ) { + + warn " bill setup" if $DEBUG; + + $setup = eval { $cust_pkg->calc_setup( $time ) }; + if ( $@ ) { $dbh->rollback if $oldAutoCommit; - return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart. - "(expression $setup_prog): $@"; + return $@; } + $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup; - $cust_pkg_mod_flag=1; } #bill recurring fee @@ -1199,28 +1191,18 @@ sub bill { ! $cust_pkg->getfield('susp') && ( $cust_pkg->getfield('bill') || 0 ) <= $time ) { - my $recur_prog = $part_pkg->getfield('recur'); - $recur_prog =~ /^(.*)$/ or do { - $dbh->rollback if $oldAutoCommit; - return "Illegal recur for pkgpart ". $part_pkg->pkgpart. - ": $recur_prog"; - }; - $recur_prog = $1; - $recur_prog = '0' if $recur_prog =~ /^\s*$/; - # shared with $recur_prog + warn " bill recur" if $DEBUG; + + # XXX shared with $recur_prog $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; - #my $cpt = new Safe; - ##$cpt->permit(); #what is necessary? - #$cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods? - #$recur = $cpt->reval($recur_prog); - $recur = eval $recur_prog; - unless ( defined($recur) ) { + $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details ) }; + if ( $@ ) { $dbh->rollback if $oldAutoCommit; - return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart. - "(expression $recur_prog): $@"; + return $@; } + #change this bit to use Date::Manip? CAREFUL with timezones (see # mailing list archive) my ($sec,$min,$hour,$mday,$mon,$year) = @@ -1248,19 +1230,22 @@ sub bill { } $cust_pkg->setfield('bill', timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year)); - $cust_pkg_mod_flag = 1; } warn "\$setup is undefined" unless defined($setup); warn "\$recur is undefined" unless defined($recur); warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill); - if ( $cust_pkg_mod_flag ) { + if ( $cust_pkg->modified ) { + + warn " package ". $cust_pkg->pkgnum. " modified; updating\n" if $DEBUG; + $error=$cust_pkg->replace($old_cust_pkg); if ( $error ) { #just in case $dbh->rollback if $oldAutoCommit; return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"; } + $setup = sprintf( "%.2f", $setup ); $recur = sprintf( "%.2f", $recur ); if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) { @@ -1272,6 +1257,8 @@ sub bill { return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum; } if ( $setup != 0 || $recur != 0 ) { + warn " charges (setup=$setup, recur=$recur); queueing line items\n" + if $DEBUG; my $cust_bill_pkg = new FS::cust_bill_pkg ({ 'pkgnum' => $cust_pkg->pkgnum, 'setup' => $setup, @@ -1391,7 +1378,7 @@ sub bill { } #if $setup != 0 || $recur != 0 - } #if $cust_pkg_mod_flag + } #if $cust_pkg->modified } #foreach my $cust_pkg @@ -1538,7 +1525,7 @@ sub collect { $self->select_for_update; #mutex my $balance = $self->balance; - warn "collect customer". $self->custnum. ": balance $balance" if $DEBUG; + warn "collect customer ". $self->custnum. ": balance $balance" if $DEBUG; unless ( $balance > 0 ) { #redundant????? $dbh->rollback if $oldAutoCommit; #hmm return ''; @@ -2690,9 +2677,11 @@ sub charge { my $part_pkg = new FS::part_pkg ( { 'pkg' => $pkg, 'comment' => $comment, - 'setup' => $amount, + #'setup' => $amount, + #'recur' => '0', + 'plan' => 'flat', + 'plandata' => "setup_fee=$amount", 'freq' => 0, - 'recur' => '0', 'disabled' => 'Y', 'taxclass' => $taxclass, } ); diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index d2a48e9..3bce653 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -502,6 +502,30 @@ sub part_pkg { : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); } +=item calc_setup + +Calls the I<calc_setup> of the FS::part_pkg object associated with this billing +item. + +=cut + +sub calc_setup { + my $self = shift; + $self->part_pkg->calc_setup($self, @_); +} + +=item calc_recur + +Calls the I<calc_recur> of the FS::part_pkg object associated with this billing +item. + +=cut + +sub calc_recur { + my $self = shift; + $self->part_pkg->calc_recur($self, @_); +} + =item cust_svc [ SVCPART ] Returns the services for this package, as FS::cust_svc objects (see diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index bd12389..1e0b905 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -377,16 +377,15 @@ sub option { $part_export_option ? $part_export_option->optionvalue : ''; } -=item rebless +=item _rebless Reblesses the object into the FS::part_export::EXPORTTYPE class, where EXPORTTYPE is the object's I<exporttype> field. There should be better docs -on how to create new exports (and they should live in their own files and be -autoloaded-on-demand), but until then, see L</NEW EXPORT CLASSES>. +on how to create new exports, but until then, see L</NEW EXPORT CLASSES>. =cut -sub rebless { +sub _rebless { my $self = shift; my $exporttype = $self->exporttype; my $class = ref($self). "::$exporttype"; @@ -395,13 +394,15 @@ sub rebless { bless($self, $class); } +#these should probably all go away, just let the subclasses define em + =item export_insert SVC_OBJECT =cut sub export_insert { my $self = shift; - $self->rebless; + #$self->rebless; $self->_export_insert(@_); } @@ -420,7 +421,7 @@ sub export_insert { sub export_replace { my $self = shift; - $self->rebless; + #$self->rebless; $self->_export_replace(@_); } @@ -430,7 +431,7 @@ sub export_replace { sub export_delete { my $self = shift; - $self->rebless; + #$self->rebless; $self->_export_delete(@_); } @@ -440,7 +441,7 @@ sub export_delete { sub export_suspend { my $self = shift; - $self->rebless; + #$self->rebless; $self->_export_suspend(@_); } @@ -450,7 +451,7 @@ sub export_suspend { sub export_unsuspend { my $self = shift; - $self->rebless; + #$self->rebless; $self->_export_unsuspend(@_); } diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index df1f02e..67c7c96 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -1,15 +1,20 @@ package FS::part_pkg; use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch dbh dbdef ); +use vars qw( @ISA %freq %plans $DEBUG ); +use Carp; +use Tie::IxHash; +use FS::Conf; +use FS::Record qw( qsearch qsearchs dbh dbdef ); use FS::pkg_svc; use FS::agent_type; use FS::type_pkgs; -use FS::Conf; +use FS::part_pkg_option; @ISA = qw( FS::Record ); +$DEBUG = 0; + =head1 NAME FS::part_pkg - Object methods for part_pkg objects @@ -38,47 +43,44 @@ FS::part_pkg - Object methods for part_pkg objects =head1 DESCRIPTION -An FS::part_pkg object represents a billing item definition. FS::part_pkg +An FS::part_pkg object represents a package definition. FS::part_pkg inherits from FS::Record. The following fields are currently supported: =over 4 -=item pkgpart - primary key (assigned automatically for new billing item definitions) +=item pkgpart - primary key (assigned automatically for new package definitions) -=item pkg - Text name of this billing item definition (customer-viewable) +=item pkg - Text name of this package definition (customer-viewable) -=item comment - Text name of this billing item definition (non-customer-viewable) +=item comment - Text name of this package definition (non-customer-viewable) -=item setup - Setup fee expression +=item setup - Setup fee expression (deprecated) =item freq - Frequency of recurring fee -=item recur - Recurring fee expression +=item recur - Recurring fee expression (deprecated) =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 taxclass - Tax class =item plan - Price plan -=item plandata - Price plan data +=item plandata - Price plan data (deprecated - see L<FS::part_pkg_option> instead) =item disabled - Disabled flag, empty or `Y' =back -setup and recur are evaluated as Safe perl expressions. You can use numbers -just as you would normally. More advanced semantics are not yet defined. - =head1 METHODS =over 4 =item new HASHREF -Creates a new billing item definition. To add the billing item definition to +Creates a new package definition. To add the package definition to the database, see L<"insert">. =cut @@ -87,9 +89,9 @@ sub table { 'part_pkg'; } =item clone -An alternate constructor. Creates a new billing item definition by duplicating +An alternate constructor. Creates a new package definition by duplicating an existing definition. A new pkgpart is assigned and `(CUSTOM) ' is prepended -to the comment field. To add the billing item definition to the database, see +to the comment field. To add the package definition to the database, see L<"insert">. =cut @@ -107,13 +109,14 @@ sub clone { =item insert -Adds this billing item definition to the database. If there is an error, +Adds this package definition to the database. If there is an error, returns the error, otherwise returns false. =cut sub insert { my $self = shift; + warn "FS::part_pkg::insert called on $self" if $DEBUG; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -126,15 +129,43 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + warn " saving legacy plandata" if $DEBUG; + my $plandata = $self->get('plandata'); + $self->set('plandata', ''); + + warn " inserting part_pkg record" if $DEBUG; my $error = $self->SUPER::insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - my $conf = new FS::Conf; + if ( $plandata ) { + warn " inserting part_pkg_option records for plandata" if $DEBUG; + foreach my $part_pkg_option ( + map { /^(\w+)=(.*)$/ or do { $dbh->rollback if $oldAutoCommit; + return "illegal plandata: $plandata"; + }; + new FS::part_pkg_option { + 'pkgpart' => $self->pkgpart, + 'optionname' => $1, + 'optionvalue' => $2, + }; + } + split("\n", $plandata) + ) { + my $error = $part_pkg_option->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + my $conf = new FS::Conf; if ( $conf->exists('agent_defaultpkg') ) { + warn " agent_defaultpkg set; allowing all agents to purchase package" + if $DEBUG; foreach my $agent_type ( qsearch('agent_type', {} ) ) { my $type_pkgs = new FS::type_pkgs({ 'typenum' => $agent_type->typenum, @@ -148,6 +179,7 @@ sub insert { } } + warn " commiting transaction" if $DEBUG; $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -169,64 +201,79 @@ sub delete { Replaces OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. -=item check - -Checks all fields to make sure this is a valid billing item definition. If -there is an error, returns the error, otherwise returns false. Called by the -insert and replace methods. - =cut -sub check { - my $self = shift; - - for (qw(setup recur)) { $self->set($_=>0) if $self->get($_) =~ /^\s*$/; } - - 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; +sub replace { + my( $new, $old ) = ( shift, shift ); - $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*$/ + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; - #or $r =~ /^\$sdate += 86400 \* \s*\d+\s*; \s*\d*\.?\d*\s*$/ + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; - 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*$/ + my $plandata = $new->get('plandata'); + $new->set('plandata', ''); - 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*$/ + foreach my $part_pkg_option ( $old->part_pkg_option ) { + my $error = $part_pkg_option->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } - 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*$/ + my $error = $new->SUPER::replace($old); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } - 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*$/ + foreach my $part_pkg_option ( + map { /^(\w+)=(.*)$/ or do { $dbh->rollback if $oldAutoCommit; + return "illegal plandata: $plandata"; + }; + new FS::part_pkg_option { + 'pkgpart' => $new->pkgpart, + 'optionname' => $1, + 'optionvalue' => $2, + }; + } + split("\n", $plandata) + ) { + my $error = $part_pkg_option->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } - 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*$/ + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} - 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*$/ +=item check - 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*$/ +Checks all fields to make sure this is a valid package definition. If +there is an error, returns the error, otherwise returns false. Called by the +insert and replace methods. - or $r =~ /^my \$last_bill = \$cust_pkg\->last_bill; my \$hours = \$cust_pkg\->seconds_since_sqlradacct\(\$last_bill, \$sdate \) \/ 3600 - \s*\d\.?\d*\s*; \$hours = 0 if \$hours < 0; my \$input = \$cust_pkg\->attribute_since_sqlradacct\(\$last_bill, \$sdate, "AcctInputOctets" \) \/ 1048576; my \$output = \$cust_pkg\->attribute_since_sqlradacct\(\$last_bill, \$sdate, "AcctOutputOctets" \) \/ 1048576; my \$total = \$input \+ \$output \- \s*\d\.?\d*\s*; \$total = 0 if \$total < 0; my \$input = \$input - \s*\d\.?\d*\s*; \$input = 0 if \$input < 0; my \$output = \$output - \s*\d\.?\d*\s*; \$output = 0 if \$output < 0; \s*\d\.?\d*\s* \+ \s*\d\.?\d*\s* \* \$hours \+ \s*\d\.?\d*\s* \* \$input \+ \s*\d\.?\d*\s* \* \$output \+ \s*\d\.?\d*\s* \* \$total *;\s*$/ +=cut - or do { - #log! - return "illegal recur: $r"; - }; +sub check { + my $self = shift; + warn "FS::part_pkg::check called on $self" if $DEBUG; + for (qw(setup recur plandata)) { + #$self->set($_=>0) if $self->get($_) =~ /^\s*$/; } + return "Use of $_ field is deprecated; set a plan and options" + if length($self->get($_)); + $self->set($_, ''); } if ( $self->dbdef_table->column('freq')->type =~ /(int)/i ) { @@ -238,19 +285,22 @@ sub check { $self->freq($1); } - $self->ut_numbern('pkgpart') - || $self->ut_text('pkg') - || $self->ut_text('comment') - || $self->ut_anything('setup') - || $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' ] ) - || $self->SUPER::check - ; + my $error = $self->ut_numbern('pkgpart') + || $self->ut_text('pkg') + || $self->ut_text('comment') + || $self->ut_alphan('plan') + || $self->ut_enum('setuptax', [ '', 'Y' ] ) + || $self->ut_enum('recurtax', [ '', 'Y' ] ) + || $self->ut_textn('taxclass') + || $self->ut_enum('disabled', [ '', 'Y' ] ) + || $self->SUPER::check + ; + return $error if $error; + + return 'Unknown plan '. $self->plan + unless exists($plans{$self->plan}); + + ''; } =item pkg_svc @@ -270,7 +320,7 @@ sub pkg_svc { =item svcpart [ SVCDB ] Returns the svcpart of the primary service definition (see L<FS::part_svc>) -associated with this billing item definition (see L<FS::pkg_svc>). Returns +associated with this package definition (see L<FS::pkg_svc>). Returns false if there not a primary service definition or exactly one service definition with quantity 1, or if SVCDB is specified and does not match the svcdb of the service definition, @@ -315,8 +365,207 @@ sub payby { } } +=item freq_pretty + +Returns an english representation of the I<freq> field, such as "monthly", +"weekly", "semi-annually", etc. + +=cut + +tie %freq, 'Tie::IxHash', + '0' => '(no recurring fee)', + '1d' => 'daily', + '1w' => 'weekly', + '2w' => 'biweekly (every 2 weeks)', + '1' => 'monthly', + '2' => 'bimonthly (every 2 months)', + '3' => 'quarterly (every 3 months)', + '6' => 'semiannually (every 6 months)', + '12' => 'annually', + '24' => 'biannually (every 2 years)', +; + +sub freq_pretty { + my $self = shift; + my $freq = $self->freq; + if ( exists($freq{$freq}) ) { + $freq{$freq}; + } else { + my $interval = 'month'; + if ( $freq =~ /^(\d+)([dw])$/ ) { + my %interval = ( 'd'=>'day', 'w'=>'week' ); + $interval = $interval{$2}; + } + if ( $1 == 1 ) { + "every $interval"; + } else { + "every $freq ${interval}s"; + } + } +} + +=item plandata + +For backwards compatibility, returns the plandata field as well as all options +from FS::part_pkg_option. + +=cut + +sub plandata { + my $self = shift; + carp "plandata is deprecated"; + if ( @_ ) { + $self->SUPER::plandata(@_); + } else { + my $plandata = $self->get('plandata'); + my %options = $self->options; + $plandata .= join('', map { "$_=$options{$_}\n" } keys %options ); + $plandata; + } +} + +=item part_pkg_option + +Returns all options as FS::part_pkg_option objects (see +L<FS::part_pkg_option>). + +=cut + +sub part_pkg_option { + my $self = shift; + qsearch('part_pkg_option', { 'pkgpart' => $self->pkgpart } ); +} + +=item options + +Returns a list of option names and values suitable for assigning to a hash. + +=cut + +sub options { + my $self = shift; + map { $_->optionname => $_->optionvalue } $self->part_pkg_option; +} + +=item option OPTIONNAME + +Returns the option value for the given name, or the empty string. + +=cut + +sub option { + my $self = shift; + my $part_pkg_option = + qsearchs('part_pkg_option', { + pkgpart => $self->pkgpart, + optionname => shift, + } ); + $part_pkg_option ? $part_pkg_option->optionvalue : ''; +} + +=item _rebless + +Reblesses the object into the FS::part_pkg::PLAN class (if available), where +PLAN is the object's I<plan> field. There should be better docs +on how to create new price plans, but until then, see L</NEW PLAN CLASSES>. + +=cut + +sub _rebless { + my $self = shift; + my $plan = $self->plan; + my $class = ref($self). "::$plan"; + eval "use $class;"; + #die $@ if $@; + bless($self, $class) unless $@; + $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; +} + =back +=head1 SUBROUTINES + +=over 4 + +=item plan_info + +=cut + +my %info; +foreach my $INC ( @INC ) { + foreach my $file ( glob("$INC/FS/part_pkg/*.pm") ) { + warn "attempting to load plan info from $file\n" if $DEBUG; + $file =~ /\/(\w+)\.pm$/ or do { + warn "unrecognized file in $INC/FS/part_pkg/: $file\n"; + next; + }; + my $mod = $1; + my $info = eval "use FS::part_pkg::$mod; ". + "\\%FS::part_pkg::$mod\::info;"; + if ( $@ ) { + die "error using FS::part_pkg::$mod (skipping): $@\n" if $@; + next; + } + unless ( keys %$info ) { + warn "no %info hash found in FS::part_pkg::$mod, skipping\n" + unless $mod =~ /^(passwdfile|null)$/; #hack but what the heck + next; + } + warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG; + if ( exists($info->{'disabled'}) && $info->{'disabled'} ) { + warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG; + next; + } + $info{$mod} = $info; + } +} + +tie %plans, 'Tie::IxHash', + map { $_ => $info{$_} } + sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} } + keys %info; + +sub plan_info { + \%plans; +} + +=back + +=head1 NEW PLAN CLASSES + +A module should be added in FS/FS/part_pkg/ (an example may be found in +eg/plan_template.pm) + =head1 BUGS The delete method is unimplemented. diff --git a/FS/FS/part_pkg/flat.pm b/FS/FS/part_pkg/flat.pm new file mode 100644 index 0000000..a3939ba --- /dev/null +++ b/FS/FS/part_pkg/flat.pm @@ -0,0 +1,36 @@ +package FS::part_pkg::flat; + +use strict; +use vars qw(@ISA %info); +#use FS::Record qw(qsearch); +use FS::part_pkg; + +@ISA = qw(FS::part_pkg); + +%info = ( + 'name' => 'Flat rate (anniversary billing)', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Recurring fee for this package', + 'default' => 0, + }, + }, + 'fieldorder' => [ 'setup_fee', 'recur_fee' ], + #'setup' => 'what.setup_fee.value', + #'recur' => 'what.recur_fee.value', + 'weight' => 10, +); + +sub calc_setup { + my($self, $cust_pkg ) = @_; + $self->option('setup_fee'); +} + +sub calc_recur { + my($self, $cust_pkg ) = @_; + $self->option('recur_fee'); +} + +1; diff --git a/FS/FS/part_pkg/flat_comission.pm b/FS/FS/part_pkg/flat_comission.pm new file mode 100644 index 0000000..d393470 --- /dev/null +++ b/FS/FS/part_pkg/flat_comission.pm @@ -0,0 +1,51 @@ +package FS::part_pkg::flat_comission; + +use strict; +use vars qw(@ISA %info); +#use FS::Record qw(qsearch qsearchs); +use FS::part_pkg; + +@ISA = qw(FS::part_pkg); + +%info = ( + 'name' => 'Flat rate with recurring commission per (any) active package', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Recurring fee for this package', + 'default' => 0, + }, + 'comission_amount' => { 'name' => 'Commission amount per month (per active package)', + 'default' => 0, + }, + 'comission_depth' => { 'name' => 'Number of layers', + 'default' => 1, + }, + }, + 'fieldorder' => [ 'setup_fee', 'recur_fee', 'comission_depth', 'comission_amount' ], + #'setup' => 'what.setup_fee.value', + #'recur' => '\'my $error = $cust_pkg->cust_main->credit( \' + what.comission_amount.value + \' * scalar($cust_pkg->cust_main->referral_cust_pkg(\' + what.comission_depth.value+ \')), "commission" ); die $error if $error; \' + what.recur_fee.value + \';\'', + 'weight' => 62, +); + +sub calc_setup { + my($self, $cust_pkg ) = @_; + $self->option('setup_fee'); +} + +sub calc_recur { + my($self, $cust_pkg ) = @_; + + my $amount = $self->option('comission_amount'); + my $num_active = scalar( + $cust_pkg->cust_main->referral_cust_pkg( $self->option('comission_depth') ) + ); + + my $error = $cust_pkg->cust_main->credit( $amount*$num_active, "commission" ); + die $error if $error; + + $self->option('recur_fee'); +} + +1; diff --git a/FS/FS/part_pkg/flat_comission_cust.pm b/FS/FS/part_pkg/flat_comission_cust.pm new file mode 100644 index 0000000..5de45c5 --- /dev/null +++ b/FS/FS/part_pkg/flat_comission_cust.pm @@ -0,0 +1,53 @@ +package FS::part_pkg::flat_comission_cust; + +use strict; +use vars qw(@ISA %info); +#use FS::Record qw(qsearch qsearchs); +use FS::part_pkg; + +@ISA = qw(FS::part_pkg); + +%info = ( + 'name' => 'Flat rate with recurring commission per active customer', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Recurring fee for this package', + 'default' => 0, + }, + 'comission_amount' => { 'name' => 'Commission amount per month (per active customer)', + 'default' => 0, + }, + 'comission_depth' => { 'name' => 'Number of layers', + 'default' => 1, + }, + }, + 'fieldorder' => [ 'setup_fee', 'recur_fee', 'comission_depth', 'comission_amount' ], + #'setup' => 'what.setup_fee.value', + #'recur' => '\'my $error = $cust_pkg->cust_main->credit( \' + what.comission_amount.value + \' * scalar($cust_pkg->cust_main->referral_cust_main_ncancelled(\' + what.comission_depth.value+ \')), "commission" ); die $error if $error; \' + what.recur_fee.value + \';\'', + 'weight' => '60', +); + +sub calc_setup { + my($self, $cust_pkg ) = @_; + $self->option('setup_fee'); +} + +sub calc_recur { + my($self, $cust_pkg ) = @_; + + my $amount = $self->option('comission_amount'); + my $num_active = scalar( + $cust_pkg->cust_main->referral_cust_pkgcust_main_ncancelled( + $self->option('comission_depth') + ) + ); + + my $error = $cust_pkg->cust_main->credit( $amount*$num_active, "commission" ); + die $error if $error; + + $self->option('recur_fee'); +} + +1; diff --git a/FS/FS/part_pkg/flat_comission_pkg.pm b/FS/FS/part_pkg/flat_comission_pkg.pm new file mode 100644 index 0000000..1e6e69b --- /dev/null +++ b/FS/FS/part_pkg/flat_comission_pkg.pm @@ -0,0 +1,50 @@ +package FS::part_pkg::flat_comission_pkg; + +use strict; +use vars qw(@ISA %info); +#use FS::Record qw(qsearch qsearchs); +use FS::part_pkg; + +@ISA = qw(FS::part_pkg); + +%info = ( + 'name' => 'Flat rate with recurring commission per (selected) active package', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Recurring fee for this package', + 'default' => 0, + }, + 'comission_amount' => { 'name' => 'Commission amount per month (per uncancelled package)', + 'default' => 0, + }, + 'comission_depth' => { 'name' => 'Number of layers', + 'default' => 1, + }, + 'comission_pkgpart' => { 'name' => 'Applicable packages<BR><FONT SIZE="-1">(hold <b>ctrl</b> to select multiple packages)</FONT>', + 'type' => 'select_multiple', + 'select_table' => 'part_pkg', + 'select_hash' => { 'disabled' => '' } , + 'select_key' => 'pkgpart', + 'select_label' => 'pkg', + }, + }, + 'fieldorder' => [ 'setup_fee', 'recur_fee', 'comission_depth', 'comission_amount', 'comission_pkgpart' ], + #'setup' => 'what.setup_fee.value', + #'recur' => '""; var pkgparts = ""; for ( var c=0; c < document.flat_comission_pkg.comission_pkgpart.options.length; c++ ) { if (document.flat_comission_pkg.comission_pkgpart.options[c].selected) { pkgparts = pkgparts + document.flat_comission_pkg.comission_pkgpart.options[c].value + \', \'; } } what.recur.value = \'my $error = $cust_pkg->cust_main->credit( \' + what.comission_amount.value + \' * scalar( grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } ( \' + pkgparts + \' ) } $cust_pkg->cust_main->referral_cust_pkg(\' + what.comission_depth.value+ \')), "commission" ); die $error if $error; \' + what.recur_fee.value + \';\'', + #'disabled' => 1, + 'weight' => '64', +); + +sub calc_setup { + my($self, $cust_pkg ) = @_; + $self->option('setup_fee'); +} + +sub calc_recur { + my($self, $cust_pkg ) = @_; + $self->option('recur_fee'); +} + +1; diff --git a/FS/FS/part_pkg/flat_delayed.pm b/FS/FS/part_pkg/flat_delayed.pm new file mode 100644 index 0000000..cf4ffef --- /dev/null +++ b/FS/FS/part_pkg/flat_delayed.pm @@ -0,0 +1,45 @@ +package FS::part_pkg::flat_delayed; + +use strict; +use vars qw(@ISA %info); +#use FS::Record qw(qsearch qsearchs); +use FS::part_pkg; + +@ISA = qw(FS::part_pkg); + +%info = ( + 'name' => 'Free (or setup fee) for X days, then flat rate'. + ' (anniversary billing)', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'free_days' => { 'name' => 'Initial free days', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Recurring fee for this package', + 'default' => 0, + }, + }, + 'fieldorder' => [ 'free_days', 'setup_fee', 'recur_fee' ], + #'setup' => '\'my $d = $cust_pkg->bill || $time; $d += 86400 * \' + what.free_days.value + \'; $cust_pkg->bill($d); $cust_pkg_mod_flag=1; \' + what.setup_fee.value', + #'recur' => 'what.recur_fee.value', + 'weight' => 50, +); + +sub calc_setup { + my($self, $cust_pkg, $time ) = @_; + + my $d = $cust_pkg->bill || $time; + $d += 86400 * $self->option('free_days'); + $cust_pkg->bill($d); + + $self->option('setup_fee'); +} + +sub calc_recur { + my($self, $cust_pkg ) = @_; + $self->option('recur_fee'); +} + +1; diff --git a/FS/FS/part_pkg/prorate.pm b/FS/FS/part_pkg/prorate.pm new file mode 100644 index 0000000..37cb37f --- /dev/null +++ b/FS/FS/part_pkg/prorate.pm @@ -0,0 +1,46 @@ +package FS::part_pkg::prorate; + +use strict; +use vars qw(@ISA %info); +use Time::Local qw(timelocal); +#use FS::Record qw(qsearch qsearchs); +use FS::part_pkg; + +@ISA = qw(FS::part_pkg); + +%info = ( + 'name' => 'First partial month pro-rated, then flat-rate (1st of month billing)', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Recurring fee for this package', + 'default' => 0, + }, + }, + 'fieldorder' => [ 'setup_fee', 'recur_fee' ], + #'setup' => 'what.setup_fee.value', + #'recur' => '\'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 ) * \' + what.recur_fee.value + \' / $part_pkg->freq + \' + what.recur_fee.value + \' / $part_pkg->freq * ($mend-$mnow) / ($mend-$mstart) ; \'', + 'freq' => 'm', + 'weight' => 20, +); + +sub calc_setup { + my($self, $cust_pkg ) = @_; + $self->option('setup_fee'); +} + +sub calc_recur { + my($self, $cust_pkg, $sdate ) = @_; + my $mnow = $$sdate; + my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($mnow) )[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; + + my $permonth = $self->option('recur_fee') / $self->freq; + + $permonth * ( ( $self->freq - 1 ) + ($mend-$mnow) / ($mend-$mstart) ); +} + +1; diff --git a/FS/FS/part_pkg/sesmon_hour.pm b/FS/FS/part_pkg/sesmon_hour.pm new file mode 100644 index 0000000..8f6da19 --- /dev/null +++ b/FS/FS/part_pkg/sesmon_hour.pm @@ -0,0 +1,48 @@ +package FS::part_pkg::sesmon_hour; + +use strict; +use vars qw(@ISA %info); +#use FS::Record qw(qsearch qsearchs); +use FS::part_pkg; + +@ISA = qw(FS::part_pkg); + +%info = ( + 'name' => 'Base charge plus charge per-hour from the session monitor', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_flat' => { 'name' => 'Base monthly charge for this package', + 'default' => 0, + }, + 'recur_included_hours' => { 'name' => 'Hours included', + 'default' => 0, + }, + 'recur_hourly_charge' => { 'name' => 'Additional charge per hour', + 'default' => 0, + }, + }, + 'fieldorder' => [ 'setup_fee', 'recur_flat', 'recur_included_hours', 'recur_hourly_charge' ], + #'setup' => 'what.setup_fee.value', + #'recur' => '\'my $hours = $cust_pkg->seconds_since($cust_pkg->bill || 0) / 3600 - \' + what.recur_included_hours.value + \'; $hours = 0 if $hours < 0; \' + what.recur_flat.value + \' + \' + what.recur_hourly_charge.value + \' * $hours;\'', + 'weight' => 80, +); + +sub calc_setup { + my($self, $cust_pkg ) = @_; + $self->option('setup_fee'); +} + +sub calc_recur { + my($self, $cust_pkg ) = @_; + + my $hours = $cust_pkg->seconds_since($cust_pkg->bill || 0) / 3600; + $hours -= $self->option('recur_included_hours'); + $hours = 0 if $hours < 0; + + $self->option('recur_flat') + $hours * $self->option('recur_hourly_charge'); + +} + +1; diff --git a/FS/FS/part_pkg/sesmon_minute.pm b/FS/FS/part_pkg/sesmon_minute.pm new file mode 100644 index 0000000..9ef76d7 --- /dev/null +++ b/FS/FS/part_pkg/sesmon_minute.pm @@ -0,0 +1,46 @@ +package FS::part_pkg::sesmon_minute; + +use strict; +use vars qw(@ISA %info); +#use FS::Record qw(qsearch qsearchs); +use FS::part_pkg; + +@ISA = qw(FS::part_pkg); + +%info = ( + 'name' => 'Base charge plus charge per-minute from the session monitor', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_flat' => { 'name' => 'Base monthly charge for this package', + 'default' => 0, + }, + 'recur_included_min' => { 'name' => 'Minutes included', + 'default' => 0, + }, + 'recur_minly_charge' => { 'name' => 'Additional charge per minute', + 'default' => 0, + }, + }, + 'fieldorder' => [ 'setup_fee', 'recur_flat', 'recur_included_min', 'recur_minly_charge' ], + #'setup' => 'what.setup_fee.value', + #'recur' => '\'my $min = $cust_pkg->seconds_since($cust_pkg->bill || 0) / 60 - \' + what.recur_included_min.value + \'; $min = 0 if $min < 0; \' + what.recur_flat.value + \' + \' + what.recur_minly_charge.value + \' * $min;\'', + 'weight' => 80, +); + +sub calc_setup { + my( $self, $cust_pkg ) = @_; + $self->option('setup_fee'); +} + +sub cakc_recur { + my( $self, $cust_pkg ) = @); + my $min = $cust_pkg->seconds_since($cust_pkg->bill || 0) / 60; + $min -= $self->option('recur_included_min'); + $min = 0 if $min < 0; + + $self->option('recur_flat') + $min * $self->option('recur_minly_charge'); +} + +1; diff --git a/FS/FS/part_pkg/sql_external.pm b/FS/FS/part_pkg/sql_external.pm new file mode 100644 index 0000000..688f918 --- /dev/null +++ b/FS/FS/part_pkg/sql_external.pm @@ -0,0 +1,68 @@ +package FS::part_pkg::sql_external; + +use strict; +use vars qw(@ISA %info); +use DBI; +#use FS::Record qw(qsearch qsearchs); +use FS::part_pkg; + +@ISA = qw(FS::part_pkg); + +%info = ( + 'name' => 'Base charge plus additional fees for external services from a configurable SQL query', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_flat' => { 'name' => 'Base monthly charge for this package', + 'default' => 0, + }, + 'datasrc' => { 'name' => 'DBI data source', + 'default' => '', + }, + 'db_username' => { 'name' => 'Database username', + 'default' => '', + }, + 'db_password' => { 'name' => 'Database password', + 'default' => '', + }, + 'query' => { 'name' => 'SQL query', + 'default' => '', + }, + }, + 'fieldorder' => [qw( setup_fee recur_flat datasrc db_username db_password query )], + #'setup' => 'what.setup_fee.value', + #'recur' => q!'my $dbh = DBI->connect("' + what.datasrc.value + '", "' + what.db_username.value + '", "' + what.db_password.value + '" ) or die $DBI::errstr; my $sth = $dbh->prepare("' + what.query.value + '") or die $dbh->errstr; my $price = ' + what.recur_flat.value + '; foreach my $cust_svc ( grep { $_->part_svc->svcdb eq "svc_external" } $cust_pkg->cust_svc ){ my $id = $cust_svc->svc_x->id; $sth->execute($id) or die $sth->errstr; $price += $sth->fetchrow_arrayref->[0]; } $price;'!, + 'weight' => '72', +); + +sub calc_setup { + my($self, $cust_pkg ) = @_; + $self->option('setup_fee'); +} + +sub calc_recur { + my($self, $cust_pkg ) = @_; + + my $dbh = DBI->connect( map { $self->option($_) } + qw( datasrc db_username db_password ) + ) + or die $DBI::errstr; + + my $sth = $dbh->prepare( $self->option('query') ) + or die $dbh->errstr; + + my $price = $self->option('recur_flat'); + + foreach my $cust_svc ( + grep { $_->part_svc->svcdb eq "svc_external" } $cust_pkg->cust_svc + ) { + my $id = $cust_svc->svc_x->id; + $sth->execute($id) or die $sth->errstr; + $price += $sth->fetchrow_arrayref->[0]; + } + + $price; +} + +1; diff --git a/FS/FS/part_pkg/sql_generic.pm b/FS/FS/part_pkg/sql_generic.pm new file mode 100644 index 0000000..85c3413 --- /dev/null +++ b/FS/FS/part_pkg/sql_generic.pm @@ -0,0 +1,79 @@ +package FS::part_pkg::sql_generic; + +use strict; +use vars qw(@ISA %info); +use DBI; +#use FS::Record qw(qsearch qsearchs); +use FS::part_pkg; + +@ISA = qw(FS::part_pkg); + +%info = ( + 'name' => 'Base charge plus a per-domain metered rate from a configurable SQL query', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_flat' => { 'name' => 'Base monthly charge for this package', + 'default' => 0, + }, + 'recur_included' => { 'name' => 'Units included', + 'default' => 0, + }, + 'recur_unit_charge' => { 'name' => 'Additional charge per unit', + 'default' => 0, + }, + 'datasrc' => { 'name' => 'DBI data source', + 'default' => '', + }, + 'db_username' => { 'name' => 'Database username', + 'default' => '', + }, + 'db_password' => { 'name' => 'Database username', + 'default' => '', + }, + 'query' => { 'name' => 'SQL query', + 'default' => '', + }, + }, + 'fieldorder' => [qw( setup_fee recur_flat recur_included recur_unit_charge datasrc db_username db_password query )], + # 'setup' => 'what.setup_fee.value', + # 'recur' => '\'my $dbh = DBI->connect(\"\' + what.datasrc.value + \'\", \"\' + what.db_username.value + \'\") or die $DBI::errstr; \'', + #'recur' => '\'my $dbh = DBI->connect(\"\' + what.datasrc.value + \'\", \"\' + what.db_username.value + \'\", \"\' + what.db_password.value + \'\" ) or die $DBI::errstr; my $sth = $dbh->prepare(\"\' + what.query.value + \'\") or die $dbh->errstr; my $units = 0; foreach my $cust_svc ( grep { $_->part_svc->svcdb eq \"svc_domain\" } $cust_pkg->cust_svc ) { my $domain = $cust_svc->svc_x->domain; $sth->execute($domain) or die $sth->errstr; $units += $sth->fetchrow_arrayref->[0]; } $units -= \' + what.recur_included.value + \'; $units = 0 if $units < 0; \' + what.recur_flat.value + \' + $units * \' + what.recur_unit_charge.value + \';\'', + #'recur' => '\'my $dbh = DBI->connect("\' + what.datasrc.value + \'", "\' + what.db_username.value + \'", "\' what.db_password.value + \'" ) or die $DBI::errstr; my $sth = $dbh->prepare("\' + what.query.value + \'") or die $dbh->errstr; my $units = 0; foreach my $cust_svc ( grep { $_->part_svc->svcdb eq "svc_domain" } $cust_pkg->cust_svc ) { my $domain = $cust_svc->svc_x->domain; $sth->execute($domain) or die $sth->errstr; $units += $sth->fetchrow_arrayref->[0]; } $units -= \' + what.recur_included.value + \'; $units = 0 if $units < 0; \' + what.recur_flat.value + \' + $units * \' + what.recur_unit_charge + \';\'', + 'weight' => '70', +); + +sub calc_setup { + my($self, $cust_pkg ) = @_; + $self->option('setup_fee'); +} + +sub calc_recur { + my($self, $cust_pkg ) = @_; + + my $dbh = DBI->connect( map { $self->option($_) } + qw( datasrc db_username db_password ) + ) + or die $DBI::errstr; + + my $sth = $dbh->prepare( $self->option('query') ) + or die $dbh->errstr; + + my $units = 0; + foreach my $cust_svc ( + grep { $_->part_svc->svcdb eq "svc_domain" } $cust_pkg->cust_svc + ) { + my $domain = $cust_svc->svc_x->domain; + $sth->execute($domain) or die $sth->errstr; + + $units += $sth->fetchrow_arrayref->[0]; + } + + $units -= $self->option('recur_included'); + $units = 0 if $units < 0; + + $self->option('recur_flat') + $units * $self->option('recur_unit_charge'); +} + +1; diff --git a/FS/FS/part_pkg/sqlradacct_hour.pm b/FS/FS/part_pkg/sqlradacct_hour.pm new file mode 100644 index 0000000..f5ad2b1 --- /dev/null +++ b/FS/FS/part_pkg/sqlradacct_hour.pm @@ -0,0 +1,115 @@ +package FS::part_pkg::sqlradacct_hour; + +use strict; +use vars qw(@ISA %info); +#use FS::Record qw(qsearch qsearchs); +use FS::part_pkg; + +@ISA = qw(FS::part_pkg); + +%info = ( + 'name' => 'Base charge plus per-hour (and for data) from an SQL RADIUS radacct table', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_flat' => { 'name' => 'Base monthly charge for this package', + 'default' => 0, + }, + 'recur_included_hours' => { 'name' => 'Hours included', + 'default' => 0, + }, + 'recur_hourly_charge' => { 'name' => 'Additional charge per hour', + 'default' => 0, + }, + 'recur_included_input' => { 'name' => 'Upload megabytes included', + 'default' => 0, + }, + 'recur_input_charge' => { 'name' => + 'Additional charge per megabyte upload', + 'default' => 0, + }, + 'recur_included_output' => { 'name' => 'Download megabytes included', + 'default' => 0, + }, + 'recur_output_charge' => { 'name' => + 'Additional charge per megabyte download', + 'default' => 0, + }, + 'recur_included_total' => { 'name' => + 'Total megabytes included', + 'default' => 0, + }, + 'recur_total_charge' => { 'name' => + 'Additional charge per megabyte total', + 'default' => 0, + }, + }, + 'fieldorder' => [qw( setup_fee recur_flat recur_included_hours recur_hourly_charge recur_included_input recur_input_charge recur_included_output recur_output_charge recur_included_total recur_total_charge )], + #'setup' => 'what.setup_fee.value', + #'recur' => '\'my $last_bill = $cust_pkg->last_bill; my $hours = $cust_pkg->seconds_since_sqlradacct($last_bill, $sdate ) / 3600 - \' + what.recur_included_hours.value + \'; $hours = 0 if $hours < 0; my $input = $cust_pkg->attribute_since_sqlradacct($last_bill, $sdate, \"AcctInputOctets\" ) / 1048576; my $output = $cust_pkg->attribute_since_sqlradacct($last_bill, $sdate, \"AcctOutputOctets\" ) / 1048576; my $total = $input + $output - \' + what.recur_included_total.value + \'; $total = 0 if $total < 0; my $input = $input - \' + what.recur_included_input.value + \'; $input = 0 if $input < 0; my $output = $output - \' + what.recur_included_output.value + \'; $output = 0 if $output < 0; my $totalcharge = sprintf(\"%.2f\", \' + what.recur_total_charge.value + \' * $total); my $inputcharge = sprintf(\"%.2f\", \' + what.recur_input_charge.value + \' * $input); my $outputcharge = sprintf(\"%.2f\", \' + what.recur_output_charge.value + \' * $output); my $hourscharge = sprintf(\"%.2f\", \' + what.recur_hourly_charge.value + \' * $hours); if ( \' + what.recur_total_charge.value + \' > 0 ) { push @details, \"Last month\\\'s data \". sprintf(\"%.1f\", $total). \" megs: \\\$$totalcharge\" } if ( \' + what.recur_input_charge.value + \' > 0 ) { push @details, \"Last month\\\'s download \". sprintf(\"%.1f\", $input). \" megs: \\\$$inputcharge\" } if ( \' + what.recur_output_charge.value + \' > 0 ) { push @details, \"Last month\\\'s upload \". sprintf(\"%.1f\", $output). \" megs: \\\$$outputcharge\" } if ( \' + what.recur_hourly_charge.value + \' > 0 ) { push @details, \"Last month\\\'s time \". sprintf(\"%.1f\", $hours). \" hours: \\\$$hourscharge\"; } \' + what.recur_flat.value + \' + $hourscharge + $inputcharge + $outputcharge + $totalcharge ;\'', + 'weight' => 40, +); + +sub calc_setup { + my($self, $cust_pkg ) = @_; + $self->option('setup_fee'); +} + +sub calc_recur { + my($self, $cust_pkg, $sdate, $details ) = @_; + + my $last_bill = $cust_pkg->last_bill; + my $hours = $cust_pkg->seconds_since_sqlradacct($last_bill, $$sdate ) / 3600; + $hours -= $self->option('recur_included_hours'); + $hours = 0 if $hours < 0; + + my $input = $cust_pkg->attribute_since_sqlradacct( $last_bill, + $$sdate, + 'AcctInputOctets' ) + / 1048576; + + my $output = $cust_pkg->attribute_since_sqlradacct( $last_bill, + $$sdate, + 'AcctOutputOctets' ) + / 1048576; + + my $total = $input + $output - $self->option('recur_included_total'); + $total = 0 if $total < 0; + $input = $input - $self->option('recur_included_input'); + $input = 0 if $input < 0; + $output = $output - $self->option('recur_included_output'); + $output = 0 if $output < 0; + + my $totalcharge = + $total * sprintf('%.2f', $self->option('recur_total_charge')); + my $inputcharge = + $input * sprintf('%.2f', $self->option('recur_input_charge')); + my $outputcharge = + $output * sprintf('%.2f', $self->option('recur_output_charge')); + + my $hourscharge = + $hours * sprintf('%.2f', $self->option('recur_hourly_charge')); + + if ( $self->option('recur_total_charge') > 0 ) { + push @$details, "Last month's data ". + sprintf('%.1f', $total). " megs: $totalcharge"; + } + if ( $self->option('recur_input_charge') > 0 ) { + push @$details, "Last month's download ". + sprintf('%.1f', $input). " megs: $inputcharge"; + } + if ( $self->option('recur_output_charge') > 0 ) { + push @$details, "Last month's upload ". + sprintf('%.1f', $output). " megs: $outputcharge"; + } + if ( $self->option('recur_hourly_charge') > 0 ) { + push @$details, "Last month\'s time ". + sprintf('%.1f', $hours). " hours: $hourscharge"; + } + + $self->option('recur_flat') + + $hourscharge + $inputcharge + $outputcharge + $totalcharge; +} + +1; diff --git a/FS/FS/part_pkg/subscription.pm b/FS/FS/part_pkg/subscription.pm new file mode 100644 index 0000000..4dc9252 --- /dev/null +++ b/FS/FS/part_pkg/subscription.pm @@ -0,0 +1,43 @@ +package FS::part_pkg::subscription; + +use strict; +use vars qw(@ISA %info); +use Time::Local qw(timelocal); +#use FS::Record qw(qsearch qsearchs); +use FS::part_pkg; + +@ISA = qw(FS::part_pkg); + +%info = ( + 'name' => 'First partial month full charge, then flat-rate (1st of month billing)', + 'fields' => { + 'setup_fee' => { 'name' => 'Setup fee for this package', + 'default' => 0, + }, + 'recur_fee' => { 'name' => 'Recurring fee for this package', + 'default' => 0, + }, + }, + 'fieldorder' => [ 'setup_fee', 'recur_fee' ], + #'setup' => 'what.setup_fee.value', + #'recur' => '\'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); \' + what.recur_fee.value', + 'freq' => 'm', + 'weight' => 30, +); + +sub calc_setup { + my($self, $cust_pkg ) = @_; + $self->option('setup_fee'); +} + +sub calc_recur { + my($self, $cust_pkg, $sdate ) = @_; + + my $mnow = $$sdate; + my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($mnow) )[0,1,2,3,4,5]; + $$sdate = timelocal(0,0,0,1,$mon,$year); + + $self->option('recur_fee'); +} + +1; diff --git a/FS/FS/part_pkg_option.pm b/FS/FS/part_pkg_option.pm new file mode 100644 index 0000000..c2f609e --- /dev/null +++ b/FS/FS/part_pkg_option.pm @@ -0,0 +1,131 @@ +package FS::part_pkg_option; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs ); +use FS::part_pkg; + +@ISA = qw(FS::Record); + +=head1 NAME + +FS::part_pkg_option - Object methods for part_pkg_option records + +=head1 SYNOPSIS + + use FS::part_pkg_option; + + $record = new FS::part_pkg_option \%hash; + $record = new FS::part_pkg_option { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::part_pkg_option object represents an package definition option. +FS::part_pkg_option inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item optionnum - primary key + +=item pkgpart - package definition (see L<FS::part_pkg>) + +=item optionname - option name + +=item optionvalue - option value + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new package definition option. To add the package definition option +to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'part_pkg_option'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +# the delete method can be inherited from FS::Record + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid package definition option. If +there is an error, returns the error, otherwise returns false. Called by the +insert and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('optionnum') + || $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart') + || $self->ut_alpha('optionname') + || $self->ut_anything('optionvalue') + ; + return $error if $error; + + #check options & values? + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +Possibly. + +=head1 SEE ALSO + +L<FS::part_pkg>, L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/MANIFEST b/FS/MANIFEST index 4e78e72..b2a301a 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -92,6 +92,19 @@ FS/part_export/textradius.pm FS/part_export/vpopmail.pm FS/part_export/www_shellcommands.pm FS/part_pkg.pm +FS/part_pkg_option.pm +FS/part_pkg/flat.pm +FS/part_pkg/flat_comission.pm +FS/part_pkg/flat_comission_cust.pm +FS/part_pkg/flat_comission_pkg.pm +FS/part_pkg/flat_delayed.pm +FS/part_pkg/prorate.pm +FS/part_pkg/sesmon_hour.pm +FS/part_pkg/sesmon_minute.pm +FS/part_pkg/sql_external.pm +FS/part_pkg/sql_generic.pm +FS/part_pkg/sqlradacct_hour.pm +FS/part_pkg/subscription.pm FS/part_pop_local.pm FS/part_referral.pm FS/part_svc.pm @@ -187,6 +200,19 @@ t/part_export-textradius.t t/part_export-vpopmail.t t/part_export-www_shellcommands.t t/part_pkg.t +t/part_pkg_option.t +t/part_pkg-flat.t +t/part_pkg-flat_comission.t +t/part_pkg-flat_comission_cust.t +t/part_pkg-flat_comission_pkg.t +t/part_pkg-flat_delayed.t +t/part_pkg-prorate.t +t/part_pkg-sesmon_hour.t +t/part_pkg-sesmon_minute.t +t/part_pkg-sql_external.t +t/part_pkg-sql_generic.t +t/part_pkg-sqlradacct_hour.t +t/part_pkg-subscription.t t/part_pop_local.t t/part_referral.t t/part_svc.t diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index 5de71a9..bc27c79 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -1148,7 +1148,17 @@ sub tables_hash_hack { 'index' => [ ['paynum'], ['refundnum'] ], }, - + 'part_pkg_option' => { + 'columns' => [ + 'optionnum', 'serial', '', '', + 'pkgpart', 'int', '', '', + 'optionname', 'varchar', '', $char_d, + 'optionvalue', 'text', 'NULL', '', + ], + 'primary_key' => 'optionnum', + 'unique' => [], + 'index' => [ [ 'pkgpart' ], [ 'optionname' ] ], + }, ); diff --git a/FS/t/part_pkg-flat.t b/FS/t/part_pkg-flat.t new file mode 100644 index 0000000..3eee7a7 --- /dev/null +++ b/FS/t/part_pkg-flat.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::flat; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-flat_comission.t b/FS/t/part_pkg-flat_comission.t new file mode 100644 index 0000000..fefa57e --- /dev/null +++ b/FS/t/part_pkg-flat_comission.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::flat_comission; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-flat_comission_cust.t b/FS/t/part_pkg-flat_comission_cust.t new file mode 100644 index 0000000..05d3ac4 --- /dev/null +++ b/FS/t/part_pkg-flat_comission_cust.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::flat_comission_cust; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-flat_comission_pkg.t b/FS/t/part_pkg-flat_comission_pkg.t new file mode 100644 index 0000000..851b58d --- /dev/null +++ b/FS/t/part_pkg-flat_comission_pkg.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::flat_comission_pkg; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-flat_delayed.t b/FS/t/part_pkg-flat_delayed.t new file mode 100644 index 0000000..ed63846 --- /dev/null +++ b/FS/t/part_pkg-flat_delayed.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::flat_delayed; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-prorate.t b/FS/t/part_pkg-prorate.t new file mode 100644 index 0000000..d32b1c0 --- /dev/null +++ b/FS/t/part_pkg-prorate.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::prorate; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-sesmon_hour.t b/FS/t/part_pkg-sesmon_hour.t new file mode 100644 index 0000000..4f02cfc --- /dev/null +++ b/FS/t/part_pkg-sesmon_hour.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::sesmon_hour; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-sesmon_minute.t b/FS/t/part_pkg-sesmon_minute.t new file mode 100644 index 0000000..6ceaa3c --- /dev/null +++ b/FS/t/part_pkg-sesmon_minute.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::sesmon_minute; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-sql_external.t b/FS/t/part_pkg-sql_external.t new file mode 100644 index 0000000..366ed01 --- /dev/null +++ b/FS/t/part_pkg-sql_external.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::sql_external; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-sql_generic.t b/FS/t/part_pkg-sql_generic.t new file mode 100644 index 0000000..299a7c6 --- /dev/null +++ b/FS/t/part_pkg-sql_generic.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::sql_generic; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-sqlradacct_hour.t b/FS/t/part_pkg-sqlradacct_hour.t new file mode 100644 index 0000000..2a4ed79 --- /dev/null +++ b/FS/t/part_pkg-sqlradacct_hour.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::sqlradacct_hour; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg-subscription.t b/FS/t/part_pkg-subscription.t new file mode 100644 index 0000000..10b4479 --- /dev/null +++ b/FS/t/part_pkg-subscription.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg::subscription; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_pkg_option.t b/FS/t/part_pkg_option.t new file mode 100644 index 0000000..6239b2d --- /dev/null +++ b/FS/t/part_pkg_option.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_pkg_option; +$loaded=1; +print "ok 1\n"; diff --git a/README.1.5.0pre6 b/README.1.5.0pre6 index 7e46264..f2ee7e2 100644 --- a/README.1.5.0pre6 +++ b/README.1.5.0pre6 @@ -31,7 +31,16 @@ alter table h_svc_external alter column id drop not null; INSERT INTO msgcat ( msgnum, msgcode, locale, msg ) VALUES ( 20, 'svc_external-id', 'en_US', 'External ID' ); INSERT INTO msgcat ( msgnum, msgcode, locale, msg ) VALUES ( 21, 'svc_external-title', 'en_US', 'Title' ); +CREATE TABLE part_pkg_option ( + optionnum int primary key, + pkgpart int not null, + optionname varchar(80) not null, + optionvalue text NULL +); +CREATE INDEX part_pkg_option1 ON part_pkg_option ( pkgpart ); +CREATE INDEX part_pkg_option2 ON part_pkg_option ( optionname ); + dbdef-create username -create-history-tables username cust_pay_refund cust_pay_void +create-history-tables username cust_pay_refund cust_pay_void part_pkg_option dbdef-create username diff --git a/SCHEMA_CHANGE b/SCHEMA_CHANGE new file mode 100644 index 0000000..2838598 --- /dev/null +++ b/SCHEMA_CHANGE @@ -0,0 +1,7 @@ +FS/bin/freeside-setup +httemplate/docs/upgrade10.html +README.1.5.0pre6 +httemplate/docs/schema.html +for new tables: edit FS/FS.pm, add a new FS/FS/table_name.pm + and FS/t/table_name.t, edit FS/MANIFEST + diff --git a/httemplate/browse/part_pkg.cgi b/httemplate/browse/part_pkg.cgi index be67338..48b0ab2 100755 --- a/httemplate/browse/part_pkg.cgi +++ b/httemplate/browse/part_pkg.cgi @@ -89,60 +89,59 @@ my $taxclasses = $conf->exists('enable_taxclasses'); <% foreach my $part_pkg ( sort $sortby @part_pkg ) { - my($hashref)=$part_pkg->hashref; my(@pkg_svc)=grep $_->getfield('quantity'), - qsearch('pkg_svc',{'pkgpart'=> $hashref->{pkgpart} }); + qsearch( 'pkg_svc', { 'pkgpart' => $part_pkg->pkgpart } ); my($rowspan)=scalar(@pkg_svc); my $plandata; - if ( $hashref->{plan} ) { - $plandata = $hashref->{plandata}; + if ( $part_pkg->plan ) { + $plandata = $part_pkg->plandata; $plandata =~ s/^(\w+)=/$1 /mg; $plandata =~ s/\n/<BR>/g; } else { - $hashref->{plan} = "(legacy)"; - $plandata = "Setup ". $hashref->{setup}. - "<BR>Recur ". $hashref->{recur}; + $part_pkg->plan('(legacy)'); + $plandata = "Setup ". $part_pkg->setup. + "<BR>Recur ". $part_pkg->recur; } %> <TR> - <TD ROWSPAN=<%= $rowspan %>><A HREF="<%=$p%>edit/part_pkg.cgi?<%= $hashref->{pkgpart} %>"><%= $hashref->{pkgpart} %></A></TD> + <TD ROWSPAN=<%= $rowspan %>><A HREF="<%=$p%>edit/part_pkg.cgi?<%= $part_pkg->pkgpart %>"><%= $part_pkg->pkgpart %></A></TD> <% unless ( $cgi->param('showdisabled') ) { %> <TD ROWSPAN=<%= $rowspan %>> - <% if ( $hashref->{disabled} ) { %> + <% if ( $part_pkg->disabled ) { %> DISABLED <% } %> </TD> <% } %> - <TD ROWSPAN=<%= $rowspan %>><A HREF="<%=$p%>edit/part_pkg.cgi?<%= $hashref->{pkgpart} %>"><%= $hashref->{pkg} %></A></TD> - <TD ROWSPAN=<%= $rowspan %>><%= $hashref->{comment} %></TD> + <TD ROWSPAN=<%= $rowspan %>><A HREF="<%=$p%>edit/part_pkg.cgi?<%= $part_pkg->pkgpart %>"><%= $part_pkg->pkg %></A></TD> + <TD ROWSPAN=<%= $rowspan %>><%= $part_pkg->comment %></TD> <% if ( $cgi->param('active') ) { %> <TD ROWSPAN=<%= $rowspan %>> - <FONT COLOR="#00CC00"><B><%= $num_active_cust_pkg{$hashref->{'pkgpart'}} %></B></FONT> <A HREF="<%=$p%>search/cust_pkg.cgi?magic=active;pkgpart=<%= $hashref->{pkgpart} %>">active</A><BR> + <FONT COLOR="#00CC00"><B><%= $num_active_cust_pkg{$part_pkg->pkgpart} %></B></FONT> <A HREF="<%=$p%>search/cust_pkg.cgi?magic=active;pkgpart=<%= $part_pkg->pkgpart %>">active</A><BR> <% $suspended_sth->execute( $part_pkg->pkgpart ) or die $suspended_sth->errstr; my $num_suspended = $suspended_sth->fetchrow_arrayref->[0]; %> - <FONT COLOR="#FF9900"><B><%= $num_suspended %></B></FONT> <A HREF="<%=$p%>search/cust_pkg.cgi?magic=suspended;pkgpart=<%= $hashref->{pkgpart} %>">suspended</A><BR> + <FONT COLOR="#FF9900"><B><%= $num_suspended %></B></FONT> <A HREF="<%=$p%>search/cust_pkg.cgi?magic=suspended;pkgpart=<%= $part_pkg->pkgpart %>">suspended</A><BR> <% $canceled_sth->execute( $part_pkg->pkgpart ) or die $canceled_sth->errstr; my $num_canceled = $canceled_sth->fetchrow_arrayref->[0]; %> - <FONT COLOR="#FF0000"><B><%= $num_canceled %></B></FONT> <A HREF="<%=$p%>search/cust_pkg.cgi?magic=canceled;pkgpart=<%= $hashref->{pkgpart} %>">canceled</A> + <FONT COLOR="#FF0000"><B><%= $num_canceled %></B></FONT> <A HREF="<%=$p%>search/cust_pkg.cgi?magic=canceled;pkgpart=<%= $part_pkg->pkgpart %>">canceled</A> </TD> <% } %> - <TD ROWSPAN=<%= $rowspan %>><%= $hashref->{freq} %></TD> + <TD ROWSPAN=<%= $rowspan %>><%= $part_pkg->freq_pretty %></TD> <% if ( $taxclasses ) { %> - <TD ROWSPAN=<%= $rowspan %>><%= $hashref->{taxclass} || ' ' %></TD> + <TD ROWSPAN=<%= $rowspan %>><%= $part_pkg->taxclass || ' ' %></TD> <% } %> - <TD ROWSPAN=<%= $rowspan %>><%= $hashref->{plan} %></TD> + <TD ROWSPAN=<%= $rowspan %>><%= $part_pkg->plan %></TD> <TD ROWSPAN=<%= $rowspan %>><%= $plandata %></TD> <% diff --git a/httemplate/docs/schema.html b/httemplate/docs/schema.html index 8dee8ad..85026c7 100644 --- a/httemplate/docs/schema.html +++ b/httemplate/docs/schema.html @@ -277,6 +277,13 @@ <li>plandata - additional price plan data <li>disabled - Disabled flag, empty or `Y' </ul> + <li><a name="part_pkg_option" href="man/FS/part_pkg_option.html">part_pkg_option</a> - Package definition options + <ul> + <li>optionnum - primary key + <li>pkgpart - <a href="#part_pkg">Package definition</a> + <li>optionname - option name + <li>optionvalue - option value + </ul> <li><a name="part_referral" href="man/FS/part_referral.html">part_referral</a> - Referral listing <ul> <li>refnum - primary key diff --git a/httemplate/docs/upgrade10.html b/httemplate/docs/upgrade10.html index dc60865..2f2c2da 100644 --- a/httemplate/docs/upgrade10.html +++ b/httemplate/docs/upgrade10.html @@ -181,6 +181,15 @@ CREATE TABLE cust_pay_void ( ); CREATE INDEX cust_pay_void1 ON cust_pay_void(custnum); +CREATE TABLE part_pkg_option ( + optionnum int primary key, + pkgpart int not null, + optionname varchar(80) not null, + optionvalue text NULL +); +CREATE INDEX part_pkg_option1 ON part_export_option ( pkgpart ); +CREATE INDEX part_pkg_option2 ON part_export_option ( optionname ); + DROP INDEX cust_bill_pkg1; ALTER TABLE cust_bill_pkg ADD itemdesc varchar(80) NULL; diff --git a/httemplate/edit/part_pkg.cgi b/httemplate/edit/part_pkg.cgi index 460f68b..546e071 100755 --- a/httemplate/edit/part_pkg.cgi +++ b/httemplate/edit/part_pkg.cgi @@ -42,20 +42,24 @@ unless ( $part_pkg->plan ) { #backwards-compat $action ||= $part_pkg->pkgpart ? 'Edit' : 'Add'; my $hashref = $part_pkg->hashref; +%> -print header("$action Package Definition", menubar( +<%= header("$action Package Definition", menubar( 'Main Menu' => popurl(2), 'View all packages' => popurl(2). 'browse/part_pkg.cgi', -)); -#), ' onLoad="visualize()"'); +)) %> + +<% #), ' onLoad="visualize()"'); %> -print qq!<FONT SIZE="+1" COLOR="#ff0000">Error: !, $cgi->param('error'), - "</FONT>" - if $cgi->param('error'); +<% if ( $cgi->param('error') ) { %> + <FONT SIZE="+1" COLOR="#ff0000">Error: <%= $cgi->param('error') %></FONT> +<% } %> -#print '<FORM ACTION="', popurl(1), 'process/part_pkg.cgi" METHOD=POST>'; -print '<FORM NAME="dummy">'; +<% #print '<FORM ACTION="', popurl(1), 'process/part_pkg.cgi" METHOD=POST>'; %> +<FORM NAME="dummy"> + +<% #if ( $cgi->param('clone') ) { # print qq!<INPUT TYPE="hidden" NAME="clone" VALUE="!, $cgi->param('clone'), qq!">!; #} @@ -64,29 +68,20 @@ print '<FORM NAME="dummy">'; #} # #print qq!<INPUT TYPE="hidden" NAME="pkgpart" VALUE="$hashref->{pkgpart}">!, -print "Package Part #", $hashref->{pkgpart} ? $hashref->{pkgpart} : "(NEW)"; - -#false laziness w/view/cust_main.cgi -my %freq; -tie %freq, 'Tie::IxHash', - '0' => '(no recurring fee)', - '1d' => 'daily', - '1w' => 'weekly', - '2w' => 'biweekly (every 2 weeks)', - '1' => 'monthly', - '2' => 'bimonthly (every 2 months)', - '3' => 'quarterly (every 3 months)', - '6' => 'semiannually (every 6 months)', - '12' => 'annually', - '24' => 'biannually (every 2 years)', -; -if ( $part_pkg->dbdef_table->column('freq')->type =~ /(int)/i ) { - delete $freq{$_} foreach grep { ! /^\d+$/ } keys %freq; -} - %> + +<%= itable('',8,1) %><TR><TD VALIGN="top"> + +Package information + <%= ntable("#cccccc",2) %> <TR> + <TD ALIGN="right">Package Definition #</TD> + <TD BGCOLOR="#ffffff"> + <%= $hashref->{pkgpart} ? $hashref->{pkgpart} : "(NEW)" %> + </TD> + </TR> + <TR> <TD ALIGN="right">Package (customer-visible)</TD> <TD> <INPUT TYPE="text" NAME="pkg" SIZE=32 VALUE="<%= $part_pkg->pkg %>"> @@ -98,16 +93,20 @@ if ( $part_pkg->dbdef_table->column('freq')->type =~ /(int)/i ) { <INPUT TYPE="text" NAME="comment" SIZE=32 VALUE="<%=$part_pkg->comment%>"> </TD> </TR> + <TR> - <TD ALIGN="right">Recurring fee frequency </TD> + <TD ALIGN="right">Disable new orders</TD> <TD> - <SELECT NAME="freq"> - <% foreach my $freq ( keys %freq ) { %> - <OPTION VALUE="<%= $freq %>"<%= $freq eq $part_pkg->freq ? ' SELECTED' : '' %>><%= $freq{$freq} %> - <% } %> - </SELECT> + <INPUT TYPE="checkbox" NAME="disabled" VALUE="Y"<%= $hashref->{disabled} eq 'Y' ? ' CHECKED' : '' %> </TD> </TR> + +</TABLE> + +</TD><TD VALIGN="top"> + +Tax information +<%= ntable("#cccccc", 2) %> <TR> <TD ALIGN="right">Setup fee tax exempt</TD> <TD> @@ -146,11 +145,13 @@ if ( $conf->exists('enable_taxclasses') ) { '<INPUT TYPE="hidden" NAME="taxclass" VALUE="'. $hashref->{taxclass}. '">'; } -print '<TR><TD ALIGN="right">Disable new orders</TD><TD>'; -print '<INPUT TYPE="checkbox" NAME="disabled" VALUE="Y"'; -print ' CHECKED' if $hashref->{disabled} eq "Y"; -print '>'; -print '</TD></TR></TABLE>'; +%> + +</TABLE> + +</TD></TR></TABLE> + +<% my $thead = "\n\n". ntable('#cccccc', 2). '<TR><TH BGCOLOR="#dcdcdc"><FONT SIZE=-1>Quan.</FONT></TH>'; @@ -162,8 +163,8 @@ $thead .= '<TH BGCOLOR="#dcdcdc">Service</TH></TR>'; #dunno why... unless ( 0 ) { #print <<END, $thead; - print <<END, itable(), '<TR><TD VALIGN="top">', $thead; -<BR><BR>Enter the quantity of each service this package includes.<BR><BR> + print <<END, itable('', 4, 1), '<TR><TD VALIGN="top">', $thead; +<BR><BR>Services included END } @@ -226,294 +227,7 @@ foreach my $f ( qw( clone pkgnum ) ) { print '<INPUT TYPE="hidden" NAME="pkgpart" VALUE="'. $part_pkg->pkgpart. '">'; # prolly should be in database -tie my %plans, 'Tie::IxHash', - 'flat' => { - 'name' => 'Flat rate (anniversary billing)', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_fee' => { 'name' => 'Recurring fee for this package', - 'default' => 0, - }, - }, - 'fieldorder' => [ 'setup_fee', 'recur_fee' ], - 'setup' => 'what.setup_fee.value', - 'recur' => 'what.recur_fee.value', - }, - - 'flat_delayed' => { - 'name' => 'Free for X days, then flat rate (anniversary billing)', - 'fields' => { - 'free_days' => { 'name' => 'Initial free days', - 'default' => 0, - }, - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_fee' => { 'name' => 'Recurring fee for this package', - 'default' => 0, - }, - }, - 'fieldorder' => [ 'free_days', 'setup_fee', 'recur_fee' ], - 'setup' => '\'my $d = $cust_pkg->bill || $time; $d += 86400 * \' + what.free_days.value + \'; $cust_pkg->bill($d); $cust_pkg_mod_flag=1; \' + what.setup_fee.value', - 'recur' => 'what.recur_fee.value', - }, - - 'prorate' => { - 'name' => 'First partial month pro-rated, then flat-rate (1st of month billing)', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_fee' => { 'name' => 'Recurring fee for this package', - 'default' => 0, - }, - }, - 'fieldorder' => [ 'setup_fee', 'recur_fee' ], - 'setup' => 'what.setup_fee.value', - 'recur' => '\'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 ) * \' + what.recur_fee.value + \' / $part_pkg->freq + \' + what.recur_fee.value + \' / $part_pkg->freq * ($mend-$mnow) / ($mend-$mstart) ; \'', - }, - - 'subscription' => { - 'name' => 'First partial month full charge, then flat-rate (1st of month billing)', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_fee' => { 'name' => 'Recurring fee for this package', - 'default' => 0, - }, - }, - 'fieldorder' => [ 'setup_fee', 'recur_fee' ], - 'setup' => 'what.setup_fee.value', - 'recur' => '\'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); \' + what.recur_fee.value', - }, - - 'flat_comission_cust' => { - 'name' => 'Flat rate with recurring commission per active customer', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_fee' => { 'name' => 'Recurring fee for this package', - 'default' => 0, - }, - 'comission_amount' => { 'name' => 'Commission amount per month (per active customer)', - 'default' => 0, - }, - 'comission_depth' => { 'name' => 'Number of layers', - 'default' => 1, - }, - }, - 'fieldorder' => [ 'setup_fee', 'recur_fee', 'comission_depth', 'comission_amount' ], - 'setup' => 'what.setup_fee.value', - 'recur' => '\'my $error = $cust_pkg->cust_main->credit( \' + what.comission_amount.value + \' * scalar($cust_pkg->cust_main->referral_cust_main_ncancelled(\' + what.comission_depth.value+ \')), "commission" ); die $error if $error; \' + what.recur_fee.value + \';\'', - }, - - 'flat_comission' => { - 'name' => 'Flat rate with recurring commission per (any) active package', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_fee' => { 'name' => 'Recurring fee for this package', - 'default' => 0, - }, - 'comission_amount' => { 'name' => 'Commission amount per month (per active package)', - 'default' => 0, - }, - 'comission_depth' => { 'name' => 'Number of layers', - 'default' => 1, - }, - }, - 'fieldorder' => [ 'setup_fee', 'recur_fee', 'comission_depth', 'comission_amount' ], - 'setup' => 'what.setup_fee.value', - 'recur' => '\'my $error = $cust_pkg->cust_main->credit( \' + what.comission_amount.value + \' * scalar($cust_pkg->cust_main->referral_cust_pkg(\' + what.comission_depth.value+ \')), "commission" ); die $error if $error; \' + what.recur_fee.value + \';\'', - }, - - 'flat_comission_pkg' => { - 'name' => 'Flat rate with recurring commission per (selected) active package', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_fee' => { 'name' => 'Recurring fee for this package', - 'default' => 0, - }, - 'comission_amount' => { 'name' => 'Commission amount per month (per uncancelled package)', - 'default' => 0, - }, - 'comission_depth' => { 'name' => 'Number of layers', - 'default' => 1, - }, - 'comission_pkgpart' => { 'name' => 'Applicable packages<BR><FONT SIZE="-1">(hold <b>ctrl</b> to select multiple packages)</FONT>', - 'type' => 'select_multiple', - 'select_table' => 'part_pkg', - 'select_hash' => { 'disabled' => '' } , - 'select_key' => 'pkgpart', - 'select_label' => 'pkg', - }, - }, - 'fieldorder' => [ 'setup_fee', 'recur_fee', 'comission_depth', 'comission_amount', 'comission_pkgpart' ], - 'setup' => 'what.setup_fee.value', - 'recur' => '""; var pkgparts = ""; for ( var c=0; c < document.flat_comission_pkg.comission_pkgpart.options.length; c++ ) { if (document.flat_comission_pkg.comission_pkgpart.options[c].selected) { pkgparts = pkgparts + document.flat_comission_pkg.comission_pkgpart.options[c].value + \', \'; } } what.recur.value = \'my $error = $cust_pkg->cust_main->credit( \' + what.comission_amount.value + \' * scalar( grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } ( \' + pkgparts + \' ) } $cust_pkg->cust_main->referral_cust_pkg(\' + what.comission_depth.value+ \')), "commission" ); die $error if $error; \' + what.recur_fee.value + \';\'', - }, - - - - 'sesmon_hour' => { - 'name' => 'Base charge plus charge per-hour from the session monitor', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_flat' => { 'name' => 'Base monthly charge for this package', - 'default' => 0, - }, - 'recur_included_hours' => { 'name' => 'Hours included', - 'default' => 0, - }, - 'recur_hourly_charge' => { 'name' => 'Additional charge per hour', - 'default' => 0, - }, - }, - 'fieldorder' => [ 'setup_fee', 'recur_flat', 'recur_included_hours', 'recur_hourly_charge' ], - 'setup' => 'what.setup_fee.value', - 'recur' => '\'my $hours = $cust_pkg->seconds_since($cust_pkg->bill || 0) / 3600 - \' + what.recur_included_hours.value + \'; $hours = 0 if $hours < 0; \' + what.recur_flat.value + \' + \' + what.recur_hourly_charge.value + \' * $hours;\'', - }, - - 'sesmon_minute' => { - 'name' => 'Base charge plus charge per-minute from the session monitor', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_flat' => { 'name' => 'Base monthly charge for this package', - 'default' => 0, - }, - 'recur_included_min' => { 'name' => 'Minutes included', - 'default' => 0, - }, - 'recur_minly_charge' => { 'name' => 'Additional charge per minute', - 'default' => 0, - }, - }, - 'fieldorder' => [ 'setup_fee', 'recur_flat', 'recur_included_min', 'recur_minly_charge' ], - 'setup' => 'what.setup_fee.value', - 'recur' => '\'my $min = $cust_pkg->seconds_since($cust_pkg->bill || 0) / 60 - \' + what.recur_included_min.value + \'; $min = 0 if $min < 0; \' + what.recur_flat.value + \' + \' + what.recur_minly_charge.value + \' * $min;\'', - - }, - - 'sqlradacct_hour' => { - 'name' => 'Base charge plus charge per-hour (and for data) from an external sqlradius radacct table', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_flat' => { 'name' => 'Base monthly charge for this package', - 'default' => 0, - }, - 'recur_included_hours' => { 'name' => 'Hours included', - 'default' => 0, - }, - 'recur_hourly_charge' => { 'name' => 'Additional charge per hour', - 'default' => 0, - }, - 'recur_included_input' => { 'name' => 'Input megabytes included', - 'default' => 0, - }, - 'recur_input_charge' => { 'name' => - 'Additional charge per input megabyte', - 'default' => 0, - }, - 'recur_included_output' => { 'name' => 'Output megabytes included', - 'default' => 0, - }, - 'recur_output_charge' => { 'name' => - 'Additional charge per output megabyte', - 'default' => 0, - }, - 'recur_included_total' => { 'name' => - 'Total input+output megabytes included', - 'default' => 0, - }, - 'recur_total_charge' => { 'name' => - 'Additional charge per input+output megabyte', - 'default' => 0, - }, - }, - 'fieldorder' => [qw( setup_fee recur_flat recur_included_hours recur_hourly_charge recur_included_input recur_input_charge recur_included_output recur_output_charge recur_included_total recur_total_charge )], - 'setup' => 'what.setup_fee.value', - 'recur' => '\'my $last_bill = $cust_pkg->last_bill; my $hours = $cust_pkg->seconds_since_sqlradacct($last_bill, $sdate ) / 3600 - \' + what.recur_included_hours.value + \'; $hours = 0 if $hours < 0; my $input = $cust_pkg->attribute_since_sqlradacct($last_bill, $sdate, \"AcctInputOctets\" ) / 1048576; my $output = $cust_pkg->attribute_since_sqlradacct($last_bill, $sdate, \"AcctOutputOctets\" ) / 1048576; my $total = $input + $output - \' + what.recur_included_total.value + \'; $total = 0 if $total < 0; my $input = $input - \' + what.recur_included_input.value + \'; $input = 0 if $input < 0; my $output = $output - \' + what.recur_included_output.value + \'; $output = 0 if $output < 0; my $totalcharge = sprintf(\"%.2f\", \' + what.recur_total_charge.value + \' * $total); my $inputcharge = sprintf(\"%.2f\", \' + what.recur_input_charge.value + \' * $input); my $outputcharge = sprintf(\"%.2f\", \' + what.recur_output_charge.value + \' * $output); my $hourscharge = sprintf(\"%.2f\", \' + what.recur_hourly_charge.value + \' * $hours); if ( \' + what.recur_total_charge.value + \' > 0 ) { push @details, \"Last month\\\'s data \". sprintf(\"%.1f\", $total). \" megs: \\\$$totalcharge\" } if ( \' + what.recur_input_charge.value + \' > 0 ) { push @details, \"Last month\\\'s download \". sprintf(\"%.1f\", $input). \" megs: \\\$$inputcharge\" } if ( \' + what.recur_output_charge.value + \' > 0 ) { push @details, \"Last month\\\'s upload \". sprintf(\"%.1f\", $output). \" megs: \\\$$outputcharge\" } if ( \' + what.recur_hourly_charge.value + \' > 0 ) { push @details, \"Last month\\\'s time \". sprintf(\"%.1f\", $hours). \" hours: \\\$$hourscharge\"; } \' + what.recur_flat.value + \' + $hourscharge + $inputcharge + $outputcharge + $totalcharge ;\'', - }, - - 'sql_generic' => { - 'name' => 'Base charge plus a metered rate from a configurable SQL query', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_flat' => { 'name' => 'Base monthly charge for this package', - 'default' => 0, - }, - 'recur_included' => { 'name' => 'Units included', - 'default' => 0, - }, - 'recur_unit_charge' => { 'name' => 'Additional charge per unit', - 'default' => 0, - }, - 'datasrc' => { 'name' => 'DBI data source', - 'default' => '', - }, - 'db_username' => { 'name' => 'Database username', - 'default' => '', - }, - 'db_password' => { 'name' => 'Database username', - 'default' => '', - }, - 'query' => { 'name' => 'SQL query', - 'default' => '', - }, - }, - 'fieldorder' => [qw( setup_fee recur_flat recur_included recur_unit_charge datasrc db_username db_password query )], - 'setup' => 'what.setup_fee.value', - # 'recur' => '\'my $dbh = DBI->connect(\"\' + what.datasrc.value + \'\", \"\' + what.db_username.value + \'\") or die $DBI::errstr; \'', - 'recur' => '\'my $dbh = DBI->connect(\"\' + what.datasrc.value + \'\", \"\' + what.db_username.value + \'\", \"\' + what.db_password.value + \'\" ) or die $DBI::errstr; my $sth = $dbh->prepare(\"\' + what.query.value + \'\") or die $dbh->errstr; my $units = 0; foreach my $cust_svc ( grep { $_->part_svc->svcdb eq \"svc_domain\" } $cust_pkg->cust_svc ) { my $domain = $cust_svc->svc_x->domain; $sth->execute($domain) or die $sth->errstr; $units += $sth->fetchrow_arrayref->[0]; } $units -= \' + what.recur_included.value + \'; $units = 0 if $units < 0; \' + what.recur_flat.value + \' + $units * \' + what.recur_unit_charge.value + \';\'', - #'recur' => '\'my $dbh = DBI->connect("\' + what.datasrc.value + \'", "\' + what.db_username.value + \'", "\' what.db_password.value + \'" ) or die $DBI::errstr; my $sth = $dbh->prepare("\' + what.query.value + \'") or die $dbh->errstr; my $units = 0; foreach my $cust_svc ( grep { $_->part_svc->svcdb eq "svc_domain" } $cust_pkg->cust_svc ) { my $domain = $cust_svc->svc_x->domain; $sth->execute($domain) or die $sth->errstr; $units += $sth->fetchrow_arrayref->[0]; } $units -= \' + what.recur_included.value + \'; $units = 0 if $units < 0; \' + what.recur_flat.value + \' + $units * \' + what.recur_unit_charge + \';\'', - }, - - - - 'sql_external' => { - 'name' => 'Base charge plus additional fees for external services from a configurable SQL query', - 'fields' => { - 'setup_fee' => { 'name' => 'Setup fee for this package', - 'default' => 0, - }, - 'recur_flat' => { 'name' => 'Base monthly charge for this package', - 'default' => 0, - }, - 'datasrc' => { 'name' => 'DBI data source', - 'default' => '', - }, - 'db_username' => { 'name' => 'Database username', - 'default' => '', - }, - 'db_password' => { 'name' => 'Database password', - 'default' => '', - }, - 'query' => { 'name' => 'SQL query', - 'default' => '', - }, - }, - 'fieldorder' => [qw( setup_fee recur_flat datasrc db_username db_password query )], - 'setup' => 'what.setup_fee.value', - 'recur' => q!'my $dbh = DBI->connect("' + what.datasrc.value + '", "' + what.db_username.value + '", "' + what.db_password.value + '" ) or die $DBI::errstr; my $sth = $dbh->prepare("' + what.query.value + '") or die $dbh->errstr; my $price = ' + what.recur_flat.value + '; foreach my $cust_svc ( grep { $_->part_svc->svcdb eq "svc_external" } $cust_pkg->cust_svc ){ my $id = $cust_svc->svc_x->id; $sth->execute($id) or die $sth->errstr; $price += $sth->fetchrow_arrayref->[0]; } $price;'!, - - }, - -; +tie my %plans, 'Tie::IxHash', %{ FS::part_pkg::plan_info() }; my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); } split("\n", $part_pkg->plandata ); @@ -532,30 +246,40 @@ if ( dbdef->table('pkg_svc')->column('primary_svc') ) { push @form_radio, 'pkg_svc_primary'; } +tie my %freq, 'Tie::IxHash', %FS::part_pkg::freq; +if ( $part_pkg->dbdef_table->column('freq')->type =~ /(int)/i ) { + delete $freq{$_} foreach grep { ! /^\d+$/ } keys %freq; +} + my $widget = new HTML::Widgets::SelectLayers( 'selected_layer' => $part_pkg->plan, 'options' => \%options, 'form_name' => 'dummy', 'form_action' => 'process/part_pkg.cgi', - 'form_text' => [ qw(pkg comment freq clone pkgnum pkgpart), @fixups ], + 'form_text' => [ qw(pkg comment clone pkgnum pkgpart), @fixups ], 'form_checkbox' => [ qw(setuptax recurtax disabled) ], 'form_radio' => \@form_radio, 'form_select' => \@form_select, - 'fixup_callback' => sub { - #my $ = @_; - my $html = ''; - for my $p ( keys %plans ) { - $html .= "if ( what.plan.value == \"$p\" ) { - what.setup.value = $plans{$p}->{setup} ; - what.recur.value = $plans{$p}->{recur} ; - }\n"; - } - $html; - }, 'layer_callback' => sub { my $layer = shift; my $html = qq!<INPUT TYPE="hidden" NAME="plan" VALUE="$layer">!. ntable("#cccccc",2); + $html .= ' + <TR> + <TD ALIGN="right">Recurring fee frequency </TD> + <TD><SELECT NAME="freq"> + '; + + my @freq = keys %freq; + @freq = grep { /^\d+$/ } @freq + if exists($plans{$layer}->{'freq'}) && $plans{$layer}->{'freq'} eq 'm'; + foreach my $freq ( @freq ) { + $html .= qq(<OPTION VALUE="$freq"); + $html .= ' SELECTED' if $freq eq $part_pkg->freq; + $html .= ">$freq{$freq}"; + } + $html .= '</SELECT></TD></TR>'; + my $href = $plans{$layer}->{'fields'}; foreach my $field ( exists($plans{$layer}->{'fieldorder'}) ? @{$plans{$layer}->{'fieldorder'}} @@ -598,22 +322,6 @@ my $widget = new HTML::Widgets::SelectLayers( ( $hashref->{pkgpart} ? "Apply changes" : "Add package" ). '" onClick="fchanged(this)">'; - $html .= '<BR><BR>don\'t edit this unless you know what you\'re doing '. - '<INPUT TYPE="button" VALUE="refresh expressions" '. - 'onClick="fchanged(this)">'. - ntable("#cccccc",2). - '<TR><TD>'. - '<FONT SIZE="1">Setup expression<BR>'. - '<INPUT TYPE="text" NAME="setup" SIZE="160" VALUE="'. - encode_entities($hashref->{setup}). '" onLoad="fchanged(this)">'. - '</FONT><BR>'. - '<FONT SIZE="1">Recurring espression<BR>'. - '<INPUT TYPE="text" NAME="recur" SIZE="160" VALUE="'. - encode_entities($hashref->{recur}). '" onLoad="fchanged(this)">'. - '</FONT>'. - '</TR></TD>'. - '</TABLE>'; - $html; }, @@ -621,7 +329,6 @@ my $widget = new HTML::Widgets::SelectLayers( %> -<BR> -Price plan <%= $widget->html %> +<BR><BR>Price plan <%= $widget->html %> </BODY> </HTML> diff --git a/httemplate/view/cust_main.cgi b/httemplate/view/cust_main.cgi index 0b51a87..9aa0089 100755 --- a/httemplate/view/cust_main.cgi +++ b/httemplate/view/cust_main.cgi @@ -411,27 +411,13 @@ foreach my $pkg (sort pkgsort_pkgnum_cancel @$packages) { #} print "<TD ROWSPAN=$rowspan>". &itable(''); - sub freq { - - #false laziness w/edit/part_pkg.cgi - my %freq = ( #move this - '1d' => 'daily', - '1w' => 'weekly', - '2w' => 'biweekly (every 2 weeks)', - '1' => 'monthly', - '2' => 'bimonthly (every 2 months)', - '3' => 'quarterly (every 3 months)', - '6' => 'semiannually (every 6 months)', - '12' => 'annually', - '24' => 'biannually (every 2 years)', - ); - - my $freq = shift; - exists $freq{$freq} ? $freq{$freq} : "every $freq months"; + sub myfreq { + my $part_pkg = shift; + my $freq = $part_pkg->freq_pretty; + $freq =~ s/ / /g; + $freq; } - #eomove - if ( $pkg->{cancel} ) { #status: cancelled print '<TR><TD><FONT COLOR="#ff0000"><B>Cancelled </B></FONT></TD>'. @@ -480,7 +466,7 @@ foreach my $pkg (sort pkgsort_pkgnum_cancel @$packages) { print '<TR><TD COLSPAN=2>( '. pkg_cancel_link($pkg). ' )</TD</TR>'; } else { - print 'billed '. freq($pkg->{freq}). ')</TD></TR>'; + print 'billed '. myfreq($pkg->{part_pkg}). ')</TD></TR>'; } } else { #setup @@ -491,7 +477,7 @@ foreach my $pkg (sort pkgsort_pkgnum_cancel @$packages) { pkg_datestr($pkg,'setup',$conf). '</TD></TR>'; } else { print '<TR><TD COLSPAN=2><FONT COLOR="#00CC00"><B>Active</B></FONT>'. - ', billed '. freq($pkg->{freq}). '</TD></TR>'. + ', billed '. myfreq($pkg->{part_pkg}). '</TD></TR>'. '<TR><TD>Setup </TD><TD>'. pkg_datestr($pkg, 'setup',$conf). '</TD></TR>'; } @@ -900,8 +886,13 @@ sub get_packages { ) { my $part_pkg = $cust_pkg->part_pkg; - + my %pkg = (); + + #to get back to the original object... should use it in the first place!! + $pkg{cust_pkg} = $cust_pkg; + $pkg{part_pkg} = $part_pkg; + $pkg{pkgnum} = $cust_pkg->pkgnum; $pkg{pkg} = $part_pkg->pkg; $pkg{pkgpart} = $part_pkg->pkgpart; @@ -913,6 +904,7 @@ sub get_packages { $pkg{susp} = $cust_pkg->getfield('susp'); $pkg{expire} = $cust_pkg->getfield('expire'); $pkg{cancel} = $cust_pkg->getfield('cancel'); + my %svcparts = map { $_->svcpart => { |