FS/FS/part_export.pm

   1 package FS::part_export;
   2
   3 use strict;
   4 use vars qw( @ISA @EXPORT_OK %exports );
   5 use Exporter;
   6 use FS::Record qw( qsearch qsearchs dbh );
   7 use FS::part_svc;
   8 use FS::part_export_option;
   9 use FS::export_svc;
  10
  11 @ISA = qw(FS::Record);
  12 @EXPORT_OK = qw(export_info);
  13
  14 =head1 NAME
  15
  16 FS::part_export - Object methods for part_export records
  17
  18 =head1 SYNOPSIS
  19
  20   use FS::part_export;
  21
  22   $record = new FS::part_export \%hash;
  23   $record = new FS::part_export { 'column' => 'value' };
  24
  25   #($new_record, $options) = $template_recored->clone( $svcpart );
  26
  27   $error = $record->insert( { 'option' => 'value' } );
  28   $error = $record->insert( \%options );
  29
  30   $error = $new_record->replace($old_record);
  31
  32   $error = $record->delete;
  33
  34   $error = $record->check;
  35
  36 =head1 DESCRIPTION
  37
  38 An FS::part_export object represents an export of Freeside data to an external
  39 provisioning system.  FS::part_export inherits from FS::Record.  The following
  40 fields are currently supported:
  41
  42 =over 4
  43
  44 =item exportnum - primary key
  45
  46 =item machine - Machine name
  47
  48 =item exporttype - Export type
  49
  50 =item nodomain - blank or "Y" : usernames are exported to this service with no domain
  51
  52 =back
  53
  54 =head1 METHODS
  55
  56 =over 4
  57
  58 =item new HASHREF
  59
  60 Creates a new export.  To add the export to the database, see L<"insert">.
  61
  62 Note that this stores the hash reference, not a distinct copy of the hash it
  63 points to.  You can ask the object for a copy with the I<hash> method.
  64
  65 =cut
  66
  67 # the new method can be inherited from FS::Record, if a table method is defined
  68
  69 sub table { 'part_export'; }
  70
  71 =cut
  72
  73 #=item clone SVCPART
  74 #
  75 #An alternate constructor.  Creates a new export by duplicating an existing
  76 #export.  The given svcpart is assigned to the new export.
  77 #
  78 #Returns a list consisting of the new export object and a hashref of options.
  79 #
  80 #=cut
  81 #
  82 #sub clone {
  83 #  my $self = shift;
  84 #  my $class = ref($self);
  85 #  my %hash = $self->hash;
  86 #  $hash{'exportnum'} = '';
  87 #  $hash{'svcpart'} = shift;
  88 #  ( $class->new( \%hash ),
  89 #    { map { $_->optionname => $_->optionvalue }
  90 #        qsearch('part_export_option', { 'exportnum' => $self->exportnum } )
  91 #    }
  92 #  );
  93 #}
  94
  95 =item insert HASHREF
  96
  97 Adds this record to the database.  If there is an error, returns the error,
  98 otherwise returns false.
  99
 100 If a hash reference of options is supplied, part_export_option records are
 101 created (see L<FS::part_export_option>).
 102
 103 =cut
 104
 105 #false laziness w/queue.pm
 106 sub insert {
 107   my $self = shift;
 108   my $options = shift;
 109   local $SIG{HUP} = 'IGNORE';
 110   local $SIG{INT} = 'IGNORE';
 111   local $SIG{QUIT} = 'IGNORE';
 112   local $SIG{TERM} = 'IGNORE';
 113   local $SIG{TSTP} = 'IGNORE';
 114   local $SIG{PIPE} = 'IGNORE';
 115
 116   my $oldAutoCommit = $FS::UID::AutoCommit;
 117   local $FS::UID::AutoCommit = 0;
 118   my $dbh = dbh;
 119
 120   my $error = $self->SUPER::insert;
 121   if ( $error ) {
 122     $dbh->rollback if $oldAutoCommit;
 123     return $error;
 124   }
 125
 126   foreach my $optionname ( keys %{$options} ) {
 127     my $part_export_option = new FS::part_export_option ( {
 128       'exportnum'   => $self->exportnum,
 129       'optionname'  => $optionname,
 130       'optionvalue' => $options->{$optionname},
 131     } );
 132     $error = $part_export_option->insert;
 133     if ( $error ) {
 134       $dbh->rollback if $oldAutoCommit;
 135       return $error;
 136     }
 137   }
 138
 139   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 140
 141   '';
 142
 143 };
 144
 145 =item delete
 146
 147 Delete this record from the database.
 148
 149 =cut
 150
 151 #foreign keys would make this much less tedious... grr dumb mysql
 152 sub delete {
 153   my $self = shift;
 154   local $SIG{HUP} = 'IGNORE';
 155   local $SIG{INT} = 'IGNORE';
 156   local $SIG{QUIT} = 'IGNORE';
 157   local $SIG{TERM} = 'IGNORE';
 158   local $SIG{TSTP} = 'IGNORE';
 159   local $SIG{PIPE} = 'IGNORE';
 160
 161   my $oldAutoCommit = $FS::UID::AutoCommit;
 162   local $FS::UID::AutoCommit = 0;
 163   my $dbh = dbh;
 164
 165   my $error = $self->SUPER::delete;
 166   if ( $error ) {
 167     $dbh->rollback if $oldAutoCommit;
 168     return $error;
 169   }
 170
 171   foreach my $part_export_option ( $self->part_export_option ) {
 172     my $error = $part_export_option->delete;
 173     if ( $error ) {
 174       $dbh->rollback if $oldAutoCommit;
 175       return $error;
 176     }
 177   }
 178
 179   foreach my $export_svc ( $self->export_svc ) {
 180     my $error = $export_svc->delete;
 181     if ( $error ) {
 182       $dbh->rollback if $oldAutoCommit;
 183       return $error;
 184     }
 185   }
 186
 187   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 188
 189   '';
 190
 191 }
 192
 193 =item replace OLD_RECORD HASHREF
 194
 195 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 196 returns the error, otherwise returns false.
 197
 198 If a hash reference of options is supplied, part_export_option records are
 199 created or modified (see L<FS::part_export_option>).
 200
 201 =cut
 202
 203 sub replace {
 204   my $self = shift;
 205   my $old = shift;
 206   my $options = shift;
 207   local $SIG{HUP} = 'IGNORE';
 208   local $SIG{INT} = 'IGNORE';
 209   local $SIG{QUIT} = 'IGNORE';
 210   local $SIG{TERM} = 'IGNORE';
 211   local $SIG{TSTP} = 'IGNORE';
 212   local $SIG{PIPE} = 'IGNORE';
 213
 214   my $oldAutoCommit = $FS::UID::AutoCommit;
 215   local $FS::UID::AutoCommit = 0;
 216   my $dbh = dbh;
 217
 218   my $error = $self->SUPER::replace($old);
 219   if ( $error ) {
 220     $dbh->rollback if $oldAutoCommit;
 221     return $error;
 222   }
 223
 224   foreach my $optionname ( keys %{$options} ) {
 225     my $old = qsearchs( 'part_export_option', {
 226         'exportnum'   => $self->exportnum,
 227         'optionname'  => $optionname,
 228     } );
 229     my $new = new FS::part_export_option ( {
 230         'exportnum'   => $self->exportnum,
 231         'optionname'  => $optionname,
 232         'optionvalue' => $options->{$optionname},
 233     } );
 234     $new->optionnum($old->optionnum) if $old;
 235     my $error = $old ? $new->replace($old) : $new->insert;
 236     if ( $error ) {
 237       $dbh->rollback if $oldAutoCommit;
 238       return $error;
 239     }
 240   }
 241
 242   #remove extraneous old options
 243   foreach my $opt (
 244     grep { !exists $options->{$_->optionname} } $old->part_export_option
 245   ) {
 246     my $error = $opt->delete;
 247     if ( $error ) {
 248       $dbh->rollback if $oldAutoCommit;
 249       return $error;
 250     }
 251   }
 252
 253   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 254
 255   '';
 256
 257 };
 258
 259 =item check
 260
 261 Checks all fields to make sure this is a valid export.  If there is
 262 an error, returns the error, otherwise returns false.  Called by the insert
 263 and replace methods.
 264
 265 =cut
 266
 267 sub check {
 268   my $self = shift;
 269   my $error =
 270     $self->ut_numbern('exportnum')
 271     || $self->ut_domain('machine')
 272     || $self->ut_alpha('exporttype')
 273   ;
 274   return $error if $error;
 275
 276   warn $self->machine. "!!!\n";
 277
 278   $self->machine =~ /^([\w\-\.]*)$/
 279     or return "Illegal machine: ". $self->machine;
 280   $self->machine($1);
 281
 282   $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain;
 283   $self->nodomain($1);
 284
 285   $self->deprecated(1); #BLAH
 286
 287   #check exporttype?
 288
 289   ''; #no error
 290 }
 291
 292 #=item part_svc
 293 #
 294 #Returns the service definition (see L<FS::part_svc>) for this export.
 295 #
 296 #=cut
 297 #
 298 #sub part_svc {
 299 #  my $self = shift;
 300 #  qsearchs('part_svc', { svcpart => $self->svcpart } );
 301 #}
 302
 303 sub part_svc {
 304   use Carp;
 305   croak "FS::part_export::part_svc deprecated";
 306   #confess "FS::part_export::part_svc deprecated";
 307 }
 308
 309 =item export_svc
 310
 311 Returns a list of associated FS::export_svc records.
 312
 313 =cut
 314
 315 sub export_svc {
 316   my $self = shift;
 317   qsearch('export_svc', { 'exportnum' => $self->exportnum } );
 318 }
 319
 320 =item part_export_option
 321
 322 Returns all options as FS::part_export_option objects (see
 323 L<FS::part_export_option>).
 324
 325 =cut
 326
 327 sub part_export_option {
 328   my $self = shift;
 329   qsearch('part_export_option', { 'exportnum' => $self->exportnum } );
 330 }
 331
 332 =item options
 333
 334 Returns a list of option names and values suitable for assigning to a hash.
 335
 336 =cut
 337
 338 sub options {
 339   my $self = shift;
 340   map { $_->optionname => $_->optionvalue } $self->part_export_option;
 341 }
 342
 343 =item option OPTIONNAME
 344
 345 Returns the option value for the given name, or the empty string.
 346
 347 =cut
 348
 349 sub option {
 350   my $self = shift;
 351   my $part_export_option =
 352     qsearchs('part_export_option', {
 353       exportnum  => $self->exportnum,
 354       optionname => shift,
 355   } );
 356   $part_export_option ? $part_export_option->optionvalue : '';
 357 }
 358
 359 =item rebless
 360
 361 Reblesses the object into the FS::part_export::EXPORTTYPE class, where
 362 EXPORTTYPE is the object's I<exporttype> field.  There should be better docs
 363 on how to create new exports (and they should live in their own files and be
 364 autoloaded-on-demand), but until then, see L</NEW EXPORT CLASSES>.
 365
 366 =cut
 367
 368 sub rebless {
 369   my $self = shift;
 370   my $exporttype = $self->exporttype;
 371   my $class = ref($self). "::$exporttype";
 372   eval "use $class;";
 373   bless($self, $class);
 374 }
 375
 376 =item export_insert SVC_OBJECT
 377
 378 =cut
 379
 380 sub export_insert {
 381   my $self = shift;
 382   $self->rebless;
 383   $self->_export_insert(@_);
 384 }
 385
 386 #sub AUTOLOAD {
 387 #  my $self = shift;
 388 #  $self->rebless;
 389 #  my $method = $AUTOLOAD;
 390 #  #$method =~ s/::(\w+)$/::_$1/; #infinite loop prevention
 391 #  $method =~ s/::(\w+)$/_$1/; #infinite loop prevention
 392 #  $self->$method(@_);
 393 #}
 394
 395 =item export_replace NEW OLD
 396
 397 =cut
 398
 399 sub export_replace {
 400   my $self = shift;
 401   $self->rebless;
 402   $self->_export_replace(@_);
 403 }
 404
 405 =item export_delete
 406
 407 =cut
 408
 409 sub export_delete {
 410   my $self = shift;
 411   $self->rebless;
 412   $self->_export_delete(@_);
 413 }
 414
 415 #fallbacks providing useful error messages intead of infinite loops
 416 sub _export_insert {
 417   my $self = shift;
 418   return "_export_insert: unknown export type ". $self->exporttype;
 419 }
 420
 421 sub _export_replace {
 422   my $self = shift;
 423   return "_export_replace: unknown export type ". $self->exporttype;
 424 }
 425
 426 sub _export_delete {
 427   my $self = shift;
 428   return "_export_delete: unknown export type ". $self->exporttype;
 429 }
 430
 431 =back
 432
 433 =head1 SUBROUTINES
 434
 435 =over 4
 436
 437 =item export_info [ SVCDB ]
 438
 439 Returns a hash reference of the exports for the given I<svcdb>, or if no
 440 I<svcdb> is specified, for all exports.  The keys of the hash are
 441 I<exporttype>s and the values are again hash references containing information
 442 on the export:
 443
 444   'desc'     => 'Description',
 445   'options'  => {
 446                   'option'  => { label=>'Option Label' },
 447                   'option2' => { label=>'Another label' },
 448                 },
 449   'nodomain' => 'Y', #or ''
 450   'notes'    => 'Additional notes',
 451
 452 =cut
 453
 454 sub export_info {
 455   #warn $_[0];
 456   return $exports{$_[0]} if @_;
 457   #{ map { %{$exports{$_}} } keys %exports };
 458   my $r = { map { %{$exports{$_}} } keys %exports };
 459 }
 460
 461 =item exporttype2svcdb EXPORTTYPE
 462
 463 Returns the applicable I<svcdb> for an I<exporttype>.
 464
 465 =cut
 466
 467 sub exporttype2svcdb {
 468   my $exporttype = $_[0];
 469   foreach my $svcdb ( keys %exports ) {
 470     return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}};
 471   }
 472   '';
 473 }
 474
 475 %exports = (
 476   'svc_acct' => {
 477     'sysvshell' => {
 478       'desc' =>
 479         'Batch export of /etc/passwd and /etc/shadow files (Linux/SysV)',
 480       'options' => {},
 481     },
 482     'bsdshell' => {
 483       'desc' =>
 484         'Batch export of /etc/passwd and /etc/master.passwd files (BSD)',
 485       'options' => {},
 486     },
 487 #    'nis' => {
 488 #      'desc' =>
 489 #        'Batch export of /etc/global/passwd and /etc/global/shadow for NIS ',
 490 #      'options' => {},
 491 #    },
 492     'bsdshell' => {
 493       'desc' =>
 494         'Batch export of /etc/passwd and /etc/master.passwd files (BSD)',
 495       'options' => {},
 496     },
 497     'textradius' => {
 498       'desc' => 'Batch export of a text /etc/raddb/users file (Livingston, Cistron)',
 499     },
 500     'sqlradius' => {
 501       'desc' => 'Real-time export to SQL-backed RADIUS (ICRADIUS, FreeRADIUS)',
 502       'options' => {
 503         'datasrc'  => { label=>'DBI data source' },
 504         'username' => { label=>'Database username' },
 505         'password' => { label=>'Database password' },
 506       },
 507       'nodomain' => 'Y',
 508       'notes' => 'Not specifying datasrc will export to the freeside database? (no...  notes on MySQL replication, DBI::Proxy, etc., from Conf.pm && export.html etc., reset with bin/sqlradius_reset',
 509     },
 510     'cyrus' => {
 511       'desc' => 'Real-time export to Cyrus IMAP server',
 512     },
 513     'cp' => {
 514       'desc' => 'Real-time export to Critical Path Account Provisioning Protocol',
 515     },
 516     'infostreet' => {
 517       'desc' => 'Real-time export to InfoStreet streetSmartAPI',
 518       'options' => {
 519         'url'      => { label=>'XML-RPC Access URL', },
 520         'login'    => { label=>'InfoStreet login', },
 521         'password' => { label=>'InfoStreet password', },
 522         'groupID'  => { label=>'InfoStreet groupID', },
 523       },
 524       'nodomain' => 'Y',
 525       'notes' => 'Real-time export to <a href="http://www.infostreet.com/">InfoStreet</a> streetSmartAPI.  Requires installation of <a href="http://search.cpan.org/search?dist=Frontier-Client">Frontier::Client</a> from CPAN.',
 526     }
 527   },
 528
 529   'svc_domain' => {},
 530
 531   'svc_acct_sm' => {},
 532
 533   'svc_forward' => {},
 534
 535   'svc_www' => {},
 536
 537 );
 538
 539 =back
 540
 541 =head1 NEW EXPORT CLASSES
 542
 543 Should be added to the %export hash here, and a module should be added in
 544 FS/FS/part_export/ (an example may be found in eg/export_template.pm)
 545
 546 =head1 BUGS
 547
 548 Probably.
 549
 550 Hmm... cust_export class (not necessarily a database table...) ... ?
 551
 552 deprecated column...
 553
 554 =head1 SEE ALSO
 555
 556 L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_acct>,
 557 L<FS::svc_domain>,
 558 L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation.
 559
 560 =cut
 561
 562 1;
 563