Merge branch 'master' of git.freeside.biz:/home/git/freeside
[freeside.git] / FS / FS / svc_Common.pm
index ef37351..1dd9ffb 100644 (file)
@@ -1,14 +1,14 @@
 package FS::svc_Common;
+use base qw( FS::cust_main_Mixin FS::Record );
 
 use strict;
-use vars qw( @ISA $noexport_hack $DEBUG $me
+use vars qw( $noexport_hack $DEBUG $me
              $overlimit_missing_cust_svc_nonfatal_kludge );
 use Carp qw( cluck carp croak confess ); #specify cluck have to specify them all
 use Scalar::Util qw( blessed );
 use Lingua::EN::Inflect qw( PL_N );
 use FS::Conf;
 use FS::Record qw( qsearch qsearchs fields dbh );
-use FS::cust_main_Mixin;
 use FS::cust_svc;
 use FS::part_svc;
 use FS::queue;
@@ -17,8 +17,6 @@ use FS::inventory_item;
 use FS::inventory_class;
 use FS::NetworkMonitoringSystem;
 
-@ISA = qw( FS::cust_main_Mixin FS::Record );
-
 $me = '[FS::svc_Common]';
 $DEBUG = 0;
 
@@ -30,9 +28,8 @@ FS::svc_Common - Object method for all svc_ records
 
 =head1 SYNOPSIS
 
-use FS::svc_Common;
-
-@ISA = qw( FS::svc_Common );
+package svc_myservice;
+use base qw( FS::svc_Common );
 
 =head1 DESCRIPTION
 
@@ -43,27 +40,6 @@ inherit from, i.e. FS::svc_acct.  FS::svc_Common inherits from FS::Record.
 
 =over 4
 
-=item search_sql_field FIELD STRING
-
-Class method which returns an SQL fragment to search for STRING in FIELD.
-
-It is now case-insensitive by default.
-
-=cut
-
-sub search_sql_field {
-  my( $class, $field, $string ) = @_;
-  my $table = $class->table;
-  my $q_string = dbh->quote($string);
-  "LOWER($table.$field) = LOWER($q_string)";
-}
-
-#fallback for services that don't provide a search... 
-sub search_sql {
-  #my( $class, $string ) = @_;
-  '1 = 0'; #false
-}
-
 =item new
 
 =cut
@@ -176,13 +152,48 @@ sub cust_linked {
 
 Checks the validity of fields in this record.
 
-At present, this does nothing but call FS::Record::check (which, in turn, 
-does nothing but run virtual field checks).
+Only checks fields marked as required in table_info or 
+part_svc_column definition.  Should be invoked by service-specific
+check using SUPER.  Invokes FS::Record::check using SUPER.
 
 =cut
 
 sub check {
   my $self = shift;
+
+  ## Checking required fields
+
+  # get fields marked as required in table_info
+  my $required = {};
+  my $labels = {};
+  my $tinfo = $self->can('table_info') ? $self->table_info : {};
+  if ($tinfo->{'manual_require'}) {
+    my $fields = $tinfo->{'fields'} || {};
+    foreach my $field (keys %$fields) {
+      if (ref($fields->{$field}) && $fields->{$field}->{'required'}) {
+        $required->{$field} = 1;
+        $labels->{$field} = $fields->{$field}->{'label'};
+      }
+    }
+    # add fields marked as required in database
+    foreach my $column (
+      qsearch('part_svc_column',{
+        'svcpart' => $self->svcpart,
+        'required' => 'Y'
+      })
+    ) {
+      $required->{$column->columnname} = 1;
+      $labels->{$column->columnname} = $column->columnlabel;
+    }
+    # do the actual checking
+    foreach my $field (keys %$required) {
+      unless (length($self->get($field)) > 0) {
+        my $name = $labels->{$field} || $field;
+        return "$name is required\n"
+      }
+    }
+  }
+
   $self->SUPER::check;
 }
 
@@ -271,7 +282,7 @@ sub insert {
     $self->svcpart($cust_svc->svcpart);
   }
 
-  my $error =    $self->preinsert_hook_first
+  my $error =    $self->preinsert_hook_first(%options)
               || $self->set_auto_inventory
               || $self->check
               || $self->_check_duplicate
@@ -356,6 +367,8 @@ sub preinsert_hook_first { ''; }
 sub _check_duplcate { ''; }
 sub preinsert_hook { ''; }
 sub table_dupcheck_fields { (); }
+sub prereplace_hook { ''; }
+sub prereplace_hook_first { ''; }
 sub predelete_hook { ''; }
 sub predelete_hook_first { ''; }
 
@@ -384,10 +397,12 @@ sub delete {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  my $error =  $self->predelete_hook_first 
+  my $error =    $self->cust_svc->check_part_svc_link_unprovision
+              || $self->predelete_hook_first 
              || $self->SUPER::delete
               || $self->export('delete', @$export_args)
              || $self->return_inventory
+              || $self->release_router
              || $self->predelete_hook
              || $self->cust_svc->delete
   ;
@@ -492,15 +507,10 @@ sub replace {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  my $error = $new->set_auto_inventory($old);
-  if ( $error ) {
-    $dbh->rollback if $oldAutoCommit;
-    return $error;
-  }
-
-  #redundant, but so any duplicate fields are maniuplated as appropriate
-  # (svc_phone.phonenum)
-  $error = $new->check;
+  my $error =  $new->prereplace_hook_first($old)
+            || $new->set_auto_inventory($old)
+            || $new->check; #redundant, but so any duplicate fields are
+                            #maniuplated as appropriate (svc_phone.phonenum)
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
@@ -709,6 +719,8 @@ sub setx {
 sub part_svc {
   my $self = shift;
 
+  cluck 'svc_X->part_svc called' if $DEBUG;
+
   #get part_svc
   my $svcpart;
   if ( $self->get('svcpart') ) {
@@ -830,6 +842,9 @@ If there is an error, returns the error, otherwise returns false.
 =cut
 
 sub set_auto_inventory {
+  # don't try to do this during an upgrade
+  return '' if $FS::CurrentUser::upgrade_hack;
+
   my $self = shift;
   my $old = @_ ? shift : '';
 
@@ -863,13 +878,20 @@ sub set_auto_inventory {
     next if $columnflag eq 'A' && $self->$field() ne '';
 
     my $classnum = $part_svc_column->columnvalue;
-    my %hash = ( 'classnum' => $classnum );
+    my %hash;
 
     if ( $columnflag eq 'A' && $self->$field() eq '' ) {
       $hash{'svcnum'} = '';
     } elsif ( $columnflag eq 'M' ) {
       return "Select inventory item for $field" unless $self->getfield($field);
       $hash{'item'} = $self->getfield($field);
+      my $chosen_classnum = $self->getfield($field.'_classnum');
+      if ( grep {$_ == $chosen_classnum} split(',', $classnum) ) {
+        $classnum = $chosen_classnum;
+      }
+      # otherwise the chosen classnum is either (all), or somehow not on 
+      # the list, so ignore it and choose the first item that's in any
+      # class on the list
     }
 
     my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql(
@@ -880,18 +902,30 @@ sub set_auto_inventory {
     my $inventory_item = qsearchs({
       'table'     => 'inventory_item',
       'hashref'   => \%hash,
-      'extra_sql' => "AND $agentnums_sql",
+      'extra_sql' => "AND classnum IN ($classnum) AND $agentnums_sql",
       'order_by'  => 'ORDER BY ( agentnum IS NULL ) '. #agent inventory first
                      ' LIMIT 1 FOR UPDATE',
     });
 
     unless ( $inventory_item ) {
+      # should really only be shown if columnflag eq 'A'...
       $dbh->rollback if $oldAutoCommit;
-      my $inventory_class =
-        qsearchs('inventory_class', { 'classnum' => $classnum } );
-      return "Can't find inventory_class.classnum $classnum"
-        unless $inventory_class;
-      return "Out of ". PL_N($inventory_class->classname);
+      my $message = 'Out of ';
+      my @classnums = split(',', $classnum);
+      foreach ( @classnums ) {
+        my $class = FS::inventory_class->by_key($_)
+          or return "Can't find inventory_class.classnum $_";
+        $message .= PL_N($class->classname);
+        if ( scalar(@classnums) > 2 ) { # english is hard
+          if ( $_ != $classnums[-1] ) {
+            $message .= ', ';
+          }
+        }
+        if ( scalar(@classnums) > 1 and $_ == $classnums[-2] ) {
+          $message .= 'and ';
+        }
+      }
+      return $message;
     }
 
     next if $columnflag eq 'M' && $inventory_item->svcnum == $self->svcnum;
@@ -899,13 +933,14 @@ sub set_auto_inventory {
     $self->setfield( $field, $inventory_item->item );
       #if $columnflag eq 'A' && $self->$field() eq '';
 
+    # release the old inventory item, if there was one
     if ( $old && $old->$field() && $old->$field() ne $self->$field() ) {
       my $old_inv = qsearchs({
         'table'     => 'inventory_item',
-        'hashref'   => { 'classnum' => $classnum,
+        'hashref'   => { 
                          'svcnum'   => $old->svcnum,
                        },
-        'extra_sql' => ' AND '.
+        'extra_sql' => "AND classnum IN ($classnum) AND ".
           '( ( svc_field IS NOT NULL AND svc_field = '.$dbh->quote($field).' )'.
           '  OR ( svc_field IS NULL AND item = '. dbh->quote($old->$field).' )'.
           ')',
@@ -941,6 +976,9 @@ sub set_auto_inventory {
 
 =item return_inventory
 
+Release all inventory items attached to this service's fields.  Call
+when unprovisioning the service.
+
 =cut
 
 sub return_inventory {
@@ -987,18 +1025,29 @@ sub inventory_item {
   });
 }
 
-=item cust_svc
+=item release_router 
 
-Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
-object (see L<FS::cust_svc>).
+Delete any routers associated with this service.  This will release their
+address blocks, also.
 
 =cut
 
-sub cust_svc {
+sub release_router {
   my $self = shift;
-  qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
+  my @routers = qsearch('router', { svcnum => $self->svcnum });
+  foreach (@routers) {
+    my $error = $_->delete;
+    return "$error (removing router '".$_->routername."')" if $error;
+  }
+  '';
 }
 
+
+=item cust_svc
+
+Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
+object (see L<FS::cust_svc>).
+
 =item suspend
 
 Runs export_suspend callbacks.
@@ -1107,7 +1156,9 @@ Runs the provided export hook (i.e. "suspend", "unsuspend") for this service.
 sub export {
   my( $self, $method ) = ( shift, shift );
 
+  # $method must start with export_, $action must be the part after that
   $method = "export_$method" unless $method =~ /^export_/;
+  my ($action) = $method =~ /^export_(\w+)/;
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -1124,6 +1175,7 @@ sub export {
   unless ( $noexport_hack ) {
     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
       next unless $part_export->can($method);
+      next if $part_export->get("no_$action"); # currently only 'no_suspend'
       my $error = $part_export->$method($self, @_);
       if ( $error ) {
         $dbh->rollback if $oldAutoCommit;
@@ -1282,6 +1334,238 @@ sub nms_ip_delete {
 #XXX not yet implemented
 }
 
+=item search_sql_field FIELD STRING
+
+Class method which returns an SQL fragment to search for STRING in FIELD.
+
+It is now case-insensitive by default.
+
+=cut
+
+sub search_sql_field {
+  my( $class, $field, $string ) = @_;
+  my $table = $class->table;
+  my $q_string = dbh->quote($string);
+  "LOWER($table.$field) = LOWER($q_string)";
+}
+
+#fallback for services that don't provide a search... 
+sub search_sql {
+  #my( $class, $string ) = @_;
+  '1 = 0'; #false
+}
+sub search_sql_addl_from {
+  '';
+}
+
+=item search HASHREF
+
+Class method which returns a qsearch hash expression to search for parameters
+specified in HASHREF.
+
+Parameters:
+
+=over 4
+
+=item unlinked - set to search for all unlinked services.  Overrides all other options.
+
+=item agentnum
+
+=item custnum
+
+=item svcpart
+
+=item ip_addr
+
+=item pkgpart - arrayref
+
+=item routernum - arrayref
+
+=item sectornum - arrayref
+
+=item towernum - arrayref
+
+=item order_by
+
+=item cancelled - if true, only returns svcs attached to cancelled pkgs;
+if defined and false, only returns svcs not attached to cancelled packages
+
+=back
+
+=cut
+
+### Don't call the 'cancelled' option 'Service Status'
+### There is no such thing
+### See cautionary note in httemplate/browse/part_svc.cgi
+
+sub search {
+  my ($class, $params) = @_;
+
+  my @from = (
+    'LEFT JOIN cust_svc  USING ( svcnum  )',
+    'LEFT JOIN part_svc  USING ( svcpart )',
+    'LEFT JOIN cust_pkg  USING ( pkgnum  )',
+    FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg'),
+  );
+
+  my @where = ();
+
+  $class->_search_svc($params, \@from, \@where) if $class->can('_search_svc');
+
+#  # domain
+#  if ( $params->{'domain'} ) { 
+#    my $svc_domain = qsearchs('svc_domain', { 'domain'=>$params->{'domain'} } );
+#    #preserve previous behavior & bubble up an error if $svc_domain not found?
+#    push @where, 'domsvc = '. $svc_domain->svcnum if $svc_domain;
+#  }
+#
+#  # domsvc
+#  if ( $params->{'domsvc'} =~ /^(\d+)$/ ) { 
+#    push @where, "domsvc = $1";
+#  }
+
+  #unlinked
+  push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
+
+  #agentnum
+  if ( $params->{'agentnum'} =~ /^(\d+)$/ && $1 ) {
+    push @where, "cust_main.agentnum = $1";
+  }
+
+  #custnum
+  if ( $params->{'custnum'} =~ /^(\d+)$/ && $1 ) {
+    push @where, "cust_pkg.custnum = $1";
+  }
+
+  #customer status
+  if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) {
+    push @where, FS::cust_main->cust_status_sql . " = '$1'";
+  }
+
+  #customer balance
+  if ( $params->{'balance'} =~ /^\s*(\-?\d*(\.\d{1,2})?)\s*$/ && length($1) ) {
+    my $balance = $1;
+
+    my $age = '';
+    if ( $params->{'balance_days'} =~ /^\s*(\d*(\.\d{1,3})?)\s*$/ && length($1) ) {
+      $age = time - 86400 * $1;
+    }
+    push @where, FS::cust_main->balance_date_sql($age) . " > $balance";
+  }
+
+  #payby
+  if ( $params->{'payby'} && scalar(@{ $params->{'payby'} }) ) {
+    my @payby = map "'$_'", grep /^(\w+)$/, @{ $params->{'payby'} };
+    push @where, 'payby IN ('. join(',', @payby ). ')';
+  }
+
+  #pkgpart
+  ##pkgpart, now properly untainted, can be arrayref
+  #for my $pkgpart ( $params->{'pkgpart'} ) {
+  #  if ( ref $pkgpart ) {
+  #    my $where = join(',', map { /^(\d+)$/ ? $1 : () } @$pkgpart );
+  #    push @where, "cust_pkg.pkgpart IN ($where)" if $where;
+  #  }
+  #  elsif ( $pkgpart =~ /^(\d+)$/ ) {
+  #    push @where, "cust_pkg.pkgpart = $1";
+  #  }
+  #}
+  if ( $params->{'pkgpart'} ) {
+    my @pkgpart = ref( $params->{'pkgpart'} )
+                    ? @{ $params->{'pkgpart'} }
+                    : $params->{'pkgpart'}
+                      ? ( $params->{'pkgpart'} )
+                      : ();
+    @pkgpart = grep /^(\d+)$/, @pkgpart;
+    push @where, 'cust_pkg.pkgpart IN ('. join(',', @pkgpart ). ')' if @pkgpart;
+  }
+
+  #svcnum
+  if ( $params->{'svcnum'} =~ /^(\d+)$/ ) {
+    push @where, "svcnum = $1";
+  }
+
+  # svcpart
+  if ( $params->{'svcpart'} ) {
+    my @svcpart = ref( $params->{'svcpart'} )
+                    ? @{ $params->{'svcpart'} }
+                    : $params->{'svcpart'}
+                      ? ( $params->{'svcpart'} )
+                      : ();
+    @svcpart = grep /^(\d+)$/, @svcpart;
+    push @where, 'svcpart IN ('. join(',', @svcpart ). ')' if @svcpart;
+  }
+
+  if ( $params->{'exportnum'} =~ /^(\d+)$/ ) {
+    push @from, ' LEFT JOIN export_svc USING ( svcpart )';
+    push @where, "exportnum = $1";
+  }
+
+  if ( defined($params->{'cancelled'}) ) {
+    if ($params->{'cancelled'}) {
+      push @where, "cust_pkg.cancel IS NOT NULL";
+    } else {
+      push @where, "cust_pkg.cancel IS NULL";
+    }
+  }
+
+#  # sector and tower
+#  my @where_sector = $class->tower_sector_sql($params);
+#  if ( @where_sector ) {
+#    push @where, @where_sector;
+#    push @from, ' LEFT JOIN tower_sector USING ( sectornum )';
+#  }
+
+  # here is the agent virtualization
+  #if ($params->{CurrentUser}) {
+  #  my $access_user =
+  #    qsearchs('access_user', { username => $params->{CurrentUser} });
+  #
+  #  if ($access_user) {
+  #    push @where, $access_user->agentnums_sql('table'=>'cust_main');
+  #  }else{
+  #    push @where, "1=0";
+  #  }
+  #} else {
+    push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
+                   'table'      => 'cust_main',
+                   'null_right' => 'View/link unlinked services',
+                 );
+  #}
+
+  push @where, @{ $params->{'where'} } if $params->{'where'};
+
+  my $addl_from = join(' ', @from);
+  my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
+
+  my $table = $class->table;
+
+  my $count_query = "SELECT COUNT(*) FROM $table $addl_from $extra_sql";
+  #if ( keys %svc_X ) {
+  #  $count_query .= ' WHERE '.
+  #                    join(' AND ', map "$_ = ". dbh->quote($svc_X{$_}),
+  #                                      keys %svc_X
+  #                        );
+  #}
+
+  {
+    'table'       => $table,
+    'hashref'     => {},
+    'select'      => join(', ',
+                       "$table.*",
+                       'part_svc.svc',
+                       'cust_main.custnum',
+                       @{ $params->{'addl_select'} || [] },
+                       FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
+                     ),
+    'addl_from'   => $addl_from,
+    'extra_sql'   => $extra_sql,
+    'order_by'    => $params->{'order_by'},
+    'count_query' => $count_query,
+  };
+
+}
+
 =back
 
 =head1 BUGS