RT#40641: unprovisioning preserved cancelled services
[freeside.git] / 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 );
8 use FS::Record qw( qsearch qsearchs dbh );
9 use FS::part_svc;
10 use FS::part_export_option;
11 use FS::part_export_machine;
12 use FS::svc_export_machine;
13 use FS::export_svc;
14 use FS::export_cust_svc;
15
16 #for export modules, though they should probably just use it themselves
17 use FS::queue;
18
19 @EXPORT_OK = qw(export_info);
20
21 $DEBUG = 0;
22
23 =head1 NAME
24
25 FS::part_export - Object methods for part_export records
26
27 =head1 SYNOPSIS
28
29   use FS::part_export;
30
31   $record = new FS::part_export \%hash;
32   $record = new FS::part_export { 'column' => 'value' };
33
34   #($new_record, $options) = $template_recored->clone( $svcpart );
35
36   $error = $record->insert( { 'option' => 'value' } );
37   $error = $record->insert( \%options );
38
39   $error = $new_record->replace($old_record);
40
41   $error = $record->delete;
42
43   $error = $record->check;
44
45 =head1 DESCRIPTION
46
47 An FS::part_export object represents an export of Freeside data to an external
48 provisioning system.  FS::part_export inherits from FS::Record.  The following
49 fields are currently supported:
50
51 =over 4
52
53 =item exportnum - primary key
54
55 =item exportname - Descriptive name
56
57 =item machine - Machine name 
58
59 =item exporttype - Export type
60
61 =item nodomain - blank or "Y" : usernames are exported to this service with no domain
62
63 =item default_machine - For exports that require a machine to be selected for
64 each service (see L<FS::svc_export_machine>), the one to use as the default.
65
66 =item no_suspend - Don't export service suspensions. In the future there may
67 be "no_*" options for the other service actions.
68
69 =back
70
71 =head1 METHODS
72
73 =over 4
74
75 =item new HASHREF
76
77 Creates a new export.  To add the export to the database, see L<"insert">.
78
79 Note that this stores the hash reference, not a distinct copy of the hash it
80 points to.  You can ask the object for a copy with the I<hash> method.
81
82 =cut
83
84 # the new method can be inherited from FS::Record, if a table method is defined
85
86 sub table { 'part_export'; }
87
88 =cut
89
90 #=item clone SVCPART
91 #
92 #An alternate constructor.  Creates a new export by duplicating an existing
93 #export.  The given svcpart is assigned to the new export.
94 #
95 #Returns a list consisting of the new export object and a hashref of options.
96 #
97 #=cut
98 #
99 #sub clone {
100 #  my $self = shift;
101 #  my $class = ref($self);
102 #  my %hash = $self->hash;
103 #  $hash{'exportnum'} = '';
104 #  $hash{'svcpart'} = shift;
105 #  ( $class->new( \%hash ),
106 #    { map { $_->optionname => $_->optionvalue }
107 #        qsearch('part_export_option', { 'exportnum' => $self->exportnum } )
108 #    }
109 #  );
110 #}
111
112 =item insert HASHREF
113
114 Adds this record to the database.  If there is an error, returns the error,
115 otherwise returns false.
116
117 If a hash reference of options is supplied, part_export_option records are
118 created (see L<FS::part_export_option>).
119
120 =cut
121
122 sub insert {
123   my $self = shift;
124
125   local $SIG{HUP} = 'IGNORE';
126   local $SIG{INT} = 'IGNORE';
127   local $SIG{QUIT} = 'IGNORE';
128   local $SIG{TERM} = 'IGNORE';
129   local $SIG{TSTP} = 'IGNORE';
130   local $SIG{PIPE} = 'IGNORE';
131   my $oldAutoCommit = $FS::UID::AutoCommit;
132   local $FS::UID::AutoCommit = 0;
133   my $dbh = dbh;
134
135   my $error = $self->SUPER::insert(@_)
136            || $self->replace;
137   # use replace to do all the part_export_machine and default_machine stuff
138   if ( $error ) {
139     $dbh->rollback if $oldAutoCommit;
140     return $error;
141   }
142
143   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
144   '';
145 }
146
147 =item delete
148
149 Delete this record from the database.
150
151 =cut
152
153 #foreign keys would make this much less tedious... grr dumb mysql
154 sub delete {
155   my $self = shift;
156
157   local $SIG{HUP} = 'IGNORE';
158   local $SIG{INT} = 'IGNORE';
159   local $SIG{QUIT} = 'IGNORE';
160   local $SIG{TERM} = 'IGNORE';
161   local $SIG{TSTP} = 'IGNORE';
162   local $SIG{PIPE} = 'IGNORE';
163   my $oldAutoCommit = $FS::UID::AutoCommit;
164   local $FS::UID::AutoCommit = 0;
165   my $dbh = dbh;
166
167   # delete associated export_cust_svc
168   foreach my $export_cust_svc ( 
169     qsearch('export_cust_svc',{ 'exportnum' => $self->exportnum })
170   ) {
171     my $error = $export_cust_svc->delete;
172     if ( $error ) {
173       $dbh->rollback if $oldAutoCommit;
174       return $error;
175     }
176   }
177
178   # clean up export_nas records
179   my $error = $self->process_m2m(
180     'link_table'    => 'export_nas',
181     'target_table'  => 'nas',
182     'params'        => [],
183   ) || $self->SUPER::delete;
184   if ( $error ) {
185     $dbh->rollback if $oldAutoCommit;
186     return $error;
187   }
188
189   foreach my $export_svc ( $self->export_svc ) {
190     my $error = $export_svc->delete;
191     if ( $error ) {
192       $dbh->rollback if $oldAutoCommit;
193       return $error;
194     }
195   }
196
197   foreach my $part_export_machine ( $self->part_export_machine ) {
198     my $error = $part_export_machine->delete;
199     if ( $error ) {
200       $dbh->rollback if $oldAutoCommit;
201       return $error;
202     }
203   }
204
205   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
206   '';
207 }
208
209 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
210
211 Replaces the OLD_RECORD with this one in the database.  If there is an error,
212 returns the error, otherwise returns false.
213
214 If a list or hash reference of options is supplied, option records are created
215 or modified.
216
217 =cut
218
219 sub replace {
220   my $self = shift;
221   my $old = $self->replace_old;
222
223   local $SIG{HUP} = 'IGNORE';
224   local $SIG{INT} = 'IGNORE';
225   local $SIG{QUIT} = 'IGNORE';
226   local $SIG{TERM} = 'IGNORE';
227   local $SIG{TSTP} = 'IGNORE';
228   local $SIG{PIPE} = 'IGNORE';
229
230   my $oldAutoCommit = $FS::UID::AutoCommit;
231   local $FS::UID::AutoCommit = 0;
232   my $dbh = dbh;
233   my $error;
234
235   if ( $self->part_export_machine_textarea ) {
236
237     my %part_export_machine = map { $_->machine => $_ }
238                                 $self->part_export_machine;
239
240     my @machines = map { $_ =~ s/^\s+//; $_ =~ s/\s+$//; $_ }
241                      grep /\S/,
242                        split /[\n\r]{1,2}/,
243                          $self->part_export_machine_textarea;
244
245     foreach my $machine ( @machines ) {
246
247       if ( $part_export_machine{$machine} ) {
248
249         if ( $part_export_machine{$machine}->disabled eq 'Y' ) {
250           $part_export_machine{$machine}->disabled('');
251           $error = $part_export_machine{$machine}->replace;
252           if ( $error ) {
253             $dbh->rollback if $oldAutoCommit;
254             return $error;
255           }
256         }
257
258         if ( $self->default_machine_name eq $machine ) {
259           $self->default_machine( $part_export_machine{$machine}->machinenum );
260         }
261
262         delete $part_export_machine{$machine}; #so we don't disable it below
263
264       } else {
265
266         my $part_export_machine = new FS::part_export_machine {
267                                         'exportnum' => $self->exportnum,
268                                         'machine'   => $machine
269                                       };
270         $error = $part_export_machine->insert;
271         if ( $error ) {
272           $dbh->rollback if $oldAutoCommit;
273           return $error;
274         }
275   
276         if ( $self->default_machine_name eq $machine ) {
277           $self->default_machine( $part_export_machine->machinenum );
278         }
279       }
280
281     }
282
283     foreach my $part_export_machine ( values %part_export_machine ) {
284       $part_export_machine->disabled('Y');
285       $error = $part_export_machine->replace;
286       if ( $error ) {
287         $dbh->rollback if $oldAutoCommit;
288         return $error;
289       }
290     }
291
292     if ( $old->machine ne '_SVC_MACHINE' ) {
293       # then set up the default for any already-attached export_svcs
294       foreach my $export_svc ( $self->export_svc ) {
295         my @svcs = qsearch('cust_svc', { 'svcpart' => $export_svc->svcpart });
296         foreach my $cust_svc ( @svcs ) {
297           my $svc_export_machine = FS::svc_export_machine->new({
298               'exportnum'   => $self->exportnum,
299               'svcnum'      => $cust_svc->svcnum,
300               'machinenum'  => $self->default_machine,
301           });
302           $error ||= $svc_export_machine->insert;
303         }
304       }
305       if ( $error ) {
306         $dbh->rollback if $oldAutoCommit;
307         return $error;
308       }
309     } # if switching to selectable hosts
310
311   } elsif ( $old->machine eq '_SVC_MACHINE' ) {
312     # then we're switching from selectable to non-selectable
313     foreach my $svc_export_machine (
314       qsearch('svc_export_machine', { 'exportnum' => $self->exportnum })
315     ) {
316       $error ||= $svc_export_machine->delete;
317     }
318     if ( $error ) {
319       $dbh->rollback if $oldAutoCommit;
320       return $error;
321     }
322
323   }
324
325   $error = $self->SUPER::replace(@_);
326   if ( $error ) {
327     $dbh->rollback if $oldAutoCommit;
328     return $error;
329   }
330
331   if ( $self->machine eq '_SVC_MACHINE' and ! $self->default_machine ) {
332     $dbh->rollback if $oldAutoCommit;
333     return "no default export host selected";
334   }
335
336   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
337   '';
338 }
339
340 =item check
341
342 Checks all fields to make sure this is a valid export.  If there is
343 an error, returns the error, otherwise returns false.  Called by the insert
344 and replace methods.
345
346 =cut
347
348 sub check {
349   my $self = shift;
350   my $error = 
351     $self->ut_numbern('exportnum')
352     || $self->ut_textn('exportname')
353     || $self->ut_domainn('machine')
354     || $self->ut_alpha('exporttype')
355     || $self->ut_flag('no_suspend')
356   ;
357
358   if ( $self->machine eq '_SVC_MACHINE' ) {
359     $error ||= $self->ut_numbern('default_machine')
360   } else {
361     $self->set('default_machine', '');
362   }
363
364   return $error if $error;
365
366   $self->nodomain =~ /^(Y?)$/ or return "Illegal nodomain: ". $self->nodomain;
367   $self->nodomain($1);
368
369   $self->deprecated(1); #BLAH
370
371   #check exporttype?
372
373   $self->SUPER::check;
374 }
375
376 =item label
377
378 Returns a label for this export, "exportname||exportype (machine)".  
379
380 =cut
381
382 sub label {
383   my $self = shift;
384   ($self->exportname || $self->exporttype ). ' ('. $self->machine. ')';
385 }
386
387 =item label_html
388
389 Returns a label for this export, "exportname: exporttype to machine".
390
391 =cut
392
393 sub label_html {
394   my $self = shift;
395
396   my $label = $self->exportname
397                 ? '<B>'. $self->exportname. '</B>: ' #<BR>'.
398                 : '';
399
400   $label .= $self->exporttype;
401
402   $label .= ' to '. ( $self->machine eq '_SVC_MACHINE'
403                         ? 'per-service hostname'
404                         : $self->machine
405                     )
406     if $self->machine;
407
408   $label;
409
410 }
411
412 #=item part_svc
413 #
414 #Returns the service definition (see L<FS::part_svc>) for this export.
415 #
416 #=cut
417 #
418 #sub part_svc {
419 #  my $self = shift;
420 #  qsearchs('part_svc', { svcpart => $self->svcpart } );
421 #}
422
423 sub part_svc {
424   use Carp;
425   croak "FS::part_export::part_svc deprecated";
426   #confess "FS::part_export::part_svc deprecated";
427 }
428
429 =item svc_x
430
431 Returns a list of associated FS::svc_* records.
432
433 =cut
434
435 sub svc_x {
436   my $self = shift;
437   map { $_->svc_x } $self->cust_svc;
438 }
439
440 =item cust_svc
441
442 Returns a list of associated FS::cust_svc records.
443
444 =cut
445
446 sub cust_svc {
447   my $self = shift;
448   map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
449     grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
450       $self->export_svc;
451 }
452
453 =item part_export_machine
454
455 Returns all machines as FS::part_export_machine objects (see
456 L<FS::part_export_machine>).
457
458 =cut
459
460 sub part_export_machine {
461   my $self = shift;
462   map { $_ } #behavior of sort undefined in scalar context
463     sort { $a->machine cmp $b->machine }
464       qsearch('part_export_machine', { 'exportnum' => $self->exportnum } );
465 }
466
467 =item export_svc
468
469 Returns a list of associated FS::export_svc records.
470
471 =cut
472
473 sub export_svc {
474   my $self = shift;
475   qsearch('export_svc', { 'exportnum' => $self->exportnum } );
476 }
477
478 =item export_device
479
480 Returns a list of associated FS::export_device records.
481
482 =cut
483
484 sub export_device {
485   my $self = shift;
486   qsearch('export_device', { 'exportnum' => $self->exportnum } );
487 }
488
489 =item part_export_option
490
491 Returns all options as FS::part_export_option objects (see
492 L<FS::part_export_option>).
493
494 =cut
495
496 sub part_export_option {
497   my $self = shift;
498   $self->option_objects;
499 }
500
501 =item options 
502
503 Returns a list of option names and values suitable for assigning to a hash.
504
505 =item option OPTIONNAME
506
507 Returns the option value for the given name, or the empty string.
508
509 =item _rebless
510
511 Reblesses the object into the FS::part_export::EXPORTTYPE class, where
512 EXPORTTYPE is the object's I<exporttype> field.  There should be better docs
513 on how to create new exports, but until then, see L</NEW EXPORT CLASSES>.
514
515 =cut
516
517 sub _rebless {
518   my $self = shift;
519   my $exporttype = $self->exporttype;
520   my $class = ref($self). "::$exporttype";
521   eval "use $class;";
522   #die $@ if $@;
523   bless($self, $class) unless $@;
524   $self;
525 }
526
527 =item svc_machine SVC_X
528
529 Return the export hostname for SVC_X.
530
531 =cut
532
533 sub svc_machine {
534   my( $self, $svc_x ) = @_;
535
536   return $self->machine unless $self->machine eq '_SVC_MACHINE';
537
538   my $svc_export_machine = qsearchs('svc_export_machine', {
539     'svcnum'    => $svc_x->svcnum,
540     'exportnum' => $self->exportnum,
541   });
542
543   if (!$svc_export_machine) {
544     warn "No hostname selected for ".($self->exportname || $self->exporttype);
545     return $self->default_export_machine->machine;
546   }
547
548   return $svc_export_machine->part_export_machine->machine;
549 }
550
551 =item default_export_machine
552
553 Return the default export hostname for this export.
554
555 =cut
556
557 sub default_export_machine {
558   my $self = shift;
559   my $machinenum = $self->default_machine;
560   if ( $machinenum ) {
561     my $default_machine = FS::part_export_machine->by_key($machinenum);
562     return $default_machine->machine if $default_machine;
563   }
564   # this should not happen
565   die "no default export hostname for export ".$self->exportnum;
566 }
567
568 #these should probably all go away, just let the subclasses define em
569
570 =item export_insert SVC_OBJECT
571
572 =cut
573
574 sub export_insert {
575   my $self = shift;
576   #$self->rebless;
577   $self->_export_insert(@_);
578 }
579
580 #sub AUTOLOAD {
581 #  my $self = shift;
582 #  $self->rebless;
583 #  my $method = $AUTOLOAD;
584 #  #$method =~ s/::(\w+)$/::_$1/; #infinite loop prevention
585 #  $method =~ s/::(\w+)$/_$1/; #infinite loop prevention
586 #  $self->$method(@_);
587 #}
588
589 =item export_replace NEW OLD
590
591 =cut
592
593 sub export_replace {
594   my $self = shift;
595   #$self->rebless;
596   $self->_export_replace(@_);
597 }
598
599 =item export_delete
600
601 =cut
602
603 sub export_delete {
604   my $self = shift;
605   #$self->rebless;
606   $self->_export_delete(@_);
607 }
608
609 =item export_suspend
610
611 =cut
612
613 sub export_suspend {
614   my $self = shift;
615   #$self->rebless;
616   $self->_export_suspend(@_);
617 }
618
619 =item export_unsuspend
620
621 =cut
622
623 sub export_unsuspend {
624   my $self = shift;
625   #$self->rebless;
626   $self->_export_unsuspend(@_);
627 }
628
629 #fallbacks providing useful error messages intead of infinite loops
630 sub _export_insert {
631   my $self = shift;
632   return "_export_insert: unknown export type ". $self->exporttype;
633 }
634
635 sub _export_replace {
636   my $self = shift;
637   return "_export_replace: unknown export type ". $self->exporttype;
638 }
639
640 sub _export_delete {
641   my $self = shift;
642   return "_export_delete: unknown export type ". $self->exporttype;
643 }
644
645 #call svcdb-specific fallbacks
646
647 sub _export_suspend {
648   my $self = shift;
649   #warn "warning: _export_suspened unimplemented for". ref($self);
650   my $svc_x = shift;
651   my $new = $svc_x->clone_suspended;
652   $self->_export_replace( $new, $svc_x );
653 }
654
655 sub _export_unsuspend {
656   my $self = shift;
657   #warn "warning: _export_unsuspend unimplemented for ". ref($self);
658   my $svc_x = shift;
659   my $old = $svc_x->clone_kludge_unsuspend;
660   $self->_export_replace( $svc_x, $old );
661 }
662
663 =item get_remoteid SVC
664
665 Returns the remote id for this export for the given service.
666
667 =cut
668
669 sub get_remoteid {
670   my ($self, $svc_x) = @_;
671
672   my $export_cust_svc = qsearchs('export_cust_svc',{
673     'exportnum' => $self->exportnum,
674     'svcnum' => $svc_x->svcnum
675   });
676
677   return $export_cust_svc ? $export_cust_svc->remoteid : '';
678 }
679
680 =item set_remoteid SVC VALUE
681
682 Sets the remote id for this export for the given service.
683 See L<FS::export_cust_svc>.
684
685 If value is true, inserts or updates export_cust_svc record.
686 If value is false, deletes any existing record.
687
688 Returns error message, blank on success.
689
690 =cut
691
692 sub set_remoteid {
693   my ($self, $svc_x, $value) = @_;
694
695   my $export_cust_svc = qsearchs('export_cust_svc',{
696     'exportnum' => $self->exportnum,
697     'svcnum' => $svc_x->svcnum
698   });
699
700   local $SIG{HUP} = 'IGNORE';
701   local $SIG{INT} = 'IGNORE';
702   local $SIG{QUIT} = 'IGNORE';
703   local $SIG{TERM} = 'IGNORE';
704   local $SIG{TSTP} = 'IGNORE';
705   local $SIG{PIPE} = 'IGNORE';
706
707   my $oldAutoCommit = $FS::UID::AutoCommit;
708   local $FS::UID::AutoCommit = 0;
709   my $dbh = dbh;
710
711   my $error = '';
712   if ($value) {
713     if ($export_cust_svc) {
714       $export_cust_svc->set('remoteid',$value);
715       $error = $export_cust_svc->replace;
716     } else {
717       $export_cust_svc = new FS::export_cust_svc {
718         'exportnum' => $self->exportnum,
719         'svcnum' => $svc_x->svcnum,
720         'remoteid' => $value
721       };
722       $error = $export_cust_svc->insert;
723     }
724   } else {
725     if ($export_cust_svc) {
726       $error = $export_cust_svc->delete;
727     } #otherwise, it already doesn't exist
728   }
729
730   if ($oldAutoCommit) {
731     $dbh->rollback if $error;
732     $dbh->commit unless $error;
733   }
734
735   return $error;  
736 }
737
738 =item export_links SVC_OBJECT ARRAYREF
739
740 Adds a list of web elements to ARRAYREF specific to this export and SVC_OBJECT.
741 The elements are displayed in the UI to lead the the operator to external
742 configuration, monitoring, and similar tools.
743
744 =item export_getsettings SVC_OBJECT SETTINGS_HASHREF DEFAUTS_HASHREF
745
746 Adds a hashref of settings to SETTINGSREF specific to this export and
747 SVC_OBJECT.  The elements can be displayed in the UI on the service view.
748
749 DEFAULTSREF is a hashref with the same keys where true values indicate the
750 setting is a default (and thus can be displayed in the UI with less emphasis,
751 or hidden by default).
752
753 =item actions
754
755 Adds one or more "action" links to the export's display in 
756 browse/part_export.cgi.  Should return pairs of values.  The first is 
757 the link label; the second is the Mason path to a document to load.
758 The document will show in a popup.
759
760 =cut
761
762 sub actions { }
763
764 =cut
765
766 =item weight
767
768 Returns the 'weight' element from the export's %info hash, or 0 if there is 
769 no weight defined.
770
771 =cut
772
773 sub weight {
774   my $self = shift;
775   export_info()->{$self->exporttype}->{'weight'} || 0;
776 }
777
778 =item info
779
780 Returns a reference to (a copy of) the export's %info hash.
781
782 =cut
783
784 sub info {
785   my $self = shift;
786   $self->{_info} ||= { 
787     %{ export_info()->{$self->exporttype} }
788   };
789 }
790
791 =item get_dids SELECTION
792
793 Does several things, which is unfortunate. DID phone numbers are organized
794 in a sort-of hierarchy: state, areacode, exchange, number. Or, for some 
795 vendors: state, region, number. But not always that, either.
796
797 SELECTION is one or more field/value pairs specifying parts of the hierarchy
798 that have already been selected.  C<get_dids> will then return an arrayref of
799 the possible values for the next selection level. Note that these are not
800 actual DIDs except at the lowest level.
801
802 Generally, 'state' alone will return an array of area codes or region names
803 in the state.
804
805 'state' and 'areacode' together will return an array of either:
806 - exchange strings of the form "New York (212-555-XXXX)"
807 - ratecenter names of the form "New York, NY"
808
809 These strings are sent back to the UI and offered as options so that the user
810 can choose the local calling area they like.
811
812 'areacode' and 'exchange', or 'state' and 'ratecenter', or 'region' by itself
813 will return an array of actual DID numbers.
814
815 Passing 'tollfree' with a true value will override the whole hierarchy and
816 return an array of tollfree numbers.
817
818 C<get_dids> methods should report errors via die().
819
820 =cut
821
822 # no stub; can('get_dids') should return false by default
823
824 #default fallbacks... FS::part_export::DID_Common ?
825 sub get_dids_can_tollfree { 0; }
826 sub get_dids_can_manual   { 0; }
827 sub get_dids_can_edit     { 0; } #don't use without can_manual, otherwise the
828                                  # DID selector provisions a new number from
829                                  # inventory each edit
830 sub get_dids_npa_select   { 1; }
831
832 # get_dids_npa_select: if true, then prompt to select state, then area code,
833 # then city/exchange, then phone number.
834 # if false, then prompt to select state (actually province), then "region",
835 # then phone number.
836 #
837 # get_dids_can_manual: if true, then there will be a radio button to enter
838 # a phone number manually.
839 #
840 # get_dids_can_tollfree: if true, then the user will be prompted to choose
841 # both a regular and a toll-free number. The export can have a 
842 # 'restrict_selection' option to enable only one or the other of those. See
843 # part_export/vitelity.pm for an example.
844 #
845 # get_dids_can_edit: if true, then the user can use the selector again to
846 # change the phone number for a service. if false, then they can't (have to
847 # reprovision completely).
848
849 =item svc_role SVC
850
851 Returns the role that SVC occupies with respect to this export, if any.
852 This is part of the part_svc's export configuration.
853
854 =cut
855
856 sub svc_role {
857   my $self = shift;
858   my $svc_x = shift;
859   my $cust_svc = $svc_x->cust_svc or return '';
860   my $export_svc = qsearchs('export_svc', { exportnum => $self->exportnum,
861                                             svcpart   => $cust_svc->svcpart })
862                    or return '';
863   $export_svc->role;
864
865
866 =item svc_with_role { SVC | PKGNUM }, ROLE
867
868 Given a svc_* object SVC or pkgnum PKG, and a role name ROLE, finds the
869 service(s) in the same package that are linked to this export with ROLE.
870
871 =cut
872
873 sub svc_with_role {
874   my $self = shift;
875   my $svc_or_pkgnum = shift;
876   my $role = shift; 
877   my $pkgnum;
878   if ( ref $svc_or_pkgnum ) {
879     $pkgnum = $svc_or_pkgnum->cust_svc->pkgnum or return '';
880   } else {
881     $pkgnum = $svc_or_pkgnum;
882   }
883   my $role_info = $self->info->{roles}->{$role}
884     or die "role '$role' does not exist for export '".$self->exporttype."'\n";
885   my $svcdb = $role_info->{svcdb};
886
887   my @svcs = qsearch({
888     'table'     =>  $svcdb,
889     'addl_from' =>  ' JOIN cust_svc USING (svcnum)' .
890                     ' JOIN export_svc USING (svcpart)',
891     'extra_sql' =>  " WHERE cust_svc.pkgnum = $pkgnum" .
892                     " AND export_svc.exportnum = ".$self->exportnum .
893                     " AND export_svc.role = '$role'",
894   });               
895   if ( $role_info->{multiple} ) {
896     return @svcs;
897   } else {
898     if ( @svcs > 1 ) {
899       warn "multiple $role services in pkgnum $pkgnum; returning the first one.\n";
900     }
901     return $svcs[0];
902   }
903 }
904
905 =back
906
907 =head1 SUBROUTINES
908
909 =over 4
910
911 =item export_info [ SVCDB ]
912
913 Returns a hash reference of the exports for the given I<svcdb>, or if no
914 I<svcdb> is specified, for all exports.  The keys of the hash are
915 I<exporttype>s and the values are again hash references containing information
916 on the export:
917
918   'desc'     => 'Description',
919   'options'  => {
920                   'option'  => { label=>'Option Label' },
921                   'option2' => { label=>'Another label' },
922                 },
923   'nodomain' => 'Y', #or ''
924   'notes'    => 'Additional notes',
925
926 =cut
927
928 sub export_info {
929   #warn $_[0];
930   return $exports{$_[0]} || {} if @_;
931   #{ map { %{$exports{$_}} } keys %exports };
932   my $r = { map { %{$exports{$_}} } keys %exports };
933 }
934
935
936 sub _upgrade_data {  #class method
937   my ($class, %opts) = @_;
938
939   my @part_export_option = qsearch('part_export_option', { 'optionname' => 'overlimit_groups' });
940   foreach my $opt ( @part_export_option ) {
941     next if $opt->optionvalue =~ /^[\d\s]+$/ || !$opt->optionvalue;
942     my @groupnames = split(' ',$opt->optionvalue);
943     my @groupnums;
944     my $error = '';
945     foreach my $groupname ( @groupnames ) {
946         my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
947         unless ( $g ) {
948             $g = new FS::radius_group {
949                             'groupname' => $groupname,
950                             'description' => $groupname,
951                             };
952             $error = $g->insert;
953             die $error if $error;
954         }
955         push @groupnums, $g->groupnum;
956     }
957     $opt->optionvalue(join(' ',@groupnums));
958     $error = $opt->replace;
959     die $error if $error;
960   }
961   # for exports that have selectable hostnames, make sure all services
962   # have a hostname selected
963   foreach my $part_export (
964     qsearch('part_export', { 'machine' => '_SVC_MACHINE' })
965   ) {
966
967     my $exportnum = $part_export->exportnum;
968     my $machinenum = $part_export->default_machine;
969     if (!$machinenum) {
970       my ($first) = $part_export->part_export_machine;
971       if (!$first) {
972         # user intervention really is required.
973         die "Export $exportnum has no hostname options defined.\n".
974             "You must correct this before upgrading.\n";
975       }
976       # warn about this, because we might not choose the right one
977       warn "Export $exportnum (". $part_export->exporttype.
978            ") has no default hostname.  Setting to ".$first->machine."\n";
979       $machinenum = $first->machinenum;
980       $part_export->set('default_machine', $machinenum);
981       my $error = $part_export->replace;
982       die $error if $error;
983     }
984
985     # the service belongs to a service def that uses this export
986     # and there is not a hostname selected for this export for that service
987     my $join = ' JOIN export_svc USING ( svcpart )'.
988                ' LEFT JOIN svc_export_machine'.
989                ' ON ( cust_svc.svcnum = svc_export_machine.svcnum'.
990                ' AND export_svc.exportnum = svc_export_machine.exportnum )';
991
992     my @svcs = qsearch( {
993           'select'    => 'cust_svc.*',
994           'table'     => 'cust_svc',
995           'addl_from' => $join,
996           'extra_sql' => ' WHERE svcexportmachinenum IS NULL'.
997                          ' AND export_svc.exportnum = '.$part_export->exportnum,
998       } );
999     foreach my $cust_svc (@svcs) {
1000       my $svc_export_machine = FS::svc_export_machine->new({
1001           'exportnum'   => $exportnum,
1002           'machinenum'  => $machinenum,
1003           'svcnum'      => $cust_svc->svcnum,
1004       });
1005       my $error = $svc_export_machine->insert;
1006       die $error if $error;
1007     }
1008   }
1009
1010   # pass downstream
1011   my %exports_in_use;
1012   $exports_in_use{ref $_} = 1 foreach qsearch('part_export', {});
1013   foreach (keys(%exports_in_use)) {
1014     $_->_upgrade_exporttype(%opts) if $_->can('_upgrade_exporttype');
1015   }
1016 }
1017
1018 #=item exporttype2svcdb EXPORTTYPE
1019 #
1020 #Returns the applicable I<svcdb> for an I<exporttype>.
1021 #
1022 #=cut
1023 #
1024 #sub exporttype2svcdb {
1025 #  my $exporttype = $_[0];
1026 #  foreach my $svcdb ( keys %exports ) {
1027 #    return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}};
1028 #  }
1029 #  '';
1030 #}
1031
1032 #false laziness w/part_pkg & cdr
1033 foreach my $INC ( @INC ) {
1034   foreach my $file ( glob("$INC/FS/part_export/*.pm") ) {
1035     warn "attempting to load export info from $file\n" if $DEBUG;
1036     $file =~ /\/(\w+)\.pm$/ or do {
1037       warn "unrecognized file in $INC/FS/part_export/: $file\n";
1038       next;
1039     };
1040     my $mod = $1;
1041     my $info = eval "use FS::part_export::$mod; ".
1042                     "\\%FS::part_export::$mod\::info;";
1043     if ( $@ ) {
1044       die "error using FS::part_export::$mod (skipping): $@\n" if $@;
1045       next;
1046     }
1047     unless ( keys %$info ) {
1048       warn "no %info hash found in FS::part_export::$mod, skipping\n"
1049         unless $mod =~ /^(passwdfile|null|.+_Common)$/; #hack but what the heck
1050       next;
1051     }
1052     warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG;
1053     no strict 'refs';
1054     foreach my $svc (
1055       ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'}
1056     ) {
1057       unless ( $svc ) {
1058         warn "blank svc for FS::part_export::$mod (skipping)\n";
1059         next;
1060       }
1061       $exports{$svc}->{$mod} = $info;
1062     }
1063   }
1064 }
1065
1066 =back
1067
1068 =head1 NEW EXPORT CLASSES
1069
1070 A module should be added in FS/FS/part_export/ (an example may be found in
1071 eg/export_template.pm)
1072
1073 =head1 BUGS
1074
1075 Hmm... cust_export class (not necessarily a database table...) ... ?
1076
1077 deprecated column...
1078
1079 =head1 SEE ALSO
1080
1081 L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_acct>,
1082 L<FS::svc_domain>,
1083 L<FS::svc_forward>, L<FS::Record>, schema.html from the base documentation.
1084
1085 =cut
1086
1087 1;
1088