diff options
author | ivan <ivan> | 2008-04-15 13:42:40 +0000 |
---|---|---|
committer | ivan <ivan> | 2008-04-15 13:42:40 +0000 |
commit | 477015901c379f8cd6ba46cfaa4a9ae284ae582d (patch) | |
tree | f4307128f80570f1f9f38250fb1769e942ec4b99 /FS/FS | |
parent | 22a294936609cfcb452742a158fafaa55d3a6fd1 (diff) |
new package editor
Diffstat (limited to 'FS/FS')
-rw-r--r-- | FS/FS/Schema.pm | 12 | ||||
-rw-r--r-- | FS/FS/cust_event.pm | 1 | ||||
-rw-r--r-- | FS/FS/cust_main.pm | 29 | ||||
-rw-r--r-- | FS/FS/cust_pkg.pm | 22 | ||||
-rw-r--r-- | FS/FS/option_Common.pm | 4 | ||||
-rw-r--r-- | FS/FS/part_event_option.pm | 1 | ||||
-rw-r--r-- | FS/FS/part_pkg.pm | 188 | ||||
-rw-r--r-- | FS/FS/svc_Common.pm | 20 | ||||
-rw-r--r-- | FS/FS/svc_acct.pm | 14 | ||||
-rw-r--r-- | FS/FS/svc_domain.pm | 8 |
10 files changed, 191 insertions, 108 deletions
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<FS::part_pkg_taxoverride>). =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<FS::radius_usergroup>. =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'); |