view release on metacpan or  search on metacpan

lib/CGI/Bus/tmsql.pm  view on Meta::CPAN

 my $opt  =shift;          # options
    $opt  ='' if !defined($opt);
 my $pxpv =shift;          # previous value param prefix
    $pxpv =!defined($pxpv) ? $s->{-pxpv}
          : substr($pxpv,0,1) eq '-' ? ($s->{$pxpv} ||$pxpv)
          : $pxpv;
 my $pxcv =shift;          # current value param prefix
    $pxcv =!defined($pxcv) ? ''
          : substr($pxcv,0,1) eq '-' ? ($s->{$pxcv} ||$pxpv)
          : $pxcv;
 my $b =1; # backup
 if ($c =~/[ud]/) {
    $s->die("Editing of version of record prohibited\n") if $v->{-npf} && $s->qparam($pxpv .$v->{-npf});
    $b =$v->{-cvd} ? !&{$v->{-cvd}}($s)
       :$v->{-svd} ? !($v->{-svd} eq $s->qparam($pxpv .$v->{-sf}))
       :1;
    if ($b && $opt !~/!v/) {
       my %save;
     # my $save =$s->qparamh($s->qparampx('-pxpv'));
       if ($v->{-npf}) {
          $save{$v->{-npf}} =$s->qparam($pxpv .$v->{-npf});
          $s->qparam($pxpv .$v->{-npf}, $s->qparam($pxcv .$s->keyfld))
       }
       foreach my $f (@{$s->{-form}}) { 
          next if !ref($f) || ref($f) eq 'CODE' 
               || !$f->{-fld} || !($f->{-cdbi} || $f->{-cdbia});
          $save{$f->{-fld}} =$s->qparam($pxpv .$f->{-fld});
       }

       $s->cmdsql('-ins',undef,undef,'-pxpv');
       if ($s->{-fsd}  # backup files
       && $c eq 'u'
       && (!$v->{-svd} || ($v->{-svd} eq $s->qparam($pxcv .$v->{-sf})))
       && -d $s->fspath) {
          $s->fspathcp(undef,     [1, $s->keyval($pxpv)]);
          $s->fsacl('r', '-pxpv', [1, $s->keyval($pxpv)]);
       }

       foreach my $fn (keys %save) {$s->qparam($pxpv .$fn, $save{$fn})}
    }