+=item expire DATE
+
+Currently this will only run expire exports if any are attached
+
+=cut
+
+sub expire {
+ my($self,$date) = (shift,shift);
+
+ return 'Expire date must be specified' unless $date;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $export_args = [$date];
+ my $error = $self->export('expire', @$export_args);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ '';
+}
+
+=item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ]
+
+Replaces OLD_RECORD with this one. If there is an error, returns the error,
+otherwise returns false.
+
+Currently available options are: I<child_objects>, I<export_args> and
+I<depend_jobnum>.
+
+If I<child_objects> is set to an array reference of FS::tablename objects
+(for example, FS::svc_export_machine or FS::acct_snarf objects), they
+will have their svcnum field set and will be inserted or replaced after
+this record, but before any exports are run. Each element of the array
+can also optionally be a two-element array reference containing the
+child object and the name of an alternate field to be filled in with
+the newly-inserted svcnum, for example C<[ $svc_forward, 'srcsvc' ]>
+
+If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
+jobnums), all provisioning jobs will have a dependancy on the supplied
+jobnum(s) (they will not run until the specific job(s) complete(s)).
+
+If I<export_args> is set to an array reference, the referenced list will be
+passed to export commands.
+
+=cut
+
+sub replace {
+ my $new = shift;
+
+ my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
+ ? shift
+ : $new->replace_old;
+
+ my $options =
+ ( ref($_[0]) eq 'HASH' )
+ ? shift
+ : { @_ };
+
+ my $objects = $options->{'child_objects'} || [];
+
+ my @jobnums = ();
+ local $FS::queue::jobnums = \@jobnums;
+ warn "[$me] replace: set \$FS::queue::jobnums to $FS::queue::jobnums\n"
+ if $DEBUG;
+ my $depend_jobnums = $options->{'depend_jobnum'} || [];
+ $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums);
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error = $new->set_auto_inventory($old);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ #redundant, but so any duplicate fields are maniuplated as appropriate
+ # (svc_phone.phonenum)
+ $error = $new->check;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ #if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
+ if ( grep { $old->$_ ne $new->$_ } $new->table_dupcheck_fields ) {
+
+ $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
+ $error = $new->_check_duplicate;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ $error = $new->SUPER::replace($old);
+ if ($error) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ foreach my $object ( @$objects ) {
+ my($field, $obj);
+ if ( ref($object) eq 'ARRAY' ) {
+ ($obj, $field) = @$object;
+ } else {
+ $obj = $object;
+ $field = 'svcnum';
+ }
+ $obj->$field($new->svcnum);
+
+ my $oldobj = qsearchs( $obj->table, {
+ $field => $new->svcnum,
+ map { $_ => $obj->$_ } $obj->_svc_child_partfields,
+ });
+
+ if ( $oldobj ) {
+ my $pkey = $oldobj->primary_key;
+ $obj->$pkey($oldobj->$pkey);
+ $obj->replace($oldobj);
+ } else {
+ $error = $obj->insert;
+ }
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ #new-style exports!
+ unless ( $noexport_hack ) {
+
+ warn "[$me] replace: \$FS::queue::jobnums is $FS::queue::jobnums\n"
+ if $DEBUG;
+
+ my $export_args = $options->{'export_args'} || [];
+
+ #not quite false laziness, but same pattern as FS::svc_acct::replace and
+ #FS::part_export::sqlradius::_export_replace. List::Compare or something
+ #would be useful but too much of a pain in the ass to deploy
+
+ my @old_part_export = $old->cust_svc->part_svc->part_export;
+ my %old_exportnum = map { $_->exportnum => 1 } @old_part_export;
+ my @new_part_export =
+ $new->svcpart
+ ? qsearchs('part_svc', { svcpart=>$new->svcpart } )->part_export
+ : $new->cust_svc->part_svc->part_export;
+ my %new_exportnum = map { $_->exportnum => 1 } @new_part_export;
+
+ foreach my $delete_part_export (
+ grep { ! $new_exportnum{$_->exportnum} } @old_part_export
+ ) {
+ my $error = $delete_part_export->export_delete($old, @$export_args);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error deleting, export to ". $delete_part_export->exporttype.
+ " (transaction rolled back): $error";
+ }
+ }
+
+ foreach my $replace_part_export (
+ grep { $old_exportnum{$_->exportnum} } @new_part_export
+ ) {
+ my $error =
+ $replace_part_export->export_replace( $new, $old, @$export_args);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error exporting to ". $replace_part_export->exporttype.
+ " (transaction rolled back): $error";
+ }
+ }
+
+ foreach my $insert_part_export (
+ grep { ! $old_exportnum{$_->exportnum} } @new_part_export
+ ) {
+ my $error = $insert_part_export->export_insert($new, @$export_args );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error inserting export to ". $insert_part_export->exporttype.
+ " (transaction rolled back): $error";
+ }
+ }
+
+ foreach my $depend_jobnum ( @$depend_jobnums ) {
+ warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
+ if $DEBUG;
+ foreach my $jobnum ( @jobnums ) {
+ my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
+ warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
+ if $DEBUG;
+ my $error = $queue->depend_insert($depend_jobnum);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error queuing job dependancy: $error";
+ }
+ }
+ }
+
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+}
+
projects / freeside.git / blobdiff