FS/FS/export_svc.pm

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