fix 'Can't call method "setup" on an undefined value' error when using into rates...
[freeside.git] / FS / FS / cust_pkg.pm
index 2efd4fd..aecb894 100644 (file)
@@ -8,7 +8,7 @@ use Carp qw(cluck);
 use Scalar::Util qw( blessed );
 use List::Util qw(max);
 use Tie::IxHash;
-use Time::Local qw( timelocal_nocheck );
+use Time::Local qw( timelocal timelocal_nocheck );
 use MIME::Entity;
 use FS::UID qw( getotaker dbh );
 use FS::Misc qw( send_email );
@@ -30,6 +30,7 @@ use FS::reason;
 use FS::cust_pkg_discount;
 use FS::discount;
 use FS::UI::Web;
+use Data::Dumper;
 
 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
 # setup }
@@ -194,6 +195,8 @@ Previous pkgpart
 
 Previous locationnum
 
+=item waive_setup
+
 =back
 
 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
@@ -263,7 +266,9 @@ sub insert {
   my $error = $self->check_pkgpart;
   return $error if $error;
 
-  if ( $self->part_pkg->option('start_1st', 1) && !$self->start_date ) {
+  my $part_pkg = $self->part_pkg;
+
+  if ( $part_pkg->option('start_1st', 1) && !$self->start_date ) {
     my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5];
     $mon += 1 unless $mday == 1;
     until ( $mon < 12 ) { $mon -= 12; $year++; }
@@ -271,13 +276,21 @@ sub insert {
   }
 
   foreach my $action ( qw(expire adjourn contract_end) ) {
-    my $months = $self->part_pkg->option("${action}_months",1);
+    my $months = $part_pkg->option("${action}_months",1);
     if($months and !$self->$action) {
       my $start = $self->start_date || $self->setup || time;
-      $self->$action( $self->part_pkg->add_freq($start, $months) );
+      $self->$action( $part_pkg->add_freq($start, $months) );
     }
   }
 
+  my $free_days = $part_pkg->option('free_days',1);
+  if ( $free_days && $part_pkg->option('delay_setup',1) ) { #&& !$self->start_date
+    my ($mday,$mon,$year) = (localtime(time) )[3,4,5];
+    #my $start_date = ($self->start_date || timelocal(0,0,0,$mday,$mon,$year)) + 86400 * $free_days;
+    my $start_date = timelocal(0,0,0,$mday,$mon,$year) + 86400 * $free_days;
+    $self->start_date($start_date);
+  }
+
   $self->order_date(time);
 
   local $SIG{HUP} = 'IGNORE';
@@ -593,8 +606,12 @@ sub check {
     || $self->ut_numbern('cancel')
     || $self->ut_numbern('adjourn')
     || $self->ut_numbern('expire')
+    || $self->ut_numbern('dundate')
     || $self->ut_enum('no_auto', [ '', 'Y' ])
+    || $self->ut_enum('waive_setup', [ '', 'Y' ])
     || $self->ut_numbern('agent_pkgid')
+    || $self->ut_enum('recur_show_zero', [ '', 'Y', 'N', ])
+    || $self->ut_enum('setup_show_zero', [ '', 'Y', 'N', ])
   ;
   return $error if $error;
 
@@ -761,6 +778,8 @@ sub cancel {
     map  { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
     qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
   ) {
+    my $part_svc = $cust_svc->part_svc;
+    next if ( defined($part_svc) and $part_svc->preserve );
     my $error = $cust_svc->cancel( %svc_cancel_opt );
 
     if ( $error ) {
@@ -981,6 +1000,19 @@ sub suspend {
     }
   }
 
+  my %hash = $self->hash;
+  if ( $date ) {
+    $hash{'adjourn'} = $date;
+  } else {
+    $hash{'susp'} = $suspend_time;
+  }
+  my $new = new FS::cust_pkg ( \%hash );
+  $error = $new->replace( $self, options => { $self->options } );
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
   unless ( $date ) {
 
     my @labels = ();
@@ -1036,19 +1068,6 @@ sub suspend {
 
   }
 
-  my %hash = $self->hash;
-  if ( $date ) {
-    $hash{'adjourn'} = $date;
-  } else {
-    $hash{'susp'} = $suspend_time;
-  }
-  my $new = new FS::cust_pkg ( \%hash );
-  $error = $new->replace( $self, options => { $self->options } );
-  if ( $error ) {
-    $dbh->rollback if $oldAutoCommit;
-    return $error;
-  }
-
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   ''; #no errors
@@ -1411,7 +1430,6 @@ sub change {
 
 }
 
-use Data::Dumper;
 use Storable 'thaw';
 use MIME::Base64;
 sub process_bulk_cust_pkg {
@@ -1783,7 +1801,7 @@ sub h_cust_svc {
       FS::h_cust_svc->sql_h_search(@_),  
     ) ]
   );
-  if ( $mode eq 'I' ) {
+  if ( defined($mode) && $mode eq 'I' ) {
     my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc;
     return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc;
   } else {
@@ -1864,7 +1882,7 @@ sub available_part_svc {
       $self->part_pkg->pkg_svc;
 }
 
-=item part_svc
+=item part_svc [ OPTION => VALUE ... ]
 
 Returns a list of FS::part_svc objects representing provisioned and available
 services included in this package.  Each FS::part_svc object also has the
@@ -1878,15 +1896,20 @@ following extra fields:
 
 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
 
-svcnum
-label -> ($cust_svc->label)[1]
-
 =back
 
+Accepts one option: summarize_size.  If specified and non-zero, will omit the
+extra cust_pkg_svc option for objects where num_cust_svc is this size or
+greater.
+
 =cut
 
+#svcnum
+#label -> ($cust_svc->label)[1]
+
 sub part_svc {
   my $self = shift;
+  my %opt = @_;
 
   #XXX some sort of sort order besides numeric by svcpart...
   my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
@@ -1897,7 +1920,9 @@ sub part_svc {
     $part_svc->{'Hash'}{'num_avail'}    =
       max( 0, $pkg_svc->quantity - $num_cust_svc );
     $part_svc->{'Hash'}{'cust_pkg_svc'} =
-      $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
+        $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []
+      unless exists($opt{summarize_size}) && $opt{summarize_size} > 0
+          && $num_cust_svc >= $opt{summarize_size};
     $part_svc->{'Hash'}{'hidden'} = $pkg_svc->hidden;
     $part_svc;
   } $self->part_pkg->pkg_svc;
@@ -1929,7 +1954,7 @@ sub extra_part_svc {
   my $self = shift;
 
   my $pkgnum  = $self->pkgnum;
-  my $pkgpart = $self->pkgpart;
+  #my $pkgpart = $self->pkgpart;
 
 #  qsearch( {
 #    'table'     => 'part_svc',
@@ -1948,23 +1973,27 @@ sub extra_part_svc {
 #    'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
 #  } );
 
-#seems to benchmark slightly faster...
+#seems to benchmark slightly faster... (or did?)
+
+  my @pkgparts = map $_->pkgpart, $self->part_pkg->self_and_svc_linked;
+  my $pkgparts = join(',', @pkgparts);
+
   qsearch( {
     #'select'      => 'DISTINCT ON (svcpart) part_svc.*',
     #MySQL doesn't grok DISINCT ON
     'select'      => 'DISTINCT part_svc.*',
     'table'       => 'part_svc',
     'addl_from'   =>
-      'LEFT JOIN pkg_svc  ON (     pkg_svc.svcpart   = part_svc.svcpart 
-                               AND pkg_svc.pkgpart   = ?
+      "LEFT JOIN pkg_svc  ON (     pkg_svc.svcpart   = part_svc.svcpart 
+                               AND pkg_svc.pkgpart IN ($pkgparts)
                                AND quantity > 0
                              )
        LEFT JOIN cust_svc ON (     cust_svc.svcpart = part_svc.svcpart )
        LEFT JOIN cust_pkg USING ( pkgnum )
-      ',
+      ",
     'hashref'     => {},
     'extra_sql'   => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
-    'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
+    'extra_param' => [ [$self->pkgnum=>'int'] ],
   } );
 }
 
@@ -2603,6 +2632,7 @@ sub insert_discount {
     'amount'      => $self->discountnum_amount,
     'percent'     => $self->discountnum_percent,
     'months'      => $self->discountnum_months,
+    'setup'      => $self->discountnum_setup,
     #'disabled'    => $self->discountnum_disabled,
   };
 
@@ -2933,45 +2963,56 @@ sub search {
   # parse package class
   ###
 
-  #false lazinessish w/graph/cust_bill_pkg.cgi
-  my $classnum = 0;
-  my @pkg_class = ();
-  if ( exists($params->{'classnum'})
-       && $params->{'classnum'} =~ /^(\d*)$/
-     )
-  {
-    $classnum = $1;
-    if ( $classnum ) { #a specific class
-      push @where, "part_pkg.classnum = $classnum";
-
-      #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
-      #die "classnum $classnum not found!" unless $pkg_class[0];
-      #$title .= $pkg_class[0]->classname.' ';
-
-    } elsif ( $classnum eq '' ) { #the empty class
-
-      push @where, "part_pkg.classnum IS NULL";
-      #$title .= 'Empty class ';
-      #@pkg_class = ( '(empty class)' );
-    } elsif ( $classnum eq '0' ) {
-      #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
-      #push @pkg_class, '(empty class)';
-    } else {
-      die "illegal classnum";
+  if ( exists($params->{'classnum'}) ) {
+
+    my @classnum = ();
+    if ( ref($params->{'classnum'}) ) {
+
+      if ( ref($params->{'classnum'}) eq 'HASH' ) {
+        @classnum = grep $params->{'classnum'}{$_}, keys %{ $params->{'classnum'} };
+      } elsif ( ref($params->{'classnum'}) eq 'ARRAY' ) {
+        @classnum = @{ $params->{'classnum'} };
+      } else {
+        die 'unhandled classnum ref '. $params->{'classnum'};
+      }
+
+
+    } elsif ( $params->{'classnum'} =~ /^(\d*)$/ && $1 ne '0' ) {
+      @classnum = ( $1 );
     }
+
+    if ( @classnum ) {
+
+      my @c_where = ();
+      my @nums = grep $_, @classnum;
+      push @c_where, 'part_pkg.classnum IN ('. join(',',@nums). ')' if @nums;
+      my $null = scalar( grep { $_ eq '' } @classnum );
+      push @c_where, 'part_pkg.classnum IS NULL' if $null;
+
+      if ( scalar(@c_where) == 1 ) {
+        push @where, @c_where;
+      } elsif ( @c_where ) {
+        push @where, ' ( '. join(' OR ', @c_where). ' ) ';
+      }
+      warn $where[-1];
+
+    }
+    
+
   }
-  #eslaf
 
   ###
   # parse package report options
   ###
 
   my @report_option = ();
-  if ( exists($params->{'report_option'})
-       && $params->{'report_option'} =~ /^([,\d]*)$/
-     )
-  {
-    @report_option = split(',', $1);
+  if ( exists($params->{'report_option'}) ) {
+    if ( ref($params->{'report_option'}) eq 'ARRAY' ) {
+      @report_option = @{ $params->{'report_option'} };
+    } elsif ( $params->{'report_option'} =~ /^([,\d]*)$/ ) {
+      @report_option = split(',', $1);
+    }
+
   }
 
   if (@report_option) {
@@ -2984,7 +3025,27 @@ sub search {
          } @report_option;
   }
 
-  #eslaf
+  foreach my $any ( grep /^report_option_any/, keys %$params ) {
+
+    my @report_option_any = ();
+    if ( ref($params->{$any}) eq 'ARRAY' ) {
+      @report_option_any = @{ $params->{$any} };
+    } elsif ( $params->{$any} =~ /^([,\d]*)$/ ) {
+      @report_option_any = split(',', $1);
+    }
+
+    if (@report_option_any) {
+      # this will result in the empty set for the dangling comma case as it should
+      push @where, ' ( '. join(' OR ',
+        map{ "0 < ( SELECT count(*) FROM part_pkg_option
+                      WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
+                      AND optionname = 'report_option_$_'
+                      AND optionvalue = '1' )"
+           } @report_option_any
+      ). ' ) ';
+    }
+
+  }
 
   ###
   # parse custom
@@ -2996,7 +3057,8 @@ sub search {
   # parse fcc_line
   ###
 
-  push @where,  "part_pkg.fcc_ds0s > 0" if $params->{fcc_line};
+  push @where,  "(part_pkg.fcc_ds0s > 0 OR pkg_class.fcc_ds0s > 0)" 
+                                                        if $params->{fcc_line};
 
   ###
   # parse censustract
@@ -3010,6 +3072,21 @@ sub search {
   }
 
   ###
+  # parse censustract2
+  ###
+  if ( exists($params->{'censustract2'})
+       && $params->{'censustract2'} =~ /^(\d*)$/
+     )
+  {
+    if ($1) {
+      push @where, "cust_main.censustract LIKE '$1%'";
+    } else {
+      push @where,
+        "( cust_main.censustract = '' OR cust_main.censustract IS NULL )";
+    }
+  }
+
+  ###
   # parse part_pkg
   ###
 
@@ -3274,6 +3351,15 @@ sub _location_sql_where {
   ";
 }
 
+sub _X_show_zero {
+  my( $self, $what ) = @_;
+
+  my $what_show_zero = $what. '_show_zero';
+  length($self->$what_show_zero())
+    ? ($self->$what_show_zero() eq 'Y')
+    : $self->part_pkg->$what_show_zero();
+}
+
 =head1 SUBROUTINES
 
 =over 4