FS/FS/export_svc.pm

   1 package FS::export_svc;
   2
   3 use strict;
   4 use vars qw( @ISA );
   5 use FS::Record qw( qsearch qsearchs dbh );
   6 use FS::part_export;
   7 use FS::part_svc;
   8 use FS::svc_export_machine;
   9
  10 @ISA = qw(FS::Record);
  11
  12 =head1 NAME
  13
  14 FS::export_svc - Object methods for export_svc records
  15
  16 =head1 SYNOPSIS
  17
  18   use FS::export_svc;
  19
  20   $record = new FS::export_svc \%hash;
  21   $record = new FS::export_svc { 'column' => 'value' };
  22
  23   $error = $record->insert;
  24
  25   $error = $new_record->replace($old_record);
  26
  27   $error = $record->delete;
  28
  29   $error = $record->check;
  30
  31 =head1 DESCRIPTION
  32
  33 An FS::export_svc object links a service definition (see L<FS::part_svc>) to
  34 an export (see L<FS::part_export>).  FS::export_svc inherits from FS::Record.
  35 The following fields are currently supported:
  36
  37 =over 4
  38
  39 =item exportsvcnum - primary key
  40
  41 =item exportnum - export (see L<FS::part_export>)
  42
  43 =item svcpart - service definition (see L<FS::part_svc>)
  44
  45 =item role - export role (see export parameters)
  46
  47 =back
  48
  49 =head1 METHODS
  50
  51 =over 4
  52
  53 =item new HASHREF
  54
  55 Creates a new record.  To add the record to the database, see L<"insert">.
  56
  57 Note that this stores the hash reference, not a distinct copy of the hash it
  58 points to.  You can ask the object for a copy with the I<hash> method.
  59
  60 =cut
  61
  62 # the new method can be inherited from FS::Record, if a table method is defined
  63
  64 sub table { 'export_svc'; }
  65
  66 =item insert [ JOB, OFFSET, MULTIPLIER ]
  67
  68 Adds this record to the database.  If there is an error, returns the error,
  69 otherwise returns false.
  70
  71 TODOC: JOB, OFFSET, MULTIPLIER
  72
  73 =cut
  74
  75 sub insert {
  76   my $self = shift;
  77   my( $job, $offset, $mult ) = ( '', 0, 100);
  78   $job = shift if @_;
  79   $offset = shift if @_;
  80   $mult = shift if @_;
  81
  82   local $SIG{HUP} = 'IGNORE';
  83   local $SIG{INT} = 'IGNORE';
  84   local $SIG{QUIT} = 'IGNORE';
  85   local $SIG{TERM} = 'IGNORE';
  86   local $SIG{TSTP} = 'IGNORE';
  87   local $SIG{PIPE} = 'IGNORE';
  88
  89   my $oldAutoCommit = $FS::UID::AutoCommit;
  90   local $FS::UID::AutoCommit = 0;
  91   my $dbh = dbh;
  92
  93   my $error = $self->check;
  94   return $error if $error;
  95
  96   #check for duplicates!
  97   my @checks = ();
  98   my $svcdb = $self->part_svc->svcdb;
  99   if ( $svcdb eq 'svc_acct' ) {
 100
 101     if ( $self->part_export->nodomain =~ /^Y/i ) {
 102       push @checks, {
 103         label  => 'usernames',
 104         method => 'username',
 105         sortby => sub { $a cmp $b },
 106       };
 107     } else {
 108       push @checks, {
 109         label  => 'username@domain',
 110         method => 'email',
 111         sortby => sub {
 112                         my($auser, $adomain) = split('@', $a);
 113                         my($buser, $bdomain) = split('@', $b);
 114                         $adomain cmp $bdomain || $auser cmp $buser;
 115                       },
 116       };
 117     }
 118
 119     unless ( $self->part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
 120       push @checks, {
 121         label  => 'uids',
 122         method => 'uid',
 123         sortby => sub { $a <=> $b },
 124       };
 125     }
 126
 127   } elsif ( $svcdb eq 'svc_domain' ) {
 128     push @checks, {
 129       label  => 'domains',
 130       method => 'domain',
 131       sortby => sub { $a cmp $b },
 132     };
 133   } else {
 134     warn "WARNING: No duplicate checking done on merge of $svcdb exports";
 135   }
 136
 137   if ( @checks ) {
 138
 139     my $done = 0;
 140     my $percheck = $mult / scalar(@checks);
 141
 142     foreach my $check ( @checks ) {
 143
 144       if ( $job ) {
 145         $error = $job->update_statustext(int( $offset + ($done+.33) *$percheck ));
 146         if ( $error ) {
 147           $dbh->rollback if $oldAutoCommit;
 148           return $error;
 149         }
 150       }
 151
 152       my @current_svc = $self->part_export->svc_x;
 153       #warn "current: ". scalar(@current_svc). " $current_svc[0]\n";
 154
 155       if ( $job ) {
 156         $error = $job->update_statustext(int( $offset + ($done+.67) *$percheck ));
 157         if ( $error ) {
 158           $dbh->rollback if $oldAutoCommit;
 159           return $error;
 160         }
 161       }
 162
 163       my @new_svc = $self->part_svc->svc_x;
 164       #warn "new: ". scalar(@new_svc). " $new_svc[0]\n";
 165
 166       if ( $job ) {
 167         $error = $job->update_statustext(int( $offset + ($done+1) *$percheck ));
 168         if ( $error ) {
 169           $dbh->rollback if $oldAutoCommit;
 170           return $error;
 171         }
 172       }
 173
 174       my $method = $check->{'method'};
 175       my %cur_svc = map { $_->$method() => $_ } @current_svc;
 176       my @dup_svc = grep { $cur_svc{$_->$method()} } @new_svc;
 177       #my @diff_customer = grep {
 178       #                           $_->cust_pkg->custnum != $cur_svc{$_->$method()}->cust_pkg->custnum
 179       #                         } @dup_svc;
 180
 181
 182
 183       if ( @dup_svc ) { #aye, that's the rub
 184         #error out for now, eventually accept different options of adjustments
 185         # to make to allow us to continue forward
 186         $dbh->rollback if $oldAutoCommit;
 187
 188         my @diff_customer_svc = grep {
 189           my $cust_pkg = $_->cust_svc->cust_pkg;
 190           my $custnum = $cust_pkg ? $cust_pkg->custnum : 0;
 191           my $other_cust_pkg = $cur_svc{$_->$method()}->cust_svc->cust_pkg;
 192           my $other_custnum = $other_cust_pkg ? $other_cust_pkg->custnum : 0;
 193           $custnum != $other_custnum;
 194         } @dup_svc;
 195
 196         my $label = $check->{'label'};
 197         my $sortby = $check->{'sortby'};
 198         return "Can't export ".
 199                $self->part_svc->svcpart.':'.$self->part_svc->svc. " service to ".
 200                $self->part_export->exportnum.':'.$self->part_export->exporttype.
 201                  ' on '. $self->part_export->machine.
 202                ' : '. scalar(@dup_svc). " duplicate $label".
 203                ' ('. scalar(@diff_customer_svc). " from different customers)".
 204                ": ". join(', ', sort $sortby map { $_->$method() } @dup_svc )
 205                #": ". join(', ', sort $sortby map { $_->$method() } @diff_customer_svc )
 206                ;
 207       }
 208
 209       $done++;
 210     }
 211
 212   } #end of duplicate check, whew
 213
 214   $error = $self->SUPER::insert;
 215
 216   my $part_export = $self->part_export;
 217   if ( !$error and $part_export->default_machine ) {
 218     foreach my $cust_svc ( $self->part_svc->cust_svc ) {
 219       my $svc_export_machine = FS::svc_export_machine->new({
 220           'exportnum'   => $self->exportnum,
 221           'svcnum'      => $cust_svc->svcnum,
 222           'machinenum'  => $part_export->default_machine,
 223       });
 224       $error ||= $svc_export_machine->insert;
 225     }
 226   }
 227
 228   if ( $error ) {
 229     $dbh->rollback if $oldAutoCommit;
 230     return $error;
 231   }
 232
 233 #  if ( $self->part_svc->svcdb eq 'svc_acct' ) {
 234 #
 235 #    if ( $self->part_export->nodomain =~ /^Y/i ) {
 236 #
 237 #      select username from svc_acct where svcpart = $svcpart
 238 #        group by username having count(*) > 1;
 239 #
 240 #    } else {
 241 #
 242 #      select username, domain
 243 #        from   svc_acct
 244 #          join svc_domain on ( svc_acct.domsvc = svc_domain.svcnum )
 245 #        group by username, domain having count(*) > 1;
 246 #
 247 #    }
 248 #
 249 #  } elsif ( $self->part_svc->svcdb eq 'svc_domain' ) {
 250 #
 251 #    #similar but easier domain checking one
 252 #
 253 #  } #etc.?
 254 #
 255 #  my @services =
 256 #    map  { $_->part_svc }
 257 #    grep { $_->svcpart != $self->svcpart }
 258 #         $self->part_export->export_svc;
 259
 260   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 261   ''; #no error
 262 }
 263
 264 =item delete
 265
 266 Delete this record from the database.
 267
 268 =cut
 269
 270 sub delete {
 271   my $self = shift;
 272   my $dbh = dbh;
 273   my $oldAutoCommit = $FS::UID::AutoCommit;
 274   local $FS::UID::AutoCommit = 0;
 275
 276   my $error = $self->SUPER::delete;
 277   foreach ($self->svc_export_machine) {
 278     $error ||= $_->delete;
 279   }
 280   if ( $error ) {
 281     $dbh->rollback if $oldAutoCommit;
 282     return $error;
 283   }
 284   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 285 }
 286
 287
 288 =item replace OLD_RECORD
 289
 290 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 291 returns the error, otherwise returns false.
 292
 293 =cut
 294
 295 # the replace method can be inherited from FS::Record
 296
 297 =item check
 298
 299 Checks all fields to make sure this is a valid record.  If there is
 300 an error, returns the error, otherwise returns false.  Called by the insert
 301 and replace methods.
 302
 303 =cut
 304
 305 # the check method should currently be supplied - FS::Record contains some
 306 # data checking routines
 307
 308 sub check {
 309   my $self = shift;
 310
 311   $self->ut_numbern('exportsvcnum')
 312     || $self->ut_number('exportnum')
 313     || $self->ut_foreign_key('exportnum', 'part_export', 'exportnum')
 314     || $self->ut_number('svcpart')
 315     || $self->ut_foreign_key('svcpart', 'part_svc', 'svcpart')
 316     || $self->ut_alphan('role')
 317     || $self->SUPER::check
 318   ;
 319
 320   my $part_export = $self->part_export;
 321   if ( exists $part_export->info->{roles} ) {
 322     my $role = $self->get('role');
 323     if ( ! $role ) {
 324       return 'must select an export role'
 325     }
 326     if ( ! exists($part_export->info->{roles}->{$role}) ) {
 327       return "invalid role for export '".$part_export->exporttype."'";
 328     }
 329   } else {
 330     $self->set('role', '');
 331   }
 332
 333   '';
 334 }
 335
 336 =item part_export
 337
 338 Returns the FS::part_export object (see L<FS::part_export>).
 339
 340 =cut
 341
 342 sub part_export {
 343   my $self = shift;
 344   qsearchs( 'part_export', { 'exportnum' => $self->exportnum } );
 345 }
 346
 347 =item part_svc
 348
 349 Returns the FS::part_svc object (see L<FS::part_svc>).
 350
 351 =cut
 352
 353 sub part_svc {
 354   my $self = shift;
 355   qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 356 }
 357
 358 =item svc_export_machine
 359
 360 Returns all export hostname records (L<FS::svc_export_machine>) for this
 361 combination of svcpart and exportnum.
 362
 363 =cut
 364
 365 sub svc_export_machine {
 366   my $self = shift;
 367   qsearch({
 368     'table'     => 'svc_export_machine',
 369     'select'    => 'svc_export_machine.*',
 370     'addl_from' => 'JOIN cust_svc USING (svcnum)',
 371     'hashref'   => { 'exportnum' => $self->exportnum },
 372     'extra_sql' => ' AND cust_svc.svcpart = '.$self->svcpart,
 373   });
 374 }
 375
 376 =back
 377
 378 =head1 BUGS
 379
 380 =head1 SEE ALSO
 381
 382 L<FS::part_export>, L<FS::part_svc>, L<FS::Record>, schema.html from the base
 383 documentation.
 384
 385 =cut
 386
 387 1;
 388