import torrus 1.0.9
[freeside.git] / FS / FS / part_pkg.pm
index 82d6ed5..f4aacae 100644 (file)
@@ -16,9 +16,12 @@ use FS::type_pkgs;
 use FS::part_pkg_option;
 use FS::pkg_class;
 use FS::agent;
+use FS::part_pkg_taxrate;
 use FS::part_pkg_taxoverride;
 use FS::part_pkg_taxproduct;
 use FS::part_pkg_link;
+use FS::part_pkg_discount;
+use FS::part_pkg_vendor;
 
 @ISA = qw( FS::m2m_Common FS::option_Common );
 $DEBUG = 0;
@@ -98,6 +101,8 @@ inherits from FS::Record.  The following fields are currently supported:
 
 =item agentnum - Optional agentnum (see L<FS::agent>)
 
+=item fcc_ds0s - Optional DS0 equivalency number for FCC form 477
+
 =back
 
 =head1 METHODS
@@ -140,7 +145,9 @@ Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg>,
 I<custnum_ref> and I<options>.
 
 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
-values, appropriate FS::pkg_svc records will be inserted.
+values, appropriate FS::pkg_svc records will be inserted.  I<hidden_svc> can 
+be set to a hashref of svcparts and flag values ('Y' or '') to set the 
+'hidden' field in these records.
 
 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
 FS::pkg_svc record will be updated.
