FS/FS/part_export.pm

   1 package FS::part_export;
   2
   3 use strict;
   4 use vars qw( @ISA @EXPORT_OK $DEBUG %exports );
   5 use Exporter;
   6 use Tie::IxHash;
   7 use FS::Record qw( qsearch qsearchs dbh );
   8 use FS::option_Common;
   9 use FS::part_svc;
  10 use FS::part_export_option;
  11 use FS::export_svc;
  12
  13 @ISA = qw( FS::option_Common );
  14 @EXPORT_OK = qw(export_info);
  15
  16 $DEBUG = 0;
  17
  18 =head1 NAME
  19
  20 FS::part_export - Object methods for part_export records
  21
  22 =head1 SYNOPSIS
  23
  24   use FS::part_export;
  25
  26   $record = new FS::part_export \%hash;
  27   $record = new FS::part_export { 'column' => 'value' };
  28
  29   #($new_record, $options) = $template_recored->clone( $svcpart );
  30
  31   $error = $record->insert( { 'option' => 'value' } );
  32   $error = $record->insert( \%options );
  33
  34   $error = $new_record->replace($old_record);
  35
  36   $error = $record->delete;
  37
  38   $error = $record->check;
  39
  40 =head1 DESCRIPTION
  41
  42 An FS::part_export object represents an export of Freeside data to an external
  43 provisioning system.  FS::part_export inherits from FS::Record.  The following
  44 fields are currently supported:
  45
  46 =over 4
  47
  48 =item exportnum - primary key
  49
  50 =item machine - Machine name
  51
  52 =item exporttype - Export type
  53
  54 =item nodomain - blank or "Y" : usernames are exported to this service with no domain
  55
  56 =back
  57
  58 =head1 METHODS
  59
  60 =over 4
  61
  62 =item new HASHREF
  63
  64 Creates a new export.  To add the export to the database, see L<"insert">.
  65
  66 Note that this stores the hash reference, not a distinct copy of the hash it
  67 points to.  You can ask the object for a copy with the I<hash> method.
  68
  69 =cut
  70
  71 # the new method can be inherited from FS::Record, if a table method is defined
  72
  73 sub table { 'part_export'; }
  74
  75 =cut
  76
  77 #=item clone SVCPART
  78 #
  79 #An alternate constructor.  Creates a new export by duplicating an existing
  80 #export.  The given svcpart is assigned to the new export.
  81 #
  82 #Returns a list consisting of the new export object and a hashref of options.
  83 #
  84 #=cut
  85 #
  86 #sub clone {
  87 #  my $self = shift;
  88 #  my $class = ref($self);
  89 #  my %hash = $self->hash;
  90 #  $hash{'exportnum'} = '';
  91 #  $hash{'svcpart'} = shift;
  92 #  ( $class->new( \%hash ),
  93 #    { map { $_->optionname => $_->optionvalue }
  94 #        qsearch('part_export_option', { 'exportnum' => $self->exportnum } )
  95 #    }
  96 #  );
  97 #}
  98
  99 =item insert HASHREF
 100
 101 Adds this record to the database.  If there is an error, returns the error,
 102 otherwise returns false.
 103
 104 If a hash reference of options is supplied, part_export_option records are
 105 created (see L<FS::part_export_option>).
 106
 107 =item delete
 108
 109 Delete this record from the database.
 110
 111 =cut
 112
 113 #foreign keys would make this much less tedious... grr dumb mysql
 114 sub delete {
 115   my $self = shift;
 116   local $SIG{HUP} = 'IGNORE';
 117   local $SIG{INT} = 'IGNORE';
 118   local $SIG{QUIT} = 'IGNORE';
 119   local $SIG{TERM} = 'IGNORE';
 120   local $SIG{TSTP} = 'IGNORE';
 121   local $SIG{PIPE} = 'IGNORE';
 122
 123   my $oldAutoCommit = $FS::UID::AutoCommit;
 124   local $FS::UID::AutoCommit = 0;
 125   my $dbh = dbh;
 126
 127   my $error = $self->SUPER::delete;
 128   if ( $error ) {
 129     $dbh->rollback if $oldAutoCommit;
 130     return $error;
 131   }
 132
 133   foreach my $export_svc ( $self->export_svc ) {
 134     my $error = $export_svc->delete;
 135     if ( $error ) {
 136       $dbh->rollback if $oldAutoCommit;
 137       return $error;
 138     }
 139   }
 140
 141   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 142
 143   '';
 144
 145 }
 146
 147 =item check
 148
 149 Checks all fields to make sure this is a valid export.  If there is
 150 an error, returns the error, otherwise returns false.  Called by the insert
 151 and replace methods.
 152
 153 =cut
 154
 155 sub check {
 156   my $self = shift;
 157   my $error =
 158     $self->ut_numbern('exportnum')
 159     || $self->ut_domain('machine')
 160     || $self->ut_alpha('exporttype')
 161   ;
 162   return $error if $error;
 163
 164   $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain;
 165   $self->nodomain($1);
 166
 167   $self->deprecated(1); #BLAH
 168
 169   #check exporttype?
 170
 171   $self->SUPER::check;
 172 }
 173
 174 #=item part_svc
 175 #
 176 #Returns the service definition (see L<FS::part_svc>) for this export.
 177 #
 178 #=cut
 179 #
 180 #sub part_svc {
 181 #  my $self = shift;
 182 #  qsearchs('part_svc', { svcpart => $self->svcpart } );
 183 #}
 184
 185 sub part_svc {
 186   use Carp;
 187   croak "FS::part_export::part_svc deprecated";
 188   #confess "FS::part_export::part_svc deprecated";
 189 }
 190
 191 =item svc_x
 192
 193 Returns a list of associated FS::svc_* records.
 194
 195 =cut
 196
 197 sub svc_x {
 198   my $self = shift;
 199   map { $_->svc_x } $self->cust_svc;
 200 }
 201
 202 =item cust_svc
 203
 204 Returns a list of associated FS::cust_svc records.
 205
 206 =cut
 207
 208 sub cust_svc {
 209   my $self = shift;
 210   map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
 211     grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
 212       $self->export_svc;
 213 }
 214
 215 =item export_svc
 216
 217 Returns a list of associated FS::export_svc records.
 218
 219 =cut
 220
 221 sub export_svc {
 222   my $self = shift;
 223   qsearch('export_svc', { 'exportnum' => $self->exportnum } );
 224 }
 225
 226 =item part_export_option
 227
 228 Returns all options as FS::part_export_option objects (see
 229 L<FS::part_export_option>).
 230
 231 =cut
 232
 233 sub part_export_option {
 234   my $self = shift;
 235   $self->option_objects;
 236 }
 237
 238 =item options
 239
 240 Returns a list of option names and values suitable for assigning to a hash.
 241
 242 =item option OPTIONNAME
 243
 244 Returns the option value for the given name, or the empty string.
 245
 246 =item _rebless
 247
 248 Reblesses the object into the FS::part_export::EXPORTTYPE class, where
 249 EXPORTTYPE is the object's I<exporttype> field.  There should be better docs
 250 on how to create new exports, but until then, see L</NEW EXPORT CLASSES>.
 251
 252 =cut
 253
 254 sub _rebless {
 255   my $self = shift;
 256   my $exporttype = $self->exporttype;
 257   my $class = ref($self). "::$exporttype";
 258   eval "use $class;";
 259   #die $@ if $@;
 260   bless($self, $class) unless $@;
 261   $self;
 262 }
 263
 264 #these should probably all go away, just let the subclasses define em
 265
 266 =item export_insert SVC_OBJECT
 267
 268 =cut
 269
 270 sub export_insert {
 271   my $self = shift;
 272   #$self->rebless;
 273   $self->_export_insert(@_);
 274 }
 275
 276 #sub AUTOLOAD {
 277 #  my $self = shift;
 278 #  $self->rebless;
 279 #  my $method = $AUTOLOAD;
 280 #  #$method =~ s/::(\w+)$/::_$1/; #infinite loop prevention
 281 #  $method =~ s/::(\w+)$/_$1/; #infinite loop prevention
 282 #  $self->$method(@_);
 283 #}
 284
 285 =item export_replace NEW OLD
 286
 287 =cut
 288
 289 sub export_replace {
 290   my $self = shift;
 291   #$self->rebless;
 292   $self->_export_replace(@_);
 293 }
 294
 295 =item export_delete
 296
 297 =cut
 298
 299 sub export_delete {
 300   my $self = shift;
 301   #$self->rebless;
 302   $self->_export_delete(@_);
 303 }
 304
 305 =item export_suspend
 306
 307 =cut
 308
 309 sub export_suspend {
 310   my $self = shift;
 311   #$self->rebless;
 312   $self->_export_suspend(@_);
 313 }
 314
 315 =item export_unsuspend
 316
 317 =cut
 318
 319 sub export_unsuspend {
 320   my $self = shift;
 321   #$self->rebless;
 322   $self->_export_unsuspend(@_);
 323 }
 324
 325 #fallbacks providing useful error messages intead of infinite loops
 326 sub _export_insert {
 327   my $self = shift;
 328   return "_export_insert: unknown export type ". $self->exporttype;
 329 }
 330
 331 sub _export_replace {
 332   my $self = shift;
 333   return "_export_replace: unknown export type ". $self->exporttype;
 334 }
 335
 336 sub _export_delete {
 337   my $self = shift;
 338   return "_export_delete: unknown export type ". $self->exporttype;
 339 }
 340
 341 #call svcdb-specific fallbacks
 342
 343 sub _export_suspend {
 344   my $self = shift;
 345   #warn "warning: _export_suspened unimplemented for". ref($self);
 346   my $svc_x = shift;
 347   my $new = $svc_x->clone_suspended;
 348   $self->_export_replace( $new, $svc_x );
 349 }
 350
 351 sub _export_unsuspend {
 352   my $self = shift;
 353   #warn "warning: _export_unsuspend unimplemented for ". ref($self);
 354   my $svc_x = shift;
 355   my $old = $svc_x->clone_kludge_unsuspend;
 356   $self->_export_replace( $svc_x, $old );
 357 }
 358
 359 =back
 360
 361 =head1 SUBROUTINES
 362
 363 =over 4
 364
 365 =item export_info [ SVCDB ]
 366
 367 Returns a hash reference of the exports for the given I<svcdb>, or if no
 368 I<svcdb> is specified, for all exports.  The keys of the hash are
 369 I<exporttype>s and the values are again hash references containing information
 370 on the export:
 371
 372   'desc'     => 'Description',
 373   'options'  => {
 374                   'option'  => { label=>'Option Label' },
 375                   'option2' => { label=>'Another label' },
 376                 },
 377   'nodomain' => 'Y', #or ''
 378   'notes'    => 'Additional notes',
 379
 380 =cut
 381
 382 sub export_info {
 383   #warn $_[0];
 384   return $exports{$_[0]} || {} if @_;
 385   #{ map { %{$exports{$_}} } keys %exports };
 386   my $r = { map { %{$exports{$_}} } keys %exports };
 387 }
 388
 389 #=item exporttype2svcdb EXPORTTYPE
 390 #
 391 #Returns the applicable I<svcdb> for an I<exporttype>.
 392 #
 393 #=cut
 394 #
 395 #sub exporttype2svcdb {
 396 #  my $exporttype = $_[0];
 397 #  foreach my $svcdb ( keys %exports ) {
 398 #    return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}};
 399 #  }
 400 #  '';
 401 #}
 402
 403 foreach my $INC ( @INC ) {
 404   foreach my $file ( glob("$INC/FS/part_export/*.pm") ) {
 405     warn "attempting to load export info from $file\n" if $DEBUG;
 406     $file =~ /\/(\w+)\.pm$/ or do {
 407       warn "unrecognized file in $INC/FS/part_export/: $file\n";
 408       next;
 409     };
 410     my $mod = $1;
 411     my $info = eval "use FS::part_export::$mod; ".
 412                     "\\%FS::part_export::$mod\::info;";
 413     if ( $@ ) {
 414       die "error using FS::part_export::$mod (skipping): $@\n" if $@;
 415       next;
 416     }
 417     unless ( keys %$info ) {
 418       warn "no %info hash found in FS::part_export::$mod, skipping\n"
 419         unless $mod =~ /^(passwdfile|null)$/; #hack but what the heck
 420       next;
 421     }
 422     warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;
 423     no strict 'refs';
 424     foreach my $svc (
 425       ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'}
 426     ) {
 427       unless ( $svc ) {
 428         warn "blank svc for FS::part_export::$mod (skipping)\n";
 429         next;
 430       }
 431       $exports{$svc}->{$mod} = $info;
 432     }
 433   }
 434 }
 435
 436 =back
 437
 438 =head1 NEW EXPORT CLASSES
 439
 440 A module should be added in FS/FS/part_export/ (an example may be found in
 441 eg/export_template.pm)
 442
 443 =head1 BUGS
 444
 445 Hmm... cust_export class (not necessarily a database table...) ... ?
 446
 447 deprecated column...
 448
 449 =head1 SEE ALSO
 450
 451 L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_acct>,
 452 L<FS::svc_domain>,
 453 L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation.
 454
 455 =cut
 456
 457 1;
 458