tax report!
[freeside.git] / FS / FS / part_export.pm
index 67371bc..bd12389 100644 (file)
@@ -1,11 +1,18 @@
 package FS::part_export;
 
 use strict;
 package FS::part_export;
 
 use strict;
-use vars qw( @ISA );
-use FS::Record qw( qsearch qsearchs );
+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_svc;
+use FS::part_export_option;
+use FS::export_svc;
 
 @ISA = qw(FS::Record);
 
 @ISA = qw(FS::Record);
+@EXPORT_OK = qw(export_info);
+
+$DEBUG = 0;
 
 =head1 NAME
 
 
 =head1 NAME
 
@@ -18,7 +25,10 @@ FS::part_export - Object methods for part_export records
   $record = new FS::part_export \%hash;
   $record = new FS::part_export { 'column' => 'value' };
 
   $record = new FS::part_export \%hash;
   $record = new FS::part_export { 'column' => 'value' };
 
-  $error = $record->insert;
+  #($new_record, $options) = $template_recored->clone( $svcpart );
+
+  $error = $record->insert( { 'option' => 'value' } );
+  $error = $record->insert( \%options );
 
   $error = $new_record->replace($old_record);
 
 
   $error = $new_record->replace($old_record);
 
@@ -34,9 +44,7 @@ fields are currently supported:
 
 =over 4
 
 
 =over 4
 
-=item eventpart - primary key
-
-=item svcpart - Service definition (see L<FS::part_svc>) to which this export applies
+=item exportnum - primary key
 
 =item machine - Machine name 
 
 
 =item machine - Machine name 
 
@@ -63,14 +71,79 @@ points to.  You can ask the object for a copy with the I<hash> method.
 
 sub table { 'part_export'; }
 
 
 sub table { 'part_export'; }
 
-=item insert
+=cut
+
+#=item clone SVCPART
+#
+#An alternate constructor.  Creates a new export by duplicating an existing
+#export.  The given svcpart is assigned to the new export.
+#
+#Returns a list consisting of the new export object and a hashref of options.
+#
+#=cut
+#
+#sub clone {
+#  my $self = shift;
+#  my $class = ref($self);
+#  my %hash = $self->hash;
+#  $hash{'exportnum'} = '';
+#  $hash{'svcpart'} = shift;
+#  ( $class->new( \%hash ),
+#    { map { $_->optionname => $_->optionvalue }
+#        qsearch('part_export_option', { 'exportnum' => $self->exportnum } )
+#    }
+#  );
+#}
+
+=item insert HASHREF
 
 Adds this record to the database.  If there is an error, returns the error,
 otherwise returns false.
 
 
 Adds this record to 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 (see L<FS::part_export_option>).
+
 =cut
 
 =cut
 
-# the insert method can be inherited from FS::Record
+#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
 
 
 =item delete
 
@@ -78,16 +151,113 @@ Delete this record from the database.
 
 =cut
 
 
 =cut
 
-# the delete method can be inherited from FS::Record
+#foreign keys would make this much less tedious... grr dumb mysql
+sub delete {
+  my $self = 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::delete;
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    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 ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+  '';
+
+}
 
 
-=item replace OLD_RECORD
+=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.
 
 
 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
 
 =cut
 
-# the replace method can be inherited from FS::Record
+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
 
 
 =item check
 
@@ -101,35 +271,317 @@ sub check {
   my $self = shift;
   my $error = 
     $self->ut_numbern('exportnum')
   my $self = shift;
   my $error = 
     $self->ut_numbern('exportnum')
-    || $self->ut_number('svcpart')
+    || $self->ut_domain('machine')
     || $self->ut_alpha('exporttype')
   ;
   return $error if $error;
 
     || $self->ut_alpha('exporttype')
   ;
   return $error if $error;
 
-  return "Unknown svcpart: ". $self->svcpart
-    unless qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
-
-  $self->machine =~ /^([\w\-\.]*)$/
-    or return "Illegal machine: ". $self->machine;
-  $self->machine($1);
-
   $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain;
   $self->nodomain($1);
 
   $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain;
   $self->nodomain($1);
 
+  $self->deprecated(1); #BLAH
+
   #check exporttype?
 
   #check exporttype?
 
-  ''; #no error
+  $self->SUPER::check;
+}
+
+#=item part_svc
+#
+#Returns the service definition (see L<FS::part_svc>) for this export.
+#
+#=cut
+#
+#sub part_svc {
+#  my $self = shift;
+#  qsearchs('part_svc', { svcpart => $self->svcpart } );
+#}
+
+sub part_svc {
+  use Carp;
+  croak "FS::part_export::part_svc deprecated";
+  #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.
+
+=cut
+
+sub export_svc {
+  my $self = shift;
+  qsearch('export_svc', { 'exportnum' => $self->exportnum } );
+}
+
+=item part_export_option
+
+Returns all options as FS::part_export_option objects (see
+L<FS::part_export_option>).
+
+=cut
+
+sub part_export_option {
+  my $self = shift;
+  qsearch('part_export_option', { 'exportnum' => $self->exportnum } );
+}
+
+=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
+
+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>.
+
+=cut
+
+sub rebless {
+  my $self = shift;
+  my $exporttype = $self->exporttype;
+  my $class = ref($self). "::$exporttype";
+  eval "use $class;";
+  die $@ if $@;
+  bless($self, $class);
+}
+
+=item export_insert SVC_OBJECT
+
+=cut
+
+sub export_insert {
+  my $self = shift;
+  $self->rebless;
+  $self->_export_insert(@_);
+}
+
+#sub AUTOLOAD {
+#  my $self = shift;
+#  $self->rebless;
+#  my $method = $AUTOLOAD;
+#  #$method =~ s/::(\w+)$/::_$1/; #infinite loop prevention
+#  $method =~ s/::(\w+)$/_$1/; #infinite loop prevention
+#  $self->$method(@_);
+#}
+
+=item export_replace NEW OLD
+
+=cut
+
+sub export_replace {
+  my $self = shift;
+  $self->rebless;
+  $self->_export_replace(@_);
+}
+
+=item export_delete
+
+=cut
+
+sub export_delete {
+  my $self = shift;
+  $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;
+  return "_export_insert: unknown export type ". $self->exporttype;
+}
+
+sub _export_replace {
+  my $self = shift;
+  return "_export_replace: unknown export type ". $self->exporttype;
+}
+
+sub _export_delete {
+  my $self = shift;
+  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
 
 }
 
 =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
+
+A module should be added in FS/FS/part_export/ (an example may be found in
+eg/export_template.pm)
+
 =head1 BUGS
 
 =head1 BUGS
 
-Probably.
+Hmm... cust_export class (not necessarily a database table...) ... ?
+
+deprecated column...
 
 =head1 SEE ALSO
 
 
 =head1 SEE ALSO
 
-L<FS::part_export_option>, L<FS::part_svc>, L<FS::svc_acct>, L<FS::svc_domain>,
+L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_acct>,
+L<FS::svc_domain>,
 L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation.
 
 =cut
 L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation.
 
 =cut