@@ -226,6 +233,7 @@ sub insert {
 
     warn "  inserting pkg_svc records" if $DEBUG;
     my $pkg_svc = $options{'pkg_svc'} || {};
+    my $hidden_svc = $options{'hidden_svc'} || {};
     foreach my $part_svc ( qsearch('part_svc', {} ) ) {
       my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
       my $primary_svc =
@@ -238,6 +246,7 @@ sub insert {
         'svcpart'     => $part_svc->svcpart,
         'quantity'    => $quantity, 
         'primary_svc' => $primary_svc,
+        'hidden'      => $hidden_svc->{$part_svc->svcpart},
       } );
       my $error = $pkg_svc->insert;
       if ( $error ) {
@@ -267,6 +276,23 @@ sub insert {
     }
   }
 
+  if ( $options{'part_pkg_vendor'} ) {
+      my($exportnum,$vendor_pkg_id);
+      my %options_part_pkg_vendor = $options{'part_pkg_vendor'};
+      while(($exportnum,$vendor_pkg_id) = each %options_part_pkg_vendor){
+           my $ppv = new FS::part_pkg_vendor( {
+                   'pkgpart' => $self->pkgpart,
+                   'exportnum' => $exportnum,
+                   'vendor_pkg_id' => $vendor_pkg_id, 
+               } );
+           my $error = $ppv->insert;
+           if ( $error ) {
+             $dbh->rollback if $oldAutoCommit;
+             return "Error inserting part_pkg_vendor record: $error";
+           }
+      }
+  }
+
   warn "  commiting transaction" if $DEBUG;
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
@@ -289,10 +315,13 @@ sub delete {
 Replaces OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
 
-Currently available options are: I<pkg_svc>, I<primary_svc> and I<options>
+Currently available options are: I<pkg_svc>, I<hidden_svc>, I<primary_svc> 
+and I<options>
 
 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
-values, the appropriate FS::pkg_svc records will be replaced.
+values, the appropriate FS::pkg_svc records will be replaced.  I<hidden_svc>
+can be set to a hashref of svcparts and flag values ('Y' or '') to set the 
+'hidden' field in these records.
 
 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
 FS::pkg_svc record will be updated.
@@ -375,8 +404,10 @@ sub replace {
 
   warn "  replacing pkg_svc records" if $DEBUG;
   my $pkg_svc = $options->{'pkg_svc'} || {};
+  my $hidden_svc = $options->{'hidden_svc'} || {};
   foreach my $part_svc ( qsearch('part_svc', {} ) ) {
     my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
+    my $hidden = $hidden_svc->{$part_svc->svcpart} || '';
     my $primary_svc =
       ( defined($options->{'primary_svc'}) && $options->{'primary_svc'}
         && $options->{'primary_svc'} == $part_svc->svcpart
@@ -384,17 +415,24 @@ sub replace {
         ? 'Y'
         : '';
 
-
     my $old_pkg_svc = qsearchs('pkg_svc', {
-      'pkgpart' => $old->pkgpart,
-      'svcpart' => $part_svc->svcpart,
-    } );
-    my $old_quantity = $old_pkg_svc ? $old_pkg_svc->quantity : 0;
-    my $old_primary_svc =
-      ( $old_pkg_svc && $old_pkg_svc->dbdef_table->column('primary_svc') )
-        ? $old_pkg_svc->primary_svc
-        : '';
-    next unless $old_quantity != $quantity || $old_primary_svc ne $primary_svc;
+        'pkgpart' => $old->pkgpart,
+        'svcpart' => $part_svc->svcpart,
+      }
+    );
+    my $old_quantity = 0;
+    my $old_primary_svc = '';
+    my $old_hidden = '';
+    if ( $old_pkg_svc ) {
+      $old_quantity = $old_pkg_svc->quantity;
+      $old_primary_svc = $old_pkg_svc->primary_svc 
+        if $old_pkg_svc->dbdef_table->column('primary_svc'); # is this needed?
+      $old_hidden = $old_pkg_svc->hidden;
+    }
+    next unless $old_quantity != $quantity || 
+                $old_primary_svc ne $primary_svc ||
+                $old_hidden ne $hidden;
   
     my $new_pkg_svc = new FS::pkg_svc( {
       'pkgsvcnum'   => ( $old_pkg_svc ? $old_pkg_svc->pkgsvcnum : '' ),
@@ -402,6 +440,7 @@ sub replace {
       'svcpart'     => $part_svc->svcpart,
       'quantity'    => $quantity, 
       'primary_svc' => $primary_svc,
+      'hidden'      => $hidden,
     } );
     my $error = $old_pkg_svc
                   ? $new_pkg_svc->replace($old_pkg_svc)
@@ -411,6 +450,56 @@ sub replace {
       return $error;
     }
   }
+  
+  my @part_pkg_vendor = $old->part_pkg_vendor;
+  my @current_exportnum = ();
+  if ( $options->{'part_pkg_vendor'} ) {
+      my($exportnum,$vendor_pkg_id);
+      while ( ($exportnum,$vendor_pkg_id) 
+                               = each %{$options->{'part_pkg_vendor'}} ) {
+         my $noinsert = 0;
+         foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
+           if($exportnum == $part_pkg_vendor->exportnum
+               && $vendor_pkg_id ne $part_pkg_vendor->vendor_pkg_id) {
+               $part_pkg_vendor->vendor_pkg_id($vendor_pkg_id);
+               my $error = $part_pkg_vendor->replace;
+               if ( $error ) {
+                 $dbh->rollback if $oldAutoCommit;
+                 return "Error replacing part_pkg_vendor record: $error";
+               }
+               $noinsert = 1;
+               last;
+           }
+           elsif($exportnum == $part_pkg_vendor->exportnum
+               && $vendor_pkg_id eq $part_pkg_vendor->vendor_pkg_id) {
+               $noinsert = 1;
+               last;
+           }
+         }
+         unless ( $noinsert ) {
+           my $ppv = new FS::part_pkg_vendor( {
+                   'pkgpart' => $new->pkgpart,
+                   'exportnum' => $exportnum,
+                   'vendor_pkg_id' => $vendor_pkg_id, 
+               } );
+           my $error = $ppv->insert;
+           if ( $error ) {
+             $dbh->rollback if $oldAutoCommit;
+             return "Error inserting part_pkg_vendor record: $error";
+           }
+         }
+         push @current_exportnum, $exportnum;
+      }
+  }
+  foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
+      unless ( grep($_ eq $part_pkg_vendor->exportnum, @current_exportnum) ) {
+       my $error = $part_pkg_vendor->delete;
+       if ( $error ) {
+         $dbh->rollback if $oldAutoCommit;
+         return "Error deleting part_pkg_vendor record: $error";
+       }
+      }
+  }
 
   warn "  commiting transaction" if $DEBUG;
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
@@ -462,6 +551,7 @@ sub check {
     || $self->ut_textn('taxclass')
     || $self->ut_enum('disabled', [ '', 'Y' ] )
     || $self->ut_enum('custom', [ '', 'Y' ] )
+    || $self->ut_enum('no_auto', [ '', 'Y' ])
     #|| $self->ut_moneyn('setup_cost')
     #|| $self->ut_moneyn('recur_cost')
     || $self->ut_floatn('setup_cost')
@@ -479,6 +569,7 @@ sub check {
            ? $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum' )
            : $self->ut_agentnum_acl('agentnum', \@null_agentnum_right)
        )
+    || $self->ut_numbern('fcc_ds0s')
     || $self->SUPER::check
   ;
   return $error if $error;
@@ -767,36 +858,12 @@ sub is_free {
   }
 }
 
+sub can_discount { 0; }
 
 sub freqs_href {
-  #method, class method or sub? #my $self = shift;
-
-  tie my %freq, 'Tie::IxHash', 
-    '0'    => '(no recurring fee)',
-    '1h'   => 'hourly',
-    '1d'   => 'daily',
-    '2d'   => 'every two days',
-    '3d'   => 'every three days',
-    '1w'   => 'weekly',
-    '2w'   => 'biweekly (every 2 weeks)',
-    '1'    => 'monthly',
-    '45d'  => 'every 45 days',
-    '2'    => 'bimonthly (every 2 months)',
-    '3'    => 'quarterly (every 3 months)',
-    '4'    => 'every 4 months',
-    '137d' => 'every 4 1/2 months (137 days)',
-    '6'    => 'semiannually (every 6 months)',
-    '12'   => 'annually',
-    '13'   => 'every 13 months (annually +1 month)',
-    '24'   => 'biannually (every 2 years)',
-    '36'   => 'triannually (every 3 years)',
-    '48'   => '(every 4 years)',
-    '60'   => '(every 5 years)',
-    '120'  => '(every 10 years)',
-  ;
-
-  \%freq;
-
+  # moved to FS::Misc to make this accessible to other packages
+  # at initialization
+  FS::Misc::pkg_freqs();
 }
 
 =item freq_pretty
@@ -829,32 +896,34 @@ sub freq_pretty {
   }
 }
 
-=item add_freq TIMESTAMP
+=item add_freq TIMESTAMP [ FREQ ]
 
-Adds the frequency of this package to the provided timestamp and returns
-the resulting timestamp, or -1 if the frequency of this package could not be
-parsed (shouldn't happen).
+Adds a billing period of some frequency to the provided timestamp and 
+returns the resulting timestamp, or -1 if the frequency could not be 
+parsed (shouldn't happen).  By default, the frequency of this package 
+will be used; to override this, pass a different frequency as a second 
+argument.
 
 =cut
 
 sub add_freq {
-  my( $self, $date ) = @_;
-  my $freq = $self->freq;
+  my( $self, $date, $freq ) = @_;
+  $freq = $self->freq unless $freq;
 
   #change this bit to use Date::Manip? CAREFUL with timezones (see
   # mailing list archive)
   my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($date) )[0,1,2,3,4,5];
 
-  if ( $self->freq =~ /^\d+$/ ) {
-    $mon += $self->freq;
+  if ( $freq =~ /^\d+$/ ) {
+    $mon += $freq;
     until ( $mon < 12 ) { $mon -= 12; $year++; }
-  } elsif ( $self->freq =~ /^(\d+)w$/ ) {
+  } elsif ( $freq =~ /^(\d+)w$/ ) {
     my $weeks = $1;
     $mday += $weeks * 7;
-  } elsif ( $self->freq =~ /^(\d+)d$/ ) {
+  } elsif ( $freq =~ /^(\d+)d$/ ) {
     my $days = $1;
     $mday += $days;
-  } elsif ( $self->freq =~ /^(\d+)h$/ ) {
+  } elsif ( $freq =~ /^(\d+)h$/ ) {
     my $hours = $1;
     $hour += $hours;
   } else {
@@ -884,6 +953,29 @@ sub plandata {
   }
 }
 
+=item part_pkg_vendor
+
+Returns all vendor/external package ids as FS::part_pkg_vendor objects (see
+L<FS::part_pkg_vendor>).
+
+=cut
+
+sub part_pkg_vendor {
+  my $self = shift;
+  qsearch('part_pkg_vendor', { 'pkgpart' => $self->pkgpart } );
+}
+
+=item vendor_pkg_ids
+
+Returns a list of vendor/external package ids by exportnum
+
+=cut
+
+sub vendor_pkg_ids {
+  my $self = shift;
+  map { $_->exportnum => $_->vendor_pkg_id } $self->part_pkg_vendor;
+}
+
 =item part_pkg_option
 
 Returns all options as FS::part_pkg_option objects (see
@@ -907,9 +999,11 @@ sub options {
   map { $_->optionname => $_->optionvalue } $self->part_pkg_option;
 }
 
-=item option OPTIONNAME
+=item option OPTIONNAME [ QUIET ]
 
-Returns the option value for the given name, or the empty string.
+Returns the option value for the given name, or the empty string.  If a true
+value is passed as the second argument, warnings about missing the option
+will be suppressed.
 
 =cut
 
@@ -955,6 +1049,8 @@ sub _part_pkg_link {
   qsearch({ table    => 'part_pkg_link',
             hashref  => { 'src_pkgpart' => $self->pkgpart,
                           'link_type'   => $type,
+                          #protection against infinite recursive links
+                          'dst_pkgpart' => { op=>'!=', value=> $self->pkgpart },
                         },
             order_by => "ORDER BY hidden",
          });
@@ -1141,6 +1237,18 @@ sub part_pkg_taxrate {
          } );
 }
 
+=item part_pkg_discount
+
+Returns the package to discount m2m records (see L<FS::part_pkg_discount>)
+for this package.
+
+=cut
+
+sub part_pkg_discount {
+  my $self = shift;
+  qsearch('part_pkg_discount', { 'pkgpart' => $self->pkgpart });
+}
+
 =item _rebless
 
 Reblesses the object into the FS::part_pkg::PLAN class (if available), where
@@ -1205,6 +1313,18 @@ sub calc_units  { 0; }
 #fallback for everything except bulk.pm
 sub hide_svc_detail { 0; }
 
+=item recur_cost_permonth CUST_PKG
+
+recur_cost divided by freq (only supported for monthly and longer frequencies)
+
+=cut
+
+sub recur_cost_permonth {
+  my($self, $cust_pkg) = @_;
+  return 0 unless $self->freq =~ /^\d+$/ && $self->freq > 0;
+  sprintf('%.2f', $self->recur_cost / $self->freq );
+}
+
 =item format OPTION DATA
 
 Returns data formatted according to the function 'format' described
@@ -1339,6 +1459,25 @@ sub _upgrade_data { # class method
     die $error if $error;
   }
 
+  my @part_pkg_option = qsearch('part_pkg_option',
+    { 'optionname'  => 'unused_credit',
+      'optionvalue' => 1,
+    });
+  foreach my $old_opt (@part_pkg_option) {
+    my $pkgpart = $old_opt->pkgpart;
+    my $error = $old_opt->delete;
+    die $error if $error;
+
+    foreach (qw(unused_credit_cancel unused_credit_change)) {
+      my $new_opt = new FS::part_pkg_option {
+        'pkgpart'     => $pkgpart,
+        'optionname'  => $_,
+        'optionvalue' => 1,
+      };
+      $error = $new_opt->insert;
+      die $error if $error;
+    }
+  }
 }
 
 =item curuser_pkgs_sql
@@ -1378,15 +1517,16 @@ sub _pkgs_sql {
 
   "
     (
-      agentnum IS NOT NULL
-      OR
-      0 < ( SELECT COUNT(*)
-              FROM type_pkgs
-                LEFT JOIN agent_type USING ( typenum )
-                LEFT JOIN agent AS typeagent USING ( typenum )
-              WHERE type_pkgs.pkgpart = part_pkg.pkgpart
-                AND typeagent.agentnum IN ($agentnums)
-          )
+      ( agentnum IS NOT NULL AND agentnum IN ($agentnums) )
+      OR ( agentnum IS NULL
+           AND EXISTS ( SELECT 1
+                          FROM type_pkgs
+                            LEFT JOIN agent_type USING ( typenum )
+                            LEFT JOIN agent AS typeagent USING ( typenum )
+                          WHERE type_pkgs.pkgpart = part_pkg.pkgpart
+                            AND typeagent.agentnum IN ($agentnums)
+                      )
+         )
     )
   ";
 
@@ -1424,19 +1564,48 @@ foreach my $INC ( @INC ) {
       next;
     }
     warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG;
-    if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
-      warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG;
-      next;
-    }
+    #if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
+    #  warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG;
+    #  next;
+    #}
     $info{$mod} = $info;
+    $info->{'weight'} ||= 0; # quiet warnings
   }
 }
 
+# copy one level deep to allow replacement of fields and fieldorder
 tie %plans, 'Tie::IxHash',
-  map  { $_ => $info{$_} }
+  map  { my %infohash = %{ $info{$_} }; 
+          $_ => \%infohash }
   sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} }
   keys %info;
 
+# inheritance of plan options
+foreach my $name (keys(%info)) {
+  if (exists($info{$name}->{'disabled'}) and $info{$name}->{'disabled'}) {
+    warn "skipping disabled plan FS::part_pkg::$name" if $DEBUG;
+    delete $plans{$name};
+    next;
+  }
+  my $parents = $info{$name}->{'inherit_fields'} || [];
+  my (%fields, %field_exists, @fieldorder);
+  foreach my $parent ($name, @$parents) {
+    %fields = ( # avoid replacing existing fields
+      %{ $info{$parent}->{'fields'} || {} },
+      %fields
+    );
+    foreach (@{ $info{$parent}->{'fieldorder'} || [] }) {
+      # avoid duplicates
+      next if $field_exists{$_};
+      $field_exists{$_} = 1;
+      # allow inheritors to remove inherited fields from the fieldorder
+      push @fieldorder, $_ if !exists($fields{$_}->{'disabled'});
+    }
+  }
+  $plans{$name}->{'fields'} = \%fields;
+  $plans{$name}->{'fieldorder'} = \@fieldorder;
+}
+
 sub plan_info {
   \%plans;
 }