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