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

diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm
index 8af413b1d..1e0b905fb 100644
--- a/FS/FS/part_export.pm
+++ b/FS/FS/part_export.pm
@@ -1,13 +1,18 @@
 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::part_svc;
 use FS::part_export_option;
 use FS::export_svc;
 
 @ISA = qw(FS::Record);
+@EXPORT_OK = qw(export_info);
+
+$DEBUG = 0;
 
 =head1 NAME
 
@@ -138,7 +143,7 @@ sub insert {
 
   '';
 
-};
+}
 
 =item delete
 
@@ -271,12 +276,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 +283,7 @@ sub check {
 
   #check exporttype?
 
-  ''; #no error
+  $self->SUPER::check;
 }
 
 #=item part_svc
@@ -304,6 +303,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.
@@ -354,30 +377,32 @@ sub option {
   $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;";
+  die $@ if $@;
   bless($self, $class);
 }
 
+#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 +421,7 @@ sub export_insert {
 
 sub export_replace {
   my $self = shift;
-  $self->rebless;
+  #$self->rebless;
   $self->_export_replace(@_);
 }
 
@@ -406,10 +431,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 +471,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...