From 477015901c379f8cd6ba46cfaa4a9ae284ae582d Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 15 Apr 2008 13:42:40 +0000 Subject: [PATCH] new package editor --- FS/FS/Schema.pm | 12 + FS/FS/cust_event.pm | 1 + FS/FS/cust_main.pm | 29 +- FS/FS/cust_pkg.pm | 22 +- FS/FS/option_Common.pm | 4 +- FS/FS/part_event_option.pm | 1 + FS/FS/part_pkg.pm | 188 ++++-- FS/FS/svc_Common.pm | 20 +- FS/FS/svc_acct.pm | 14 +- FS/FS/svc_domain.pm | 8 +- httemplate/edit/elements/edit.html | 219 +++++-- httemplate/edit/part_event.html | 16 +- httemplate/edit/part_pkg.cgi | 860 +++++++++++-------------- httemplate/edit/process/elements/process.html | 64 +- httemplate/edit/process/part_pkg.cgi | 218 ++++--- httemplate/elements/select-agent_types.html | 30 + httemplate/elements/select-taxproduct.html | 3 + httemplate/elements/selectlayers.html | 8 +- httemplate/elements/tr-input-text.html | 8 +- httemplate/elements/tr-part_pkg_freq.html | 19 +- httemplate/elements/tr-pkg_svc.html | 93 +++ httemplate/elements/tr-select-agent_types.html | 19 + httemplate/elements/tr-title.html | 12 +- 23 files changed, 1060 insertions(+), 808 deletions(-) create mode 100644 httemplate/elements/select-agent_types.html create mode 100644 httemplate/elements/tr-pkg_svc.html create mode 100644 httemplate/elements/tr-select-agent_types.html diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index d4a51a60d..2666c533a 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -1007,6 +1007,18 @@ sub tables_hashref { 'index' => [ [ 'promo_code' ], [ 'disabled' ], [ 'agentnum' ], ], }, + 'part_pkg_link' => { + 'columns' => [ + 'pkglinknum', 'serial', '', '', '', '', + 'src_pkgpart', 'int', '', '', '', '', + 'dst_pkgpart', 'int', '', '', '', '', + 'link_type', 'varchar', '', $char_d, '', '', + ], + 'primary_key' => 'pkglinknum', + 'unique' => [ [ 'src_pkgpart', 'dst_pkgpart', 'link_type' ] ], + 'index' => [ [ 'src_pkgpart' ] ], + }, + 'part_pkg_taxclass' => { 'columns' => [ 'taxclassnum', 'serial', '', '', '', '', diff --git a/FS/FS/cust_event.pm b/FS/FS/cust_event.pm index 5924851fd..5ca816752 100644 --- a/FS/FS/cust_event.pm +++ b/FS/FS/cust_event.pm @@ -344,6 +344,7 @@ sub process_re_X { } +#this needs some updating based on the 1.7 cust_bill_event.pm still, i think sub re_X { my($method, $beginning, $ending, $failed, $job) = @_; diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index ceefeaf69..3490e46d2 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -8,6 +8,7 @@ use vars qw( $realtime_bop_decline_quiet ); #ugh use Safe; use Carp; use Exporter; +use Scalar::Util qw( blessed ); use Time::Local qw(timelocal_nocheck); use Data::Dumper; use Tie::IxHash; @@ -1052,7 +1053,7 @@ sub delete { } -=item replace OLD_RECORD [ INVOICING_LIST_ARYREF ] +=item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. @@ -1068,23 +1069,16 @@ check_invoicing_list first. Here's an example: sub replace { my $self = shift; - my $old = shift; + + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $self->replace_old; + my @param = @_; + warn "$me replace called\n" if $DEBUG; - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - # We absolutely have to have an old vs. new record to make this work. - if (!defined($old)) { - $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); - } - my $curuser = $FS::CurrentUser::CurrentUser; if ( $self->payby eq 'COMP' && $self->payby ne $old->payby @@ -1099,6 +1093,13 @@ sub replace { && $self->payby =~ /^(CARD|DCRD)$/ && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask ); + 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; diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index d41359634..09808a45f 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -2,6 +2,7 @@ package FS::cust_pkg; use strict; use vars qw(@ISA $disable_agentcheck $DEBUG); +use Scalar::Util qw( blessed ); use List::Util qw(max); use Tie::IxHash; use FS::UID qw( getotaker dbh ); @@ -301,12 +302,17 @@ Calls =cut sub replace { - my( $new, $old, %options ) = @_; + my $new = shift; + + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $new->replace_old; + + my $options = + ( ref($_[0]) eq 'HASH' ) + ? shift + : { @_ }; - # We absolutely have to have an old vs. new record to make this work. - if (!defined($old)) { - $old = qsearchs( 'cust_pkg', { 'pkgnum' => $new->pkgnum } ); - } #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart; return "Can't change otaker!" if $old->otaker ne $new->otaker; @@ -331,8 +337,8 @@ sub replace { my $dbh = dbh; foreach my $method ( qw(adjourn expire) ) { # How many reasons? - if ($options{'reason'} && $new->$method && $old->$method ne $new->$method) { - my $error = $new->insert_reason( 'reason' => $options{'reason'}, + if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) { + my $error = $new->insert_reason( 'reason' => $options->{'reason'}, 'date' => $new->$method, ); if ( $error ) { @@ -357,7 +363,7 @@ sub replace { } my $error = $new->SUPER::replace($old, - $options{options} ? ${options{options}} : () + $options->{options} ? $options->{options} : () ); if ( $error ) { $dbh->rollback if $oldAutoCommit; diff --git a/FS/FS/option_Common.pm b/FS/FS/option_Common.pm index 441e798d2..a786ae3fa 100644 --- a/FS/FS/option_Common.pm +++ b/FS/FS/option_Common.pm @@ -161,8 +161,8 @@ sub delete { Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. -If a list hash reference of options is supplied, option records are created or -modified. +If a list or hash reference of options is supplied, option records are created +or modified. =cut diff --git a/FS/FS/part_event_option.pm b/FS/FS/part_event_option.pm index 43e1da933..09b775609 100644 --- a/FS/FS/part_event_option.pm +++ b/FS/FS/part_event_option.pm @@ -2,6 +2,7 @@ package FS::part_event_option; use strict; use vars qw( @ISA ); +use Scalar::Util qw( blessed ); use FS::UID qw( dbh ); use FS::Record qw( qsearch qsearchs ); use FS::part_event; diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 1e16f29e7..cffdc8857 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -3,6 +3,7 @@ package FS::part_pkg; use strict; use vars qw( @ISA %plans $DEBUG ); use Carp qw(carp cluck confess); +use Scalar::Util qw( blessed ); use Tie::IxHash; use FS::Conf; use FS::Record qw( qsearch qsearchs dbh dbdef ); @@ -16,11 +17,9 @@ use FS::pkg_class; use FS::agent; use FS::part_pkg_taxoverride; use FS::part_pkg_taxproduct; +#XXX#use FS::part_pkg_link; -@ISA = qw( FS::m2m_Common FS::Record ); # FS::option_Common ); # this can use option_Common - # when all the plandata bs is - # gone - +@ISA = qw( FS::m2m_Common FS::option_Common ); $DEBUG = 0; =head1 NAME @@ -168,61 +167,13 @@ 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; + my $error = $self->SUPER::insert( $options{options} ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - 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; - } - } - - } elsif ( $options{'options'} ) { - - warn " inserting part_pkg_option records for options hashref" if $DEBUG; - foreach my $optionname ( keys %{$options{'options'}} ) { - - my $part_pkg_option = - new FS::part_pkg_option { - 'pkgpart' => $self->pkgpart, - 'optionname' => $optionname, - 'optionvalue' => $options{'options'}->{$optionname}, - }; - - 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" @@ -314,16 +265,19 @@ FS::pkg_svc record will be updated. =cut sub replace { - my( $new, $old ) = ( shift, shift ); - my %options = @_; + my $new = shift; - # We absolutely have to have an old vs. new record to make this work. - if (!defined($old)) { - $old = qsearchs( 'part_pkg', { 'pkgpart' => $new->pkgpart } ); - } + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $new->replace_old; - warn "FS::part_pkg::replace called on $new to replace $old ". - "with options %options" + my $options = + ( ref($_[0]) eq 'HASH' ) + ? shift + : { @_ }; + + warn "FS::part_pkg::replace called on $new to replace $old with options". + join(', ', map "$_ => ". $options->{$_}, keys %$options) if $DEBUG; local $SIG{HUP} = 'IGNORE'; @@ -337,6 +291,8 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + #plandata shit stays in replace for upgrades until after 2.0 (or edit + #_upgrade_data) warn " saving legacy plandata" if $DEBUG; my $plandata = $new->get('plandata'); $new->set('plandata', ''); @@ -351,13 +307,13 @@ sub replace { } warn " replacing part_pkg record" if $DEBUG; - my $error = $new->SUPER::replace($old); + my $error = $new->SUPER::replace($old, $options->{options} ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - warn " inserting part_pkg_option records for plandata" if $DEBUG; + warn " inserting part_pkg_option records for plandata: $plandata|" if $DEBUG; foreach my $part_pkg_option ( map { /^(\w+)=(.*)$/ or do { $dbh->rollback if $oldAutoCommit; return "illegal plandata: $plandata"; @@ -378,10 +334,10 @@ sub replace { } warn " replacing pkg_svc records" if $DEBUG; - my $pkg_svc = $options{'pkg_svc'} || {}; + my $pkg_svc = $options->{'pkg_svc'} || {}; foreach my $part_svc ( qsearch('part_svc', {} ) ) { my $quantity = $pkg_svc->{$part_svc->svcpart} || 0; - my $primary_svc = $options{'primary_svc'} == $part_svc->svcpart ? 'Y' : ''; + my $primary_svc = $options->{'primary_svc'} == $part_svc->svcpart ? 'Y' : ''; my $old_pkg_svc = qsearchs('pkg_svc', { 'pkgpart' => $old->pkgpart, @@ -429,7 +385,8 @@ sub check { for (qw(setup recur plandata)) { #$self->set($_=>0) if $self->get($_) =~ /^\s*$/; } - return "Use of $_ field is deprecated; set a plan and options" + return "Use of $_ field is deprecated; set a plan and options: ". + $self->get($_) if length($self->get($_)); $self->set($_, ''); } @@ -476,6 +433,22 @@ sub check { ''; } +=item pkg_comment + +Returns an (internal) string representing this package. Currently, +"pkgpart: pkg - comment", is returned. "pkg - comment" may be returned in the +future, omitting pkgpart. + +=cut + +sub pkg_comment { + my $self = shift; + + #$self->pkg. ' - '. $self->comment; + #$self->pkg. ' ('. $self->comment. ')'; + $self->pkgpart. ': '. $self->pkg. ' - '. $self->comment; +} + =item pkg_class Returns the package class, as an FS::pkg_class object, or the empty string @@ -728,9 +701,20 @@ sub option { ''; } +=item dst_pkgpart + +=cut + +sub part_pkg_link { + (); + #XXX + #my $self = shift; + #qsearch('part_pkg_link', { 'src_pkgpart' => $self->pkgpart } ); +} + =item part_pkg_taxoverride -Returns all options as FS::part_pkg_taxoverride objects (see +Returns all associated FS::part_pkg_taxoverride objects (see L). =cut @@ -799,7 +783,7 @@ sub _rebless { my $self = shift; my $plan = $self->plan; unless ( $plan ) { - confess "no price plan found for pkgpart ". $self->pkgpart. "\n" + cluck "no price plan found for pkgpart ". $self->pkgpart. "\n" if $DEBUG; return $self; } @@ -849,6 +833,74 @@ sub calc_cancel { 0; } =back +=cut + +# _upgrade_data +# +# Used by FS::Upgrade to migrate to a new database. + +sub _upgrade_data { # class method + my($class, %opts) = @_; + + warn "[FS::part_pkg] upgrading $class\n" if $DEBUG; + + my @part_pkg = qsearch({ + 'table' => 'part_pkg', + 'extra_sql' => "WHERE ". join(' OR ', + ( map "($_ IS NOT NULL AND $_ != '' )", + qw( plandata setup recur ) ), + 'plan IS NULL', "plan = '' ", + ), + }); + + foreach my $part_pkg (@part_pkg) { + + unless ( $part_pkg->plan ) { + + $part_pkg->plan('flat'); + + if ( $part_pkg->setup =~ /^\s*([\d\.]+)\s*$/ ) { + + my $opt = new FS::part_pkg_option { + 'pkgpart' => $part_pkg->pkgpart, + 'optionname' => 'setup_fee', + 'optionvalue' => $1, + }; + my $error = $opt->insert; + die $error if $error; + + $part_pkg->setup(''); + + } else { + die "Can't parse part_pkg.setup for fee; convert pkgnum ". + $part_pkg->pkgnum. " manually: ". $part_pkg->setup. "\n"; + } + + if ( $part_pkg->recur =~ /^\s*([\d\.]+)\s*$/ ) { + + my $opt = new FS::part_pkg_option { + 'pkgpart' => $part_pkg->pkgpart, + 'optionname' => 'recur_fee', + 'optionvalue' => $1, + }; + my $error = $opt->insert; + die $error if $error; + + $part_pkg->recur(''); + + } else { + die "Can't parse part_pkg.setup for fee; convert pkgnum ". + $part_pkg->pkgnum. " manually: ". $part_pkg->setup. "\n"; + } + + } + + $part_pkg->replace; #this should take care of plandata, right? + + } + +} + =head1 SUBROUTINES =over 4 diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm index d830f2fad..31e53dbd3 100644 --- a/FS/FS/svc_Common.pm +++ b/FS/FS/svc_Common.pm @@ -3,6 +3,7 @@ package FS::svc_Common; use strict; use vars qw( @ISA $noexport_hack $DEBUG $me ); use Carp qw( cluck carp croak ); #specify cluck have to specify them all.. +use Scalar::Util qw( blessed ); use FS::Record qw( qsearch qsearchs fields dbh ); use FS::cust_main_Mixin; use FS::cust_svc; @@ -359,7 +360,7 @@ sub delete { ''; } -=item replace OLD_RECORD +=item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ] Replaces OLD_RECORD with this one. If there is an error, returns the error, otherwise returns false. @@ -367,8 +368,16 @@ otherwise returns false. =cut sub replace { - my ($new, $old) = (shift, shift); - my %options = @_; + my $new = shift; + + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $new->replace_old; + + my $options = + ( ref($_[0]) eq 'HASH' ) + ? shift + : { @_ }; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -381,9 +390,6 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - # We absolutely have to have an old vs. new record to make this work. - $old = $new->replace_old unless defined($old); - my $error = $new->set_auto_inventory; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -399,7 +405,7 @@ sub replace { #new-style exports! unless ( $noexport_hack ) { - my $export_args = $options{'export_args'} || []; + my $export_args = $options->{'export_args'} || []; #not quite false laziness, but same pattern as FS::svc_acct::replace and #FS::part_export::sqlradius::_export_replace. List::Compare or something diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 4343df5cc..3e3ecb5bd 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -14,6 +14,7 @@ use vars qw( @ISA $DEBUG $me $conf $skip_fuzzyfiles $radius_password $radius_ip $dirhash @saltset @pw_set ); +use Scalar::Util qw( blessed ); use Carp; use Fcntl qw(:flock); use Date::Format; @@ -734,14 +735,15 @@ contain an arrayref of group names. See L. =cut sub replace { - my ( $new, $old ) = ( shift, shift ); - my $error; + my $new = shift; + + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $new->replace_old; + warn "$me replacing $old with $new\n" if $DEBUG; - # We absolutely have to have an old vs. new record to make this work. - if (!defined($old)) { - $old = qsearchs( 'svc_acct', { 'svcnum' => $new->svcnum } ); - } + my $error; return "can't modify system account" if $old->_check_system; diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 758b399be..47aa8f32e 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -6,6 +6,7 @@ use vars qw( @ISA $whois_hack $conf $soarefresh $soaretry ); use Carp; +use Scalar::Util qw( blessed ); use Date::Format; #use Net::Whois::Raw; use Net::Domain::TLD qw(tld_exists); @@ -289,10 +290,11 @@ returns the error, otherwise returns false. =cut sub replace { - my ( $new, $old ) = ( shift, shift ); + my $new = shift; - # We absolutely have to have an old vs. new record to make this work. - $old = $new->replace_old unless defined($old); + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $new->replace_old; return "Can't change domain - reorder." if $old->getfield('domain') ne $new->getfield('domain'); diff --git a/httemplate/edit/elements/edit.html b/httemplate/edit/elements/edit.html index c80586a4c..150ed8583 100644 --- a/httemplate/edit/elements/edit.html +++ b/httemplate/edit/elements/edit.html @@ -22,9 +22,12 @@ Example: #percentage #checkbox #select - #selectlayers (can't use after a tablebreak-tr-title yet... grep "OneTrueTable") + #selectlayers (can now use after a tablebreak-tr-title... but not inside columnstart/columnnext/columnend) #title #tablebreak-tr-title + #columnstart + #columnnext + #columnend #hidden - hidden value from object #fixed - display fixed value from object or here #fixed-country @@ -32,29 +35,32 @@ Example: 'value' => 'Y', #for checkbox, title, fixed, fixedhidden 'disabled' => 0, 'onchange' => 'javascript_function', - 'm2name_table' => 'table_name', #only tested w/ - # selectlayers so far - # might work w/select - # dunno others - 'm2name_namecol' => 'name_column', # - 'm2name_label' => 'Label', # - 'm2name_new_default' => \@table_name_objects, #default - #m2name - #objects for - #new records - 'm2name_error_callback' => sub { my($cgi, $object) = @_; }, - 'm2name_remove_warnings' => \%warnings, #hashref of warning - #messages for - #m2name removal - 'm2name_new_js' => 'function_name', #javascript function - #called on spawned rows - #(one arg: new_element) - 'm2name_remove_js' => 'function_name', #js function called - #when a row is - #deleted - #(three args: - # value, text, - # 'no_match') + + #m2 stuff only tested w/selectlayers so far + #might work w/select too, dunno others + 'm2name_table' => 'table_name', + 'm2name_namecol' => 'name_column', + #OR# + 'm2m_table' => + 'm2m_target_table' => + 'm2m_srccol' => #opt, if not the same as this table + 'm2m_dstcol' => #opt, if not the same as target table + + 'm2_label' => 'Label', # + 'm2_new_default' => \@table_name_objects, #default + #m2 objects for + #new records + 'm2_error_callback' => sub { my($cgi, $object) = @_; }, + 'm2_remove_warnings' => \%warnings, #hashref of warning + #messages for m2 + #removal + 'm2_new_js' => 'function_name', #javascript function called + #on spawned rows (one arg: + #new_element) + 'm2_remove_js' => 'function_name', #js function called when + #a row is deleted (three + #args: value, text, + #'no_match') #layer_fields & layer_values_callback only for selectlayer 'layer_fields' => [ 'fieldname' => 'Label', @@ -93,6 +99,9 @@ Example: # returns a hashref for the new object 'new_hashref_callback' + + # returns the new object iself (otherwise, ->new is called) + 'new_object_callback' #run when adding 'new_callback' => sub { my( $cgi, $object, $fields_listref ) = @_; }, @@ -103,18 +112,24 @@ Example: #XXX describe 'field_callback' => sub { }, + 'viewall_dir' => '', #'search' or 'browse', defaults to 'search' + + 'html_init' => '', #after the header/menubar + #string or coderef of additional HTML to add before 'html_table_bottom' => '', - - 'viewall_dir' => '', #'search' or 'browse', defaults to 'search' - + + #after but before the submit 'html_bottom' => '', #string 'html_bottom' => sub { my $object = shift; # ... "html_string"; }, - + + #at the very bottom (well, as low as you can go from here) + 'html_foot' => '', + # overrides default popurl(1)."process/$table.html" 'post_url' => popurl(1).'process/something', @@ -131,6 +146,14 @@ Example: ) %> +<% defined($opt{'html_init'}) + ? ( ref($opt{'html_init'}) + ? &{$opt{'html_init'}}() + : $opt{'html_init'} + ) + : '' +%> + <% include('/elements/error.html') %> % my $url = $opt{'post_url'} || popurl(1)."process/$table.html"; @@ -148,10 +171,11 @@ Example: #<% $object->$pkey() || "(NEW)" %> -%# <% ntable("#cccccc",0) %> - +% my $tablenum = 0; +
% my $g_row = 0; +% my @g_row_stack = (); % foreach my $f ( map { ref($_) ? $_ : {'field'=>$_} } % @$fields % ) { @@ -169,9 +193,11 @@ Example: % my $onchange = $f->{'onchange'}; % % my $layer_values = {}; -% if ( $f->{'layer_values_callback'} && ! $f->{'m2name_table'} ) { -% $layer_values = &{ $f->{'layer_values_callback'} }( $cgi, $object ); -% } +% $layer_values = &{ $f->{'layer_values_callback'} }( $cgi, $object ) +% if $f->{'layer_values_callback'} +% && ! $f->{'m2name_table'} +% && ! $f->{'m2m_table'}; +% % warn "layer values: ". Dumper($layer_values) % if $opt{'debug'}; % @@ -196,8 +222,19 @@ Example: % 'layer_fields' => $f->{'layer_fields'}, % 'layer_values' => $layer_values, % 'html_between' => $f->{'html_between'}, +% +% #umm. +% 'disabled' => $f->{'disabled'}, % ); % +% #select-table +% $include_common{$_} = $f->{$_} +% foreach grep exists($f->{$_}), qw( table name_col ); +% +% if ( $type eq 'tablebreak-tr-title' ) { +% $include_common{'table_id'} = 'TableNumber'. $tablenum++ +% } +% % my $layer_prefix_on = ''; % % my $include_sub = sub { @@ -207,7 +244,7 @@ Example: % % my $include = $type; % $include = "input-$include" if $include =~ /^(text|money|percentage)$/; -% $include = "tr-$include" unless $include =~ /^(hidden|tablebreak)/; +% $include = "tr-$include" unless $include =~ /^(hidden|tablebreak|column)/; % % $include_common{'layer_prefix'} = "$field$fieldnum." % if $layer_prefix_on; @@ -223,33 +260,56 @@ Example: % @include; % }; % -% $g_row++; -% $g_row++ if $type eq 'title'; +% unless ( $type =~ /^column/ ) { +% $g_row = 1 if $type eq 'tablebreak-tr-title'; +% $g_row++; +% $g_row++ if $type eq 'title'; +% } else { +% if ( $type eq 'columnstart' ) { +% push @g_row_stack, $g_row++; +% $g_row = 0; +% #} elsif ( $type eq 'columnnext' ) { +% } elsif ( $type eq 'columnend' ) { +% $g_row = pop @g_row_stack; +% } +% +% } % % my $fieldnum = ''; % my $curr_value = ''; -% if ( $f->{'m2name_table'} ) { #XXX test this for all types of fields -% my $table = $f->{'m2name_table'}; -% my $col = $f->{'m2name_namecol'}; +% if ( $f->{'m2name_table'} || $f->{'m2m_table'} ) { #XXX test this for all +% #types of fields +% my($table, $col); +% if ( $f->{'m2name_table'} ) { +% $table = $f->{'m2name_table'}; +% $col = $f->{'m2name_namecol'}; +% } elsif ( $f->{'m2m_table'} ) { +% $table = $f->{'m2m_table'}; #XXX method name +% $col = $f->{'m2m_dstcol'}; #XXX or get it from schema, defualt to +% #same name as primary key of +% #m2m_target_table +% } % $fieldnum = 0; % $layer_prefix_on = 1; -% #print out the fields for the existing m2names +% #print out the fields for the existing m2s % my @existing = (); % if ( $mode eq 'error' ) { -% @existing = &{ $f->{'m2name_error_callback'} }( $cgi, $object ); +% @existing = &{ $f->{'m2_error_callback'} }( $cgi, $object ); % } elsif ( $object->$pkey() ) { # $mode eq 'edit' % @existing = $object->$table(); -% } elsif ( $f->{'m2name_new_default'} ) { # && $mode eq 'new' -% @existing = @{ $f->{'m2name_new_default'} }; +% warn scalar(@existing). " from $object->$table: ". join('/', @existing) +% if $opt{'debug'}; +% } elsif ( $f->{'m2_new_default'} ) { # && $mode eq 'new' +% @existing = @{ $f->{'m2_new_default'} }; % } % foreach my $name_obj ( @existing ) { % % my $ex_label = ' '. ($f->{'m2name_label'} || $field ). ' '; +% '> '. ($f->{'m2_label'} || $field ). ' '; % % if ( $f->{'layer_values_callback'} ) { % my %switches = ( 'mode' => $mode ); @@ -276,10 +336,13 @@ Example: % #$field .= $fieldnum; % $onchange .= "\nspawn_$field(what);"; % } else { -% $curr_value = -% ($opt{'value_callback'} && $mode ne 'error') -% ? &{ $opt{'value_callback'} }( $f->{'field'}, $object->$field() ) -% : $object->$field(); +% if ( $f->{curr_value_callback} ) { +% $curr_value = &{ $f->{curr_value_callback} }( $cgi, $object, $field ), +% } else { +% $curr_value = $object->$field(); +% } +% $curr_value = &{ $opt{'value_callback'} }( $f->{'field'}, $curr_value ) +% if $opt{'value_callback'} && $mode ne 'error'; % } % % my @include = &{ $include_sub }( @@ -287,18 +350,19 @@ Example: % 'fieldnum' => $fieldnum, % 'curr_value' => $curr_value, % 'object' => $object, +% 'cgi' => $cgi, % 'onchange' => $onchange, % 'cell_style' => ( $fieldnum ? 'border-top:1px solid black' : '' ), % ); <% include( @include ) %> -% if ( $f->{'m2name_table'} ) { +% if ( $f->{'m2name_table'} || $f->{'m2m_table'} ) { - - - - -<% include('/elements/error.html') %> - - - -<% itable('',8,1) %> - - - - - - - - - - - - <% include( '/elements/tr-select-pkg_class.html', - 'curr_value' => $part_pkg->classnum, - ) - %> - - - - - - - - - -
- -Package information - -<% ntable("#cccccc",2) %> -
Package Definition # - <% $hashref->{pkgpart} ? $hashref->{pkgpart} : "(NEW)" %> -
Package (customer-visible) - -
Comment (customer-hidden) - -
Promotional code - -
Disable new orders - {disabled} eq 'Y' ? ' CHECKED' : '' %> -
- - - -Tax information -<% ntable("#cccccc", 2) %> - - Setup fee tax exempt - - {setuptax} eq 'Y' ? ' CHECKED' : '' %>> - - - - Recurring fee tax exempt - - {recurtax} eq 'Y' ? ' CHECKED' : '' %>> - - - -% if ( $conf->exists('enable_taxclasses') ) { - - - Tax class - - <% include('/elements/select-taxclass.html', $hashref->{taxclass} ) %> - - - -% } else { - - <% include('/elements/select-taxclass.html', $hashref->{taxclass} ) %> - -% } - -% if ( $conf->exists('enable_taxproducts') ) { - - - <% ntable("#cccccc", 2) %> - - Tax product - - - - - - - - - - <% $tax_override ? 'Edit tax overrides' : 'Override taxes' %> - - - - - - -% } else { - - - - -% } - - -
- -Line-item revenue recognition -<% ntable("#cccccc", 2) %> -% tie my %weight, 'Tie::IxHash', -% 'pay_weight' => 'Payment', -% 'credit_weight' => 'Credit' -% ; -% foreach my $weight (keys %weight) { - - <% $weight{$weight} %> weight - - {$weight} || 0 %>> - - -% } - - - - -% if ( $cgi->param('clone') ) { - - - -% } elsif ( scalar(@all_agent_types) == 1) { - - - -% } else { - - Reseller information - <% ntable("#cccccc", 2) %> - - <% 'Agent Types' %> - - <% include( '/elements/select-table.html', - 'element_name' => 'agent_type', - 'table' => 'agent_type', - 'name_col' => 'atype', - 'value' => \@agent_type, - 'multiple' => '1', - 'element_etc' => 'size="10"', - ) - %> - - - - -% } - - - -%my $thead = "\n\n". ntable('#cccccc', 2). -% 'Quan.'. -% 'Primary'. -% 'Service'; - -

Services included -<% itable('', 4, 1) %> -<% $thead %> -% -% -%my $where = "WHERE disabled IS NULL OR disabled = ''"; -%if ( $pkgpart ) { -% $where .= " OR 0 < ( SELECT quantity FROM pkg_svc -% WHERE pkg_svc.svcpart = part_svc.svcpart -% AND pkgpart = $pkgpart -% )"; -%} -%my @part_svc = qsearch('part_svc', {}, '', $where); -%my $q_part_pkg = $clone_part_pkg || $part_pkg; -%my %pkg_svc = map { $_->svcpart => $_ } $q_part_pkg->pkg_svc; -% -%my @fixups = (); -%my $count = 0; -%my $columns = 3; -%foreach my $part_svc ( @part_svc ) { -% my $svcpart = $part_svc->svcpart; -% my $pkg_svc = $pkg_svc{$svcpart} -% || new FS::pkg_svc ( { -% 'pkgpart' => $pkgpart, -% 'svcpart' => $svcpart, -% 'quantity' => 0, -% 'primary_svc' => '', -% } ); -% if ( $cgi->param('error') ) { -% my $primary_svc = ( $pkg_svc->primary_svc =~ /^Y/i ); -% my $pkg_svc_primary = scalar($cgi->param('pkg_svc_primary')); -% $pkg_svc->primary_svc('') -% if $primary_svc && $pkg_svc_primary != $svcpart; -% $pkg_svc->primary_svc('Y') -% if ! $primary_svc && $pkg_svc_primary == $svcpart; -% } -% -% push @fixups, "pkg_svc$svcpart"; -% -% my $quan = 0; -% if ( $cgi->param("pkg_svc$svcpart") =~ /^\s*(\d+)\s*$/ ) { -% $quan = $1; -% } elsif ( $pkg_svc->quantity ) { -% $quan = $pkg_svc->quantity; -% } - - - - - - - - - primary_svc =~ /^Y/i ? ' CHECKED' : '' %>> - - - - <% $part_svc->svc %> <% $part_svc->disabled =~ /^Y/i ? ' (DISABLED' : '' %> - - -% foreach ( 1 .. $columns-1 ) { -% if ( $count == int( $_ * scalar(@part_svc) / $columns ) ) { -% - - <% $thead %> -% } -% } -% $count++; -% -% } - - - -% foreach my $f ( qw( clone pkgnum ) ) { #safe, these were untained in %init - -% } - - -% -% -%# prolly should be in database -%tie my %plans, 'Tie::IxHash', %{ FS::part_pkg::plan_info() }; -% -%my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); } -% split("\n", ($clone_part_pkg||$part_pkg)->plandata ); -%#warn join("\n", map { "$_: $plandata{$_}" } keys %plandata ). "\n"; -% -%tie my %options, 'Tie::IxHash', map { $_=>$plans{$_}->{'name'} } keys %plans; -% -%#my @form_select = ('classnum'); -%#if ( $conf->exists('enable_taxclasses') ) { -%# push @form_select, 'taxclass'; -%#} else { -%# push @fixups, 'taxclass'; #hidden -%#} -%my @form_elements = ( 'classnum', 'taxclass', 'agent_type', 'tax_override' ); -% -%my @form_radio = ( 'pkg_svc_primary' ); -% -%tie my %freq, 'Tie::IxHash', %{FS::part_pkg->freqs_href()}; -%if ( $part_pkg->dbdef_table->column('freq')->type =~ /(int)/i ) { -% delete $freq{$_} foreach grep { ! /^\d+$/ } keys %freq; -%} -% -%#this should be replaced by /elements/selectlayers.html -%my $widget = new HTML::Widgets::SelectLayers( -% 'selected_layer' => $part_pkg->plan, -% 'options' => \%options, -% 'form_name' => 'dummy', -% 'form_action' => 'process/part_pkg.cgi', -% 'form_elements' => \@form_elements, -% 'form_text' => [ qw(pkg comment promo_code clone pkgnum pkgpart), -% qw(pay_weight credit_weight), #keys(%weight), -% qw(taxproductnum), -% @fixups, -% ], -% 'form_checkbox' => [ qw(setuptax recurtax disabled) ], -% 'form_radio' => \@form_radio, -% 'layer_callback' => sub { -% my $layer = shift; -% my $html = qq!!. -% ntable("#cccccc",2); -% $html .= ' -% -% Recurring fee frequency -% '; -% -% my $href = $plans{$layer}->{'fields'}; -% foreach my $field ( exists($plans{$layer}->{'fieldorder'}) -% ? @{$plans{$layer}->{'fieldorder'}} -% : keys %{ $href } -% ) { -% -% $html .= ''. $href->{$field}{'name'}. ''; -% -% my $format = sub { shift }; -% $format = $href->{$field}{'format'} if exists($href->{$field}{'format'}); -% -% if ( ! exists($href->{$field}{'type'}) ) { -% -% $html .= qq!!; -% -% } elsif ( $href->{$field}{'type'} eq 'checkbox' ) { -% -% $html .= qq!'; -% -% } elsif ( $href->{$field}{'type'} =~ /^select/ ) { -% -% $html .= '{$field}{'type'} eq 'select_multiple'; -% $html .= qq! NAME="$field" onChange="fchanged(this)">!; -% -% if ( $href->{$field}{'select_table'} ) { -% foreach my $record ( -% qsearch( $href->{$field}{'select_table'}, -% $href->{$field}{'select_hash'} ) -% ) { -% my $value = $record->getfield($href->{$field}{'select_key'}); -% $html .= qq!