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