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