[freeside-commits] freeside/FS/FS Schema.pm, 1.82, 1.83 cust_event.pm, 1.4, 1.5 cust_main.pm, 1.337, 1.338 cust_pkg.pm, 1.89, 1.90 option_Common.pm, 1.8, 1.9 part_event_option.pm, 1.1, 1.2 part_pkg.pm, 1.63, 1.64 svc_Common.pm, 1.43, 1.44 svc_acct.pm, 1.240, 1.241 svc_domain.pm, 1.52, 1.53

Ivan,,, ivan at wavetail.420.am
Tue Apr 15 06:41:04 PDT 2008


Update of /home/cvs/cvsroot/freeside/FS/FS
In directory wavetail.420.am:/tmp/cvs-serv335

Modified Files:
	Schema.pm cust_event.pm cust_main.pm cust_pkg.pm 
	option_Common.pm part_event_option.pm part_pkg.pm 
	svc_Common.pm svc_acct.pm svc_domain.pm 
Log Message:
new package editor

Index: cust_event.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_event.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- cust_event.pm	2 Oct 2007 21:56:11 -0000	1.4
+++ cust_event.pm	15 Apr 2008 13:41:01 -0000	1.5
@@ -344,6 +344,7 @@
 
 }
 
+#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) = @_;
 

Index: svc_domain.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/svc_domain.pm,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -d -r1.52 -r1.53
--- svc_domain.pm	22 Sep 2007 19:03:34 -0000	1.52
+++ svc_domain.pm	15 Apr 2008 13:41:01 -0000	1.53
@@ -6,6 +6,7 @@
   $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 @@
 =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'); 

Index: svc_acct.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/svc_acct.pm,v
retrieving revision 1.240
retrieving revision 1.241
diff -u -d -r1.240 -r1.241
--- svc_acct.pm	8 Jan 2008 21:33:53 -0000	1.240
+++ svc_acct.pm	15 Apr 2008 13:41:01 -0000	1.241
@@ -14,6 +14,7 @@
              $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 @@
 =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;
 

Index: part_event_option.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/part_event_option.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- part_event_option.pm	1 Aug 2007 22:24:36 -0000	1.1
+++ part_event_option.pm	15 Apr 2008 13:41:01 -0000	1.2
@@ -2,6 +2,7 @@
 
 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;

Index: cust_pkg.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_pkg.pm,v
retrieving revision 1.89
retrieving revision 1.90
diff -u -d -r1.89 -r1.90
--- cust_pkg.pm	29 Jan 2008 04:16:04 -0000	1.89
+++ cust_pkg.pm	15 Apr 2008 13:41:01 -0000	1.90
@@ -2,6 +2,7 @@
 
 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 @@
 =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 @@
   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 @@
   }
 
   my $error = $new->SUPER::replace($old,
-                                   $options{options} ? ${options{options}} : ()
+                                   $options->{options} ? $options->{options} : ()
                                   );
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;

Index: option_Common.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/option_Common.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- option_Common.pm	1 Aug 2007 22:24:36 -0000	1.8
+++ option_Common.pm	15 Apr 2008 13:41:01 -0000	1.9
@@ -161,8 +161,8 @@
 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
 

Index: part_pkg.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/part_pkg.pm,v
retrieving revision 1.63
retrieving revision 1.64
diff -u -d -r1.63 -r1.64
--- part_pkg.pm	6 Apr 2008 16:12:45 -0000	1.63
+++ part_pkg.pm	15 Apr 2008 13:41:01 -0000	1.64
@@ -3,6 +3,7 @@
 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::agent;
 use FS::part_pkg_taxoverride;
 use FS::part_pkg_taxproduct;
+#XXX#use FS::part_pkg_link;
 
- at ISA = qw( FS::m2m_Common FS::Record ); # FS::option_Common ); # this can use option_Common
-                                                # when all the plandata bs is
-                                                # gone
-
+ at ISA = qw( FS::m2m_Common FS::option_Common );
 $DEBUG = 0;
 
 =head1 NAME
@@ -168,61 +167,13 @@
   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 @@
 =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 @@
   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 @@
   }
 
   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 @@
   }
 
   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 @@
 
   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 @@
   '';
 }
 
+=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 @@
   '';
 }
 
+=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 @@
   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 @@
 
 =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

Index: cust_main.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_main.pm,v
retrieving revision 1.337
retrieving revision 1.338
diff -u -d -r1.337 -r1.338
--- cust_main.pm	6 Apr 2008 16:12:45 -0000	1.337
+++ cust_main.pm	15 Apr 2008 13:41:01 -0000	1.338
@@ -8,6 +8,7 @@
 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 @@
 
 }
 
-=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 @@
 
 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 @@
     && $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;

Index: svc_Common.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/svc_Common.pm,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -d -r1.43 -r1.44
--- svc_Common.pm	12 Mar 2008 16:24:33 -0000	1.43
+++ svc_Common.pm	15 Apr 2008 13:41:01 -0000	1.44
@@ -3,6 +3,7 @@
 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 @@
   '';
 }
 
-=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 @@
 =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 @@
   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 @@
   #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

Index: Schema.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Schema.pm,v
retrieving revision 1.82
retrieving revision 1.83
diff -u -d -r1.82 -r1.83
--- Schema.pm	2 Apr 2008 20:42:43 -0000	1.82
+++ Schema.pm	15 Apr 2008 13:41:01 -0000	1.83
@@ -1007,6 +1007,18 @@
       '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', '',       '', '', '',



More information about the freeside-commits mailing list