summaryrefslogtreecommitdiff
path: root/FS
diff options
context:
space:
mode:
Diffstat (limited to 'FS')
-rw-r--r--FS/FS/Schema.pm12
-rw-r--r--FS/FS/cust_event.pm1
-rw-r--r--FS/FS/cust_main.pm29
-rw-r--r--FS/FS/cust_pkg.pm22
-rw-r--r--FS/FS/option_Common.pm4
-rw-r--r--FS/FS/part_event_option.pm1
-rw-r--r--FS/FS/part_pkg.pm188
-rw-r--r--FS/FS/svc_Common.pm20
-rw-r--r--FS/FS/svc_acct.pm14
-rw-r--r--FS/FS/svc_domain.pm8
10 files changed, 191 insertions, 108 deletions
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index d4a51a6..2666c53 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 5924851..5ca8167 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 ceefeaf..3490e46 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 d413596..09808a4 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 441e798..a786ae3 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 43e1da9..09b7756 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 1e16f29..cffdc88 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 d830f2f..31e53db 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 4343df5..3e3ecb5 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 758b399b..47aa8f3 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');
generated by cgit v1.1 at 2024-06-18 13:51:30 +0000