X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fpart_export.pm;h=dce2d2a44411bfb143939413ca3467100965c192;hb=fd76d85b82f8ab6917218c7fcb015f4e72216f9a;hp=8af413b1d97a74a14cce8a712bcff3dfe746552d;hpb=a7c1b602f88c177db34477ed4cdc1f72603f8995;p=freeside.git

diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm
index 8af413b1d..dce2d2a44 100644
--- a/FS/FS/part_export.pm
+++ b/FS/FS/part_export.pm
@@ -1,13 +1,19 @@
 package FS::part_export;
 
 use strict;
-use vars qw( @ISA );
+use vars qw( @ISA @EXPORT_OK $DEBUG %exports );
+use Exporter;
+use Tie::IxHash;
 use FS::Record qw( qsearch qsearchs dbh );
+use FS::option_Common;
 use FS::part_svc;
 use FS::part_export_option;
 use FS::export_svc;
 
-@ISA = qw(FS::Record);
+@ISA = qw( FS::option_Common );
+@EXPORT_OK = qw(export_info);
+
+$DEBUG = 0;
 
 =head1 NAME
 
@@ -98,48 +104,6 @@ otherwise returns false.
 If a hash reference of options is supplied, part_export_option records are
 created (see L<FS::part_export_option>).
 
-=cut
-
-#false laziness w/queue.pm
-sub insert {
-  my $self = shift;
-  my $options = shift;
-  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;
-
-  my $error = $self->SUPER::insert;
-  if ( $error ) {
-    $dbh->rollback if $oldAutoCommit;
-    return $error;
-  }
-
-  foreach my $optionname ( keys %{$options} ) {
-    my $part_export_option = new FS::part_export_option ( {
-      'exportnum'   => $self->exportnum,
-      'optionname'  => $optionname,
-      'optionvalue' => $options->{$optionname},
-    } );
-    $error = $part_export_option->insert;
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return $error;
-    }
-  }
-
-  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
-  '';
-
-};
-
 =item delete
 
 Delete this record from the database.
@@ -166,14 +130,6 @@ sub delete {
     return $error;
   }
 
-  foreach my $part_export_option ( $self->part_export_option ) {
-    my $error = $part_export_option->delete;
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return $error;
-    }
-  }
-
   foreach my $export_svc ( $self->export_svc ) {
     my $error = $export_svc->delete;
     if ( $error ) {
@@ -188,72 +144,6 @@ sub delete {
 
 }
 
-=item replace OLD_RECORD HASHREF
-
-Replaces the OLD_RECORD with this one in the database.  If there is an error,
-returns the error, otherwise returns false.
-
-If a hash reference of options is supplied, part_export_option records are
-created or modified (see L<FS::part_export_option>).
-
-=cut
-
-sub replace {
-  my $self = shift;
-  my $old = shift;
-  my $options = shift;
-  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;
-
-  my $error = $self->SUPER::replace($old);
-  if ( $error ) {
-    $dbh->rollback if $oldAutoCommit;
-    return $error;
-  }
-
-  foreach my $optionname ( keys %{$options} ) {
-    my $old = qsearchs( 'part_export_option', {
-        'exportnum'   => $self->exportnum,
-        'optionname'  => $optionname,
-    } );
-    my $new = new FS::part_export_option ( {
-        'exportnum'   => $self->exportnum,
-        'optionname'  => $optionname,
-        'optionvalue' => $options->{$optionname},
-    } );
-    $new->optionnum($old->optionnum) if $old;
-    my $error = $old ? $new->replace($old) : $new->insert;
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return $error;
-    }
-  }
-
-  #remove extraneous old options
-  foreach my $opt (
-    grep { !exists $options->{$_->optionname} } $old->part_export_option
-  ) {
-    my $error = $opt->delete;
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return $error;
-    }
-  }
-
-  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-
-  '';
-
-};
-
 =item check
 
 Checks all fields to make sure this is a valid export.  If there is
