view release on metacpan or  search on metacpan

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

          }
      }

      if ($st ne $sto && !$tskip) {                # push table
          $sto  =$st;
          $sts .=(!$sts ? '' : ', ') .$st->{-tbl} 
      }
    }
 }

 if ($opt =~/[g]/) {          # Assembly SQL Statement  
    if ($op =~/[ud]/) {
       foreach my $v ($swps, ($s->{-fltedt} ||$s->{-filter})) {
         my $vv=(ref($v) ? &$v($s): $v);
         $sws .=(!$sws ? '' : ' AND ') 
              .'(' . $vv.') '
              if $vv
       }
       $s->{-genwhr} =$sws;
    }
    $s->{-genfrom} =$sts;
    $s->{-genedt}  =$op =~/i/ ? "INSERT INTO $sts ($ipns) VALUES ($ipvs)"
                   :$op =~/u/ ? "UPDATE $sts SET $ipvs WHERE $sws"
                   :$op =~/d/ ? "DELETE FROM $sts WHERE $sws"
                   : '';
 }

 if ($opt =~/x/ && $s->dbi) { # Execute SQL Statement 

    $s->pushmsg($s->{-genedt});
    $s->dbi->do($s->{-genedt});

    foreach my $f (@{$s->{-form}}) { 
      next if !ref($f) || ref($f) eq 'CODE' || !$f->{-fld};
      if ($f->{'-cdb' .$op .'a'}) { # after command   
         local $_ =$s->param($pxcv .$f->{-fld});
         $s->param($pxcv .$f->{-fld}, &{$f->{'-cdb' .$op .'a'}}($s, $pxcv));
      }
    }
    &{$s->{-rowsav2a}}($s,$cmd,$opt,$pxpv,$pxcv) if $s->{-rowsav2a};
    &{$s->{-rowsav1a}}($s,$cmd,$opt,$pxpv,$pxcv) if $s->{-rowsav1a} && !$pxcv;
 }
}


sub _vscmn { # Versioning Common Code
 my $s    =shift;
 my $v    =$s->{-vsd}; return if !$v;
 my $p    =$s->parent;
 my $c    =shift;          # command: 'i'nsert, 'u'pdate, 'd'elete
 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})}
    }

    if ($c eq 'd') {
       $s->qparam($pxcv .$v->{-sf}, $v->{-sd}) if $v->{-sd};
    }
 }
 $p->cgi->param($pxcv .$s->{-vsd}->{-uuf}, $p->user)    if $s->{-vsd}->{-uuf};
 $p->cgi->param($pxcv .$s->{-vsd}->{-utf}, $p->strtime) if $s->{-vsd}->{-utf};
}


sub _fscmn {  # File Store Common Code
 my $s    =shift;
 my $v    =$s->{-vsd}; return if !$s->{-fsd};
 my $p    =$s->parent;
 my $c    =shift;          # command: 'i'nsert, 'u'pdate, 'd'elete
 my $opt  =shift;          # options
 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;
 if ($c =~/[iu]/) {
    my $fsa =!$v ? 'w'
            :$v->{-cvd} ? (&{$v->{-cvd}}($s) ? 'w' : 'r')
            :$v->{-svd} ? (($v->{-svd} eq $s->qparam($pxcv .$v->{-sf})) ? 'w' : 'r')
            :'';
    my $fsc =$c =~/[i]/ && $s->keyval($pxpv) 
                        && -d $s->fspath($s->keyval($pxpv));
    $s->fspathmk($s->qparam($pxcv .$s->keyfld))  
                           if $fsa eq 'w' || $fsc;

    $s->fspathcp($s->keyval($pxpv), $s->keyval($pxcv))
                           if $fsc;
    $s->fsacl($fsa, $pxcv) if ($fsa || $fsc) && -d $s->fspath;
  # $s->fsacl($fsa, $pxcv) if $fsc; # 'fsacl' above was above 'fspathcp'
 }
}


sub cmdins { # Insert Record
 my $s =shift;
 $s->acltest('-ins','');
 $s->die($s->lng(1,'op!let',$s->lng(0,'-ins')) ."\n") 
        if ($s->{-rowins} && !&{$s->{-rowins}}($s)) 
        || ($s->{-rowsav} && !&{$s->{-rowsav}}($s))
	|| ($s->{-opflg}  && ($s->{-opflg} !~/[aci]/ || $s->{-opflg} =~/![ci]/));
 $s->_vscmn('i',@_) if $s->{-vsd};
 $s->cmdsql('-ins',@_);