diff options
author | ivan <ivan> | 2005-02-24 14:24:07 +0000 |
---|---|---|
committer | ivan <ivan> | 2005-02-24 14:24:07 +0000 |
commit | 4d599c8ce382f51d7bfbb4172cdc73a2c8bd400d (patch) | |
tree | 495cce273f64cd9f7e791014b8cf50bc973a4869 /FS/FS | |
parent | 41a036e2d95b39e28eecc624203024e27b3f539b (diff) |
add progressbar to service definition add - duplicate checking can take a while, closes: Bug#1126
Diffstat (limited to 'FS/FS')
-rw-r--r-- | FS/FS/UI/Web.pm | 22 | ||||
-rw-r--r-- | FS/FS/export_svc.pm | 42 | ||||
-rw-r--r-- | FS/FS/part_svc.pm | 122 | ||||
-rw-r--r-- | FS/FS/rate.pm | 4 | ||||
-rw-r--r-- | FS/FS/svc_acct.pm | 4 |
5 files changed, 172 insertions, 22 deletions
diff --git a/FS/FS/UI/Web.pm b/FS/FS/UI/Web.pm index 18c2dfe8c..46e904b00 100644 --- a/FS/FS/UI/Web.pm +++ b/FS/FS/UI/Web.pm @@ -36,9 +36,27 @@ sub new { sub start_job { my $self = shift; - my %param = @_; + warn "FS::UI::Web::start_job: ". join(', ', @_) if $DEBUG; +# my %param = @_; + my %param = (); + while ( @_ ) { + my( $field, $value ) = splice(@_, 0, 2); + unless ( exists( $param{$field} ) ) { + $param{$field} = $value; + } elsif ( ! ref($param{$field}) ) { + $param{$field} = [ $param{$field}, $value ]; + } else { + push @{$param{$field}}, $value; + } + } warn "FS::UI::Web::start_job\n". - join('', map " $_ => $param{$_}\n", keys %param ) + join('', map { + if ( ref($param{$_}) ) { + " $_ => [ ". join(', ', @{$param{$_}}). " ]\n"; + } else { + " $_ => $param{$_}\n"; + } + } keys %param ) if $DEBUG; #first get the CGI params shipped off to a job ASAP so an id can be returned diff --git a/FS/FS/export_svc.pm b/FS/FS/export_svc.pm index d1153c0fd..b196d6cf2 100644 --- a/FS/FS/export_svc.pm +++ b/FS/FS/export_svc.pm @@ -60,16 +60,21 @@ points to. You can ask the object for a copy with the I<hash> method. sub table { 'export_svc'; } -=item insert +=item insert [ JOB, OFFSET, MULTIPLIER ] Adds this record to the database. If there is an error, returns the error, otherwise returns false. +TODOC: JOB, OFFSET, MULTIPLIER + =cut sub insert { my $self = shift; - my $error; + my( $job, $offset, $mult ) = ( '', 0, 100); + $job = shift if @_; + $offset = shift if @_; + $mult = shift if @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -82,7 +87,7 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - $error = $self->check; + my $error = $self->check; return $error if $error; #check for duplicates! @@ -126,11 +131,40 @@ sub insert { warn "WARNING: No duplicate checking done on merge of $svcdb exports"; } + my $done = 0; + my $percheck = $mult / scalar(@checks); foreach my $check ( @checks ) { + + if ( $job ) { + $error = $job->update_statustext(int( $offset + ($done+.33) *$percheck )); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + my @current_svc = $self->part_export->svc_x; #warn "current: ". scalar(@current_svc). " $current_svc[0]\n"; + + if ( $job ) { + $error = $job->update_statustext(int( $offset + ($done+.67) *$percheck )); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + my @new_svc = $self->part_svc->svc_x; #warn "new: ". scalar(@new_svc). " $new_svc[0]\n"; + + if ( $job ) { + $error = $job->update_statustext(int( $offset + ($done+1) *$percheck )); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + my $method = $check->{'method'}; my %cur_svc = map { $_->$method() => $_ } @current_svc; my @dup_svc = grep { $cur_svc{$_->$method()} } @new_svc; @@ -165,6 +199,8 @@ sub insert { ": ". join(', ', sort $sortby map { $_->$method() } @diff_customer_svc ) ; } + + $done++; } #end of duplicate check, whew diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm index e7f205d10..e94c803b7 100644 --- a/FS/FS/part_svc.pm +++ b/FS/FS/part_svc.pm @@ -1,7 +1,7 @@ package FS::part_svc; use strict; -use vars qw( @ISA ); +use vars qw( @ISA $DEBUG ); use FS::Record qw( qsearch qsearchs fields dbh ); use FS::part_svc_column; use FS::part_export; @@ -10,6 +10,8 @@ use FS::cust_svc; @ISA = qw(FS::Record); +$DEBUG = 1; + =head1 NAME FS::part_svc - Object methods for part_svc objects @@ -64,7 +66,7 @@ database, see L<"insert">. sub table { 'part_svc'; } -=item insert [ EXTRA_FIELDS_ARRAYREF [ , EXPORTNUMS_HASHREF ] ] +=item insert [ EXTRA_FIELDS_ARRAYREF [ , EXPORTNUMS_HASHREF [ , JOB ] ] ] Adds this service definition to the database. If there is an error, returns the error, otherwise returns false. @@ -87,6 +89,8 @@ EXTRA_FIELDS_ARRAYREF also. If EXPORTNUMS_HASHREF is specified (keys are exportnums and values are boolean), the appopriate export_svc records will be inserted. +TODOC: JOB + =cut sub insert { @@ -98,6 +102,8 @@ sub insert { my $exportnums = shift; @exportnums = grep $exportnums->{$_}, keys %$exportnums; } + my $job = ''; + $job = shift if @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -156,13 +162,14 @@ sub insert { } # add export_svc records - + my $slice = 100/scalar(@exportnums) if @exportnums; + my $done = 0; foreach my $exportnum ( @exportnums ) { my $export_svc = new FS::export_svc ( { 'exportnum' => $exportnum, 'svcpart' => $self->svcpart, } ); - $error = $export_svc->insert; + $error = $export_svc->insert($job, $slice*$done++, $slice); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -185,7 +192,7 @@ sub delete { # check & make sure the svcpart isn't in cust_svc or pkg_svc (in any packages)? } -=item replace OLD_RECORD [ '1.3-COMPAT' [ , EXTRA_FIELDS_ARRAYREF [ , EXPORTNUMS_HASHREF ] ] ] +=item replace OLD_RECORD [ '1.3-COMPAT' [ , EXTRA_FIELDS_ARRAYREF [ , EXPORTNUMS_HASHREF [ , JOB ] ] ] ] Replaces OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. @@ -194,10 +201,26 @@ TODOC: 1.3-COMPAT TODOC: EXTRA_FIELDS_ARRAYREF (same as insert method) +TODOC: JOB + =cut sub replace { my ( $new, $old ) = ( shift, shift ); + my $compat = ''; + my @fields = (); + my $exportnums; + my $job = ''; + if ( @_ && $_[0] eq '1.3-COMPAT' ) { + shift; + $compat = '1.3'; + @fields = @{shift(@_)} if @_; + $exportnums = @_ ? shift : ''; + $job = shift if @_; + } else { + return 'non-1.3-COMPAT interface not yet written'; + #not yet implemented + } return "Can't change svcdb for an existing service definition!" unless $old->svcdb eq $new->svcdb; @@ -219,11 +242,7 @@ sub replace { return $error; } - if ( @_ && $_[0] eq '1.3-COMPAT' ) { - shift; - my @fields = (); - @fields = @{shift(@_)} if @_; - my $exportnums = @_ ? shift : ''; + if ( $compat eq '1.3' ) { # maintain part_svc_column records @@ -264,6 +283,7 @@ sub replace { if ( $exportnums ) { #false laziness w/ edit/process/agent_type.cgi + my @new_export_svc = (); foreach my $part_export ( qsearch('part_export', {}) ) { my $exportnum = $part_export->exportnum; my $hashref = { @@ -279,14 +299,26 @@ sub replace { return $error; } } elsif ( ! $export_svc && $exportnums->{$exportnum} ) { - $export_svc = new FS::export_svc ( $hashref ); - $error = $export_svc->insert; + push @new_export_svc, new FS::export_svc ( $hashref ); + } + + } + + my $slice = 100/scalar(@new_export_svc) if @new_export_svc; + my $done = 0; + foreach my $export_svc (@new_export_svc) { + $error = $export_svc->insert($job, $slice*$done++, $slice); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + if ( $job ) { + $error = $job->update_statustext( int( $slice * $done ) ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } } - } } @@ -397,6 +429,70 @@ sub svc_x { =back +=head1 SUBROUTINES + +=over 4 + +=item process + +Experimental job-queue processor for web interface adds/edits + +=cut + +use Storable qw(thaw); +use Data::Dumper; +use MIME::Base64; +sub process { + my $job = shift; + + my $param = thaw(decode_base64(shift)); + warn Dumper($param) if $DEBUG; + + my $old = qsearchs('part_svc', { 'svcpart' => $param->{'svcpart'} }) + if $param->{'svcpart'}; + + $param->{'svc_acct__usergroup'} = + ref($param->{'svc_acct__usergroup'}) + ? join(',', @{$param->{'svc_acct__usergroup'}} ) + : ''; + + my $new = new FS::part_svc ( { + map { + $_ => $param->{$_}; + # } qw(svcpart svc svcdb) + } ( fields('part_svc'), + map { my $svcdb = $_; + my @fields = fields($svcdb); + push @fields, 'usergroup' if $svcdb eq 'svc_acct'; #kludge + map { ( $svcdb.'__'.$_, $svcdb.'__'.$_.'_flag' ) } @fields; + } grep defined( $FS::Record::dbdef->table($_) ), + qw( svc_acct svc_domain svc_forward svc_www svc_broadband ) + ) + } ); + + my %exportnums = + map { $_->exportnum => ( $param->{'exportnum'.$_->exportnum} || '') } + qsearch('part_export', {} ); + + my $error; + if ( $param->{'svcpart'} ) { + $error = $new->replace( $old, + '1.3-COMPAT', + [ 'usergroup' ], + \%exportnums, + $job + ); + } else { + $error = $new->insert( [ 'usergroup' ], + \%exportnums, + $job, + ); + $param->{'svcpart'} = $new->getfield('svcpart'); + } + + die $error if $error; +} + =head1 BUGS Delete is unimplemented. diff --git a/FS/FS/rate.pm b/FS/FS/rate.pm index 1cc215244..f19ebf002 100644 --- a/FS/FS/rate.pm +++ b/FS/FS/rate.pm @@ -2,8 +2,6 @@ package FS::rate; use strict; use vars qw( @ISA $DEBUG ); -use Storable qw(thaw); -use Data::Dumper; use FS::Record qw( qsearch qsearchs dbh fields ); use FS::rate_detail; @@ -309,6 +307,8 @@ Experimental job-queue processor for web interface adds/edits =cut +use Storable qw(thaw); +use Data::Dumper; use MIME::Base64; sub process { my $job = shift; diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 157a2e840..35596e34b 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -1414,7 +1414,7 @@ sub radius_usergroup_selector { END foreach my $group ( @all_groups ) { - $html .= '<OPTION'; + $html .= qq(<OPTION VALUE="$group"); if ( $sel_groups{$group} ) { $html .= ' SELECTED'; $sel_groups{$group} = 0; @@ -1422,7 +1422,7 @@ END $html .= ">$group</OPTION>\n"; } foreach my $group ( grep { $sel_groups{$_} } keys %sel_groups ) { - $html .= "<OPTION SELECTED>$group</OPTION>\n"; + $html .= qq(<OPTION VALUE="$group" SELECTED>$group</OPTION>\n); }; $html .= '</SELECT>'; |