@@ -271,12 +161,6 @@ sub check {
   ;
   return $error if $error;
 
-  warn $self->machine. "!!!\n";
-
-  $self->machine =~ /^([\w\-\.]*)$/
-    or return "Illegal machine: ". $self->machine;
-  $self->machine($1);
-
   $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain;
   $self->nodomain($1);
 
@@ -284,7 +168,7 @@ sub check {
 
   #check exporttype?
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 #=item part_svc
@@ -304,6 +188,30 @@ sub part_svc {
   #confess "FS::part_export::part_svc deprecated";
 }
 
+=item svc_x
+
+Returns a list of associated FS::svc_* records.
+
+=cut
+
+sub svc_x {
+  my $self = shift;
+  map { $_->svc_x } $self->cust_svc;
+}
+
+=item cust_svc
+
+Returns a list of associated FS::cust_svc records.
+
+=cut
+
+sub cust_svc {
+  my $self = shift;
+  map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+    grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+      $self->export_svc;
+}
+
 =item export_svc
 
 Returns a list of associated FS::export_svc records.
@@ -324,60 +232,44 @@ L<FS::part_export_option>).
 
 sub part_export_option {
   my $self = shift;
-  qsearch('part_export_option', { 'exportnum' => $self->exportnum } );
+  $self->option_objects;
 }
 
 =item options 
 
 Returns a list of option names and values suitable for assigning to a hash.
 
-=cut
-
-sub options {
-  my $self = shift;
-  map { $_->optionname => $_->optionvalue } $self->part_export_option;
-}
-
 =item option OPTIONNAME
 
 Returns the option value for the given name, or the empty string.
 
-=cut
-
-sub option {
-  my $self = shift;
-  my $part_export_option =
-    qsearchs('part_export_option', {
-      exportnum  => $self->exportnum,
-      optionname => shift,
-  } );
-  $part_export_option ? $part_export_option->optionvalue : '';
-}
-
-=item rebless
+=item _rebless
 
 Reblesses the object into the FS::part_export::EXPORTTYPE class, where
 EXPORTTYPE is the object's I<exporttype> field.  There should be better docs
-on how to create new exports (and they should live in their own files and be
-autoloaded-on-demand), but until then, see L</NEW EXPORT CLASSES>.
+on how to create new exports, but until then, see L</NEW EXPORT CLASSES>.
 
 =cut
 
-sub rebless {
+sub _rebless {
   my $self = shift;
   my $exporttype = $self->exporttype;
   my $class = ref($self). "::$exporttype";
   eval "use $class;";
-  bless($self, $class);
+  #die $@ if $@;
+  bless($self, $class) unless $@;
+  $self;
 }
 
+#these should probably all go away, just let the subclasses define em
+
 =item export_insert SVC_OBJECT
 
 =cut
 
 sub export_insert {
   my $self = shift;
-  $self->rebless;
+  #$self->rebless;
   $self->_export_insert(@_);
 }
 
@@ -396,7 +288,7 @@ sub export_insert {
 
 sub export_replace {
   my $self = shift;
-  $self->rebless;
+  #$self->rebless;
   $self->_export_replace(@_);
 }
 
@@ -406,10 +298,30 @@ sub export_replace {
 
 sub export_delete {
   my $self = shift;
-  $self->rebless;
+  #$self->rebless;
   $self->_export_delete(@_);
 }
 
+=item export_suspend
+
+=cut
+
+sub export_suspend {
+  my $self = shift;
+  #$self->rebless;
+  $self->_export_suspend(@_);
+}
+
+=item export_unsuspend
+
+=cut
+
+sub export_unsuspend {
+  my $self = shift;
+  #$self->rebless;
+  $self->_export_unsuspend(@_);
+}
+
 #fallbacks providing useful error messages intead of infinite loops
 sub _export_insert {
   my $self = shift;
@@ -426,17 +338,110 @@ sub _export_delete {
   return "_export_delete: unknown export type ". $self->exporttype;
 }
 
+#call svcdb-specific fallbacks
+
+sub _export_suspend {
+  my $self = shift;
+  #warn "warning: _export_suspened unimplemented for". ref($self);
+  my $svc_x = shift;
+  my $new = $svc_x->clone_suspended;
+  $self->_export_replace( $new, $svc_x );
+}
+
+sub _export_unsuspend {
+  my $self = shift;
+  #warn "warning: _export_unsuspend unimplemented for ". ref($self);
+  my $svc_x = shift;
+  my $old = $svc_x->clone_kludge_unsuspend;
+  $self->_export_replace( $svc_x, $old );
+}
+
+=back
+
+=head1 SUBROUTINES
+
+=over 4
+
+=item export_info [ SVCDB ]
+
+Returns a hash reference of the exports for the given I<svcdb>, or if no
+I<svcdb> is specified, for all exports.  The keys of the hash are
+I<exporttype>s and the values are again hash references containing information
+on the export:
+
+  'desc'     => 'Description',
+  'options'  => {
+                  'option'  => { label=>'Option Label' },
+                  'option2' => { label=>'Another label' },
+                },
+  'nodomain' => 'Y', #or ''
+  'notes'    => 'Additional notes',
+
+=cut
+
+sub export_info {
+  #warn $_[0];
+  return $exports{$_[0]} || {} if @_;
+  #{ map { %{$exports{$_}} } keys %exports };
+  my $r = { map { %{$exports{$_}} } keys %exports };
+}
+
+#=item exporttype2svcdb EXPORTTYPE
+#
+#Returns the applicable I<svcdb> for an I<exporttype>.
+#
+#=cut
+#
+#sub exporttype2svcdb {
+#  my $exporttype = $_[0];
+#  foreach my $svcdb ( keys %exports ) {
+#    return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}};
+#  }
+#  '';
+#}
+
+foreach my $INC ( @INC ) {
+  foreach my $file ( glob("$INC/FS/part_export/*.pm") ) {
+    warn "attempting to load export info from $file\n" if $DEBUG;
+    $file =~ /\/(\w+)\.pm$/ or do {
+      warn "unrecognized file in $INC/FS/part_export/: $file\n";
+      next;
+    };
+    my $mod = $1;
+    my $info = eval "use FS::part_export::$mod; ".
+                    "\\%FS::part_export::$mod\::info;";
+    if ( $@ ) {
+      die "error using FS::part_export::$mod (skipping): $@\n" if $@;
+      next;
+    }
+    unless ( keys %$info ) {
+      warn "no %info hash found in FS::part_export::$mod, skipping\n"
+        unless $mod =~ /^(passwdfile|null)$/; #hack but what the heck
+      next;
+    }
+    warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;
+    no strict 'refs';
+    foreach my $svc (
+      ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'}
+    ) {
+      unless ( $svc ) {
+        warn "blank svc for FS::part_export::$mod (skipping)\n";
+        next;
+      }
+      $exports{$svc}->{$mod} = $info;
+    }
+  }
+}
+
 =back
 
 =head1 NEW EXPORT CLASSES
 
-Should be added to httemplate/edit/part_export.cgi and a module should
-be FS/FS/part_export/ (an example may be found in eg/export_template.pm)
+A module should be added in FS/FS/part_export/ (an example may be found in
+eg/export_template.pm)
 
 =head1 BUGS
 
-Probably.
-
 Hmm... cust_export class (not necessarily a database table...) ... ?
 
 deprecated column...