X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=htdocs%2Fedit%2Fprocess%2Fpart_pkg.cgi;h=5af9055d686fb56ada2607de08cb9e4ad8211cc2;hb=15f65a0c56cbce6951d9cb4f71119725a2009f79;hp=78ed696138ebbc045db6a0d28ee14cdd4fbb9aca;hpb=61f2610ee6b8660a206a05675899ed72a5e59296;p=freeside.git diff --git a/htdocs/edit/process/part_pkg.cgi b/htdocs/edit/process/part_pkg.cgi index 78ed69613..5af9055d6 100755 --- a/htdocs/edit/process/part_pkg.cgi +++ b/htdocs/edit/process/part_pkg.cgi @@ -1,6 +1,6 @@ #!/usr/bin/perl -Tw # -# $Id: part_pkg.cgi,v 1.2 1998-11-15 13:16:15 ivan Exp $ +# $Id: part_pkg.cgi,v 1.9 2001-04-09 23:05:16 ivan Exp $ # # process/part_pkg.cgi: Edit package definitions (process form) # @@ -17,87 +17,132 @@ # lose background, FS::CGI ivan@sisd.com 98-sep-2 # # $Log: part_pkg.cgi,v $ -# Revision 1.2 1998-11-15 13:16:15 ivan +# Revision 1.9 2001-04-09 23:05:16 ivan +# Transactions Part I!!! +# +# Revision 1.8 1999/02/07 09:59:27 ivan +# more mod_perl fixes, and bugfixes Peter Wemm sent via email +# +# Revision 1.7 1999/01/19 05:13:55 ivan +# for mod_perl: no more top-level my() variables; use vars instead +# also the last s/create/new/; +# +# Revision 1.6 1999/01/18 22:47:56 ivan +# s/create/new/g; and use fields('table_name') +# +# Revision 1.5 1998/12/30 23:03:29 ivan +# bugfixes; fields isn't exported by derived classes +# +# Revision 1.4 1998/12/17 08:40:24 ivan +# s/CGI::Request/CGI.pm/; etc +# +# Revision 1.3 1998/11/21 07:17:58 ivan +# bugfix to work for regular aswell as custom pricing +# +# Revision 1.2 1998/11/15 13:16:15 ivan # first pass as per-user custom pricing # use strict; +use vars qw( $cgi $pkgpart $old $new $part_svc $error $dbh ); use CGI; use CGI::Carp qw(fatalsToBrowser); use FS::UID qw(cgisuidsetup); -use FS::CGI qw(eidiot popurl); -use FS::Record qw(qsearch qsearchs); -use FS::part_pkg qw(fields); +use FS::CGI qw(popurl); +use FS::Record qw(qsearch qsearchs fields); +use FS::part_pkg; use FS::pkg_svc; use FS::cust_pkg; -my($cgi)=new CGI; -&cgisuidsetup($cgi); +$cgi = new CGI; +$dbh = &cgisuidsetup($cgi); -my($pkgpart)=$cgi->param('pkgpart'); +$pkgpart = $cgi->param('pkgpart'); -my($old)=qsearchs('part_pkg',{'pkgpart'=>$pkgpart}) if $pkgpart; +$old = qsearchs('part_pkg',{'pkgpart'=>$pkgpart}) if $pkgpart; -my($new)=create FS::part_pkg ( { +$new = new FS::part_pkg ( { map { - $_, $cgi->param($_); + $_, scalar($cgi->param($_)); } fields('part_pkg') } ); +#most of the stuff below should move to part_pkg.pm + +foreach $part_svc ( qsearch('part_svc', {} ) ) { + my $quantity = $cgi->param('pkg_svc'. $part_svc->svcpart) || 0; + unless ( $quantity =~ /^(\d+)$/ ) { + $cgi->param('error', "Illegal quantity" ); + print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string ); + exit; + } +} + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; +local $SIG{PIPE} = 'IGNORE'; + +local $FS::UID::AutoCommit = 0; if ( $pkgpart ) { - my($error)=$new->replace($old); - eidiot($error) if $error; + $error = $new->replace($old); } else { - my($error)=$new->insert; - eidiot($error) if $error; - $pkgpart=$new->getfield('pkgpart'); + $error = $new->insert; + $pkgpart=$new->pkgpart; +} +if ( $error ) { + $dbh->rollback; + $cgi->param('error', $error ); + print $cgi->redirect(popurl(2). "part_pkg.cgi?". $cgi->query_string ); + exit; } -my($part_svc); foreach $part_svc (qsearch('part_svc',{})) { -# don't update non-changing records in part_svc (causing harmless but annoying -# "Records identical" errors). ivan@sisd.com 98-jan-19 - #my($quantity)=$cgi->param('pkg_svc'. $part_svc->getfield('svcpart')), - my($quantity)=$cgi->param('pkg_svc'. $part_svc->svcpart) || 0, - my($old_pkg_svc)=qsearchs('pkg_svc',{ - 'pkgpart' => $pkgpart, - 'svcpart' => $part_svc->getfield('svcpart'), - }); - my($old_quantity)=$old_pkg_svc ? $old_pkg_svc->quantity : 0; + my $quantity = $cgi->param('pkg_svc'. $part_svc->svcpart) || 0; + my $old_pkg_svc = qsearchs('pkg_svc', { + 'pkgpart' => $pkgpart, + 'svcpart' => $part_svc->svcpart, + } ); + my $old_quantity = $old_pkg_svc ? $old_pkg_svc->quantity : 0; next unless $old_quantity != $quantity; #!here - my($new_pkg_svc)=create FS::pkg_svc({ + my $new_pkg_svc = new FS::pkg_svc( { 'pkgpart' => $pkgpart, - 'svcpart' => $part_svc->getfield('svcpart'), - #'quantity' => $cgi->param('pkg_svc'. $part_svc->getfield('svcpart')), + 'svcpart' => $part_svc->svcpart, 'quantity' => $quantity, - }); - if ($old_pkg_svc) { - my($error)=$new_pkg_svc->replace($old_pkg_svc); - eidiot($error) if $error; + } ); + if ( $old_pkg_svc ) { + my $myerror = $new_pkg_svc->replace($old_pkg_svc); + if ( $myerror ) { + $dbh->rollback; + die $myerror; + } } else { - my($error)=$new_pkg_svc->insert; - eidiot($error) if $error; + my $myerror = $new_pkg_svc->insert; + if ( $myerror ) { + $dbh->rollback; + die $myerror; + } } } -unless ( $cgi->param('pkgnum') =~ /^(\d+)$/ ) { - #$req->cgi->redirect("../../view/part_pkg.cgi?$pkgpart"); - #$req->cgi->redirect("../../edit/part_pkg.cgi?$pkgpart"); - $cgi->redirect("../../browse/part_pkg.cgi"); +unless ( $cgi->param('pkgnum') && $cgi->param('pkgnum') =~ /^(\d+)$/ ) { + $dbh->commit or die $dbh->errstr; + print $cgi->redirect(popurl(3). "browse/part_pkg.cgi"); } else { my($old_cust_pkg) = qsearchs( 'cust_pkg', { 'pkgnum' => $1 } ); my %hash = $old_cust_pkg->hash; $hash{'pkgpart'} = $pkgpart; - my($new_cust_pkg) = create FS::cust_pkg \%hash; - my $error = $new_cust_pkg->replace($old_cust_pkg); - eidiot "Error modifying cust_pkg record: $error\n" if $error; - print $cgi->redirect(popurl(3). "/view/cust_main.cgi?". $new_cust_pkg->custnum); -} + my($new_cust_pkg) = new FS::cust_pkg \%hash; + my $myerror = $new_cust_pkg->replace($old_cust_pkg); + if ( $myerror ) { + $dbh->rollback; + die "Error modifying cust_pkg record: $myerror\n"; + } + $dbh->commit or die $dbh->errstr; + print $cgi->redirect(popurl(3). "view/cust_main.cgi?". $new_cust_pkg->custnum); +}