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 label
 181
 182 Returns a label for this export, "exportname||exportype (machine)".
 183
 184 =cut
 185
 186 sub label {
 187   my $self = shift;
 188   ($self->exportname || $self->exporttype ). ' ('. $self->machine. ')';
 189 }
 190
 191 #=item part_svc
 192 #
 193 #Returns the service definition (see L<FS::part_svc>) for this export.
 194 #
 195 #=cut
 196 #
 197 #sub part_svc {
 198 #  my $self = shift;
 199 #  qsearchs('part_svc', { svcpart => $self->svcpart } );
 200 #}
 201
 202 sub part_svc {
 203   use Carp;
 204   croak "FS::part_export::part_svc deprecated";
 205   #confess "FS::part_export::part_svc deprecated";
 206 }
 207
 208 =item svc_x
 209
 210 Returns a list of associated FS::svc_* records.
 211
 212 =cut
 213
 214 sub svc_x {
 215   my $self = shift;
 216   map { $_->svc_x } $self->cust_svc;
 217 }
 218
 219 =item cust_svc
 220
 221 Returns a list of associated FS::cust_svc records.
 222
 223 =cut
 224
 225 sub cust_svc {
 226   my $self = shift;
 227   map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
 228     grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
 229       $self->export_svc;
 230 }
 231
 232 =item export_svc
 233
 234 Returns a list of associated FS::export_svc records.
 235
 236 =cut
 237
 238 sub export_svc {
 239   my $self = shift;
 240   qsearch('export_svc', { 'exportnum' => $self->exportnum } );
 241 }
 242
 243 =item export_device
 244
 245 Returns a list of associated FS::export_device records.
 246
 247 =cut
 248
 249 sub export_device {
 250   my $self = shift;
 251   qsearch('export_device', { 'exportnum' => $self->exportnum } );
 252 }
 253
 254 =item part_export_option
 255
 256 Returns all options as FS::part_export_option objects (see
 257 L<FS::part_export_option>).
 258
 259 =cut
 260
 261 sub part_export_option {
 262   my $self = shift;
 263   $self->option_objects;
 264 }
 265
 266 =item options
 267
 268 Returns a list of option names and values suitable for assigning to a hash.
 269
 270 =item option OPTIONNAME
 271
 272 Returns the option value for the given name, or the empty string.
 273
 274 =item _rebless
 275
 276 Reblesses the object into the FS::part_export::EXPORTTYPE class, where
 277 EXPORTTYPE is the object's I<exporttype> field.  There should be better docs
 278 on how to create new exports, but until then, see L</NEW EXPORT CLASSES>.
 279
 280 =cut
 281
 282 sub _rebless {
 283   my $self = shift;
 284   my $exporttype = $self->exporttype;
 285   my $class = ref($self). "::$exporttype";
 286   eval "use $class;";
 287   #die $@ if $@;
 288   bless($self, $class) unless $@;
 289   $self;
 290 }
 291
 292 #these should probably all go away, just let the subclasses define em
 293
 294 =item export_insert SVC_OBJECT
 295
 296 =cut
 297
 298 sub export_insert {
 299   my $self = shift;
 300   #$self->rebless;
 301   $self->_export_insert(@_);
 302 }
 303
 304 #sub AUTOLOAD {
 305 #  my $self = shift;
 306 #  $self->rebless;
 307 #  my $method = $AUTOLOAD;
 308 #  #$method =~ s/::(\w+)$/::_$1/; #infinite loop prevention
 309 #  $method =~ s/::(\w+)$/_$1/; #infinite loop prevention
 310 #  $self->$method(@_);
 311 #}
 312
 313 =item export_replace NEW OLD
 314
 315 =cut
 316
 317 sub export_replace {
 318   my $self = shift;
 319   #$self->rebless;
 320   $self->_export_replace(@_);
 321 }
 322
 323 =item export_delete
 324
 325 =cut
 326
 327 sub export_delete {
 328   my $self = shift;
 329   #$self->rebless;
 330   $self->_export_delete(@_);
 331 }
 332
 333 =item export_suspend
 334
 335 =cut
 336
 337 sub export_suspend {
 338   my $self = shift;
 339   #$self->rebless;
 340   $self->_export_suspend(@_);
 341 }
 342
 343 =item export_unsuspend
 344
 345 =cut
 346
 347 sub export_unsuspend {
 348   my $self = shift;
 349   #$self->rebless;
 350   $self->_export_unsuspend(@_);
 351 }
 352
 353 #fallbacks providing useful error messages intead of infinite loops
 354 sub _export_insert {
 355   my $self = shift;
 356   return "_export_insert: unknown export type ". $self->exporttype;
 357 }
 358
 359 sub _export_replace {
 360   my $self = shift;
 361   return "_export_replace: unknown export type ". $self->exporttype;
 362 }
 363
 364 sub _export_delete {
 365   my $self = shift;
 366   return "_export_delete: unknown export type ". $self->exporttype;
 367 }
 368
 369 #call svcdb-specific fallbacks
 370
 371 sub _export_suspend {
 372   my $self = shift;
 373   #warn "warning: _export_suspened unimplemented for". ref($self);
 374   my $svc_x = shift;
 375   my $new = $svc_x->clone_suspended;
 376   $self->_export_replace( $new, $svc_x );
 377 }
 378
 379 sub _export_unsuspend {
 380   my $self = shift;
 381   #warn "warning: _export_unsuspend unimplemented for ". ref($self);
 382   my $svc_x = shift;
 383   my $old = $svc_x->clone_kludge_unsuspend;
 384   $self->_export_replace( $svc_x, $old );
 385 }
 386
 387 =item export_links SVC_OBJECT ARRAYREF
 388
 389 Adds a list of web elements to ARRAYREF specific to this export and SVC_OBJECT.
 390 The elements are displayed in the UI to lead the the operator to external
 391 configuration, monitoring, and similar tools.
 392
 393 =item export_getsettings SVC_OBJECT SETTINGS_HASHREF DEFAUTS_HASHREF
 394
 395 Adds a hashref of settings to SETTINGSREF specific to this export and
 396 SVC_OBJECT.  The elements can be displayed in the UI on the service view.
 397
 398 DEFAULTSREF is a hashref with the same keys where true values indicate the
 399 setting is a default (and thus can be displayed in the UI with less emphasis,
 400 or hidden by default).
 401
 402 =cut
 403
 404 =item weight
 405
 406 Returns the 'weight' element from the export's %info hash, or 0 if there is
 407 no weight defined.
 408
 409 =cut
 410
 411 sub weight {
 412   my $self = shift;
 413   export_info()->{$self->exporttype}->{'weight'} || 0;
 414 }
 415
 416 =back
 417
 418 =head1 SUBROUTINES
 419
 420 =over 4
 421
 422 =item export_info [ SVCDB ]
 423
 424 Returns a hash reference of the exports for the given I<svcdb>, or if no
 425 I<svcdb> is specified, for all exports.  The keys of the hash are
 426 I<exporttype>s and the values are again hash references containing information
 427 on the export:
 428
 429   'desc'     => 'Description',
 430   'options'  => {
 431                   'option'  => { label=>'Option Label' },
 432                   'option2' => { label=>'Another label' },
 433                 },
 434   'nodomain' => 'Y', #or ''
 435   'notes'    => 'Additional notes',
 436
 437 =cut
 438
 439 sub export_info {
 440   #warn $_[0];
 441   return $exports{$_[0]} || {} if @_;
 442   #{ map { %{$exports{$_}} } keys %exports };
 443   my $r = { map { %{$exports{$_}} } keys %exports };
 444 }
 445
 446
 447 sub _upgrade_data {  #class method
 448   my ($class, %opts) = @_;
 449
 450   my @part_export_option = qsearch('part_export_option', { 'optionname' => 'overlimit_groups' });
 451   foreach my $opt ( @part_export_option ) {
 452     next if $opt->optionvalue =~ /^[\d\s]+$/ || !$opt->optionvalue;
 453     my @groupnames = split(' ',$opt->optionvalue);
 454     my @groupnums;
 455     my $error = '';
 456     foreach my $groupname ( @groupnames ) {
 457         my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
 458         unless ( $g ) {
 459             $g = new FS::radius_group {
 460                             'groupname' => $groupname,
 461                             'description' => $groupname,
 462                             };
 463             $error = $g->insert;
 464             die $error if $error;
 465         }
 466         push @groupnums, $g->groupnum;
 467     }
 468     $opt->optionvalue(join(' ',@groupnums));
 469     $error = $opt->replace;
 470     die $error if $error;
 471   }
 472 }
 473
 474 #=item exporttype2svcdb EXPORTTYPE
 475 #
 476 #Returns the applicable I<svcdb> for an I<exporttype>.
 477 #
 478 #=cut
 479 #
 480 #sub exporttype2svcdb {
 481 #  my $exporttype = $_[0];
 482 #  foreach my $svcdb ( keys %exports ) {
 483 #    return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}};
 484 #  }
 485 #  '';
 486 #}
 487
 488 #false laziness w/part_pkg & cdr
 489 foreach my $INC ( @INC ) {
 490   foreach my $file ( glob("$INC/FS/part_export/*.pm") ) {
 491     warn "attempting to load export info from $file\n" if $DEBUG;
 492     $file =~ /\/(\w+)\.pm$/ or do {
 493       warn "unrecognized file in $INC/FS/part_export/: $file\n";
 494       next;
 495     };
 496     my $mod = $1;
 497     my $info = eval "use FS::part_export::$mod; ".
 498                     "\\%FS::part_export::$mod\::info;";
 499     if ( $@ ) {
 500       die "error using FS::part_export::$mod (skipping): $@\n" if $@;
 501       next;
 502     }
 503     unless ( keys %$info ) {
 504       warn "no %info hash found in FS::part_export::$mod, skipping\n"
 505         unless $mod =~ /^(passwdfile|null|.+_Common)$/; #hack but what the heck
 506       next;
 507     }
 508     warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;
 509     no strict 'refs';
 510     foreach my $svc (
 511       ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'}
 512     ) {
 513       unless ( $svc ) {
 514         warn "blank svc for FS::part_export::$mod (skipping)\n";
 515         next;
 516       }
 517       $exports{$svc}->{$mod} = $info;
 518     }
 519   }
 520 }
 521
 522 =back
 523
 524 =head1 NEW EXPORT CLASSES
 525
 526 A module should be added in FS/FS/part_export/ (an example may be found in
 527 eg/export_template.pm)
 528
 529 =head1 BUGS
 530
 531 Hmm... cust_export class (not necessarily a database table...) ... ?
 532
 533 deprecated column...
 534
 535 =head1 SEE ALSO
 536
 537 L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_acct>,
 538 L<FS::svc_domain>,
 539 L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation.
 540
 541 =cut
 542
 543 1;
 544