view release on metacpan or  search on metacpan

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

    # Assembly Where Part of SQL Select
    foreach my $v (($opt !~/!q/ ? $swps :'') 
                  , $swfs
                  ) {
      my $vv=(ref($v) ? &$v($s): $v);
      $sws .=(!$sws ? '' : ' AND ') .'(' . $vv.') ' if $vv
    }
    foreach my $v ( ($opt =~/!q/ ? '' : $swps)
                  , ($opt =~/!q/ ? '' : ($s->qparamsw('WHERE')||($vw && $vw->{-wherepar})||''))
                  ) {
      my $vv=(!defined($v) ? '' : ref($v) ? &$v($s): $v =~/^ *$/ ? '' : $v);
      $swts .=(!$swts ? '' : ' AND ') .'(' . $vv .') ' if $vv
    }

    if ($opt !~/!q/ && $s->{-ftext} && $s->qparamsw('FTEXT')) {
       my $c =$s->{-ftext};
       my $v =$s->qparamsw('FTEXT');
       $c =~s/%\$_/$s->dbi->quote('%' .$v .'%')/ge;
       $c =~s/\$_/$s->dbi->quote($v)/ge;
       $sws  .=(!$sws  ? '' : ' AND ') ."($c)";
       $swts .=(!$swts ? '' : ' AND ') ."($c)"
    }
    if ($vw && $vw->{-gant1}) {
       $sws  .=(!$sws  ? '' : ' AND ') 
             .'(' .join(' AND ', map {"$_ IS NOT NULL"} $vw->{-gant1}, $vw->{-gant2}) .')'
    }
    $s->{-genwhr}  =$sws;
    $s->{-genfrom} =$sts;

    # Assembly OrderBy Part of SQL Select
    $sobs =join(',', map {ref($_) ? join(' ',@$_): $_} @$sobs) if ref($sobs);

    # Assembly SQL Select Statement
    my $lr =!$s->dbi ? undef : ($s->qparamsw('LIMIT') || ($vw && $vw->{-listrnm}) || $s->{-listrnm});
    $s->{-gensel} =
          ' FROM ' .$sts
          .($sws ? " WHERE $sws " : '')
          .($vw && $vw->{-groupby} ? ' GROUP BY ' .$vw->{-groupby} .' ' :'')
          .($sobs ? " ORDER BY $sobs " :'')
          .(!$lr ? '' : eval{$s->dbi->{Driver}->{Name} eq 'mysql'} ? (' LIMIT ' .($lr+1) .' ') : '')
          ;
    $s->{-genselg} =$vw && $vw->{-gant1}
         ? 'SELECT MIN(' .$vw->{-gant1} .'), MAX(' .$vw->{-gant2} .')' 
          .     ', MAX(' .$vw->{-gant1} .'), MIN(' .$vw->{-gant2} .')' 
         #.' ' .$s->{-gensel} # 'order by' clause may contain fields to be defined in 'select' list
          .' FROM ' .$sts
          .($sws ? " WHERE $sws " : '')
         : '';
    $s->{-gensel} =
           'SELECT ' .$sfs .($vw && $vw->{-gant1} ? ', ' .join(', ', $vw->{-gant1}, $vw->{-gant2}) : '')
          .$s->{-gensel};
    $s->{-genselt} =$swts;
 }

 if ($opt =~/x/ && $s->dbi) { # Execute SQL Statement 
    my $p =$s->parent;
    my $g =$s->cgi;    
    if ($opt !~/m/) {
       my $t =$p->{-htmlstart}->{-title}||$p->{-htpgstart}->{-title}||'';
       print	'<div class="MenuArea">'
		,($vw && $vw->{-cmt}
		?('<strong class="MenuArea MenuHeader">'
		 ,$p->htmlescape(($t ? "$t - " : '' ), (ref($vw->{-cmt}) ? $vw->{-cmt}->[0] : $vw->{-cmt}))
		 ,"</strong><br />\n")
		:())
		,($vw && $vw->{-cmt} && ref($vw->{-cmt})
		 ?('<span class="MenuArea MenuComment">'
		  ,join("<br />\n"
			,map {$p->htmlescape($_)} @{$vw->{-cmt}}[1..$#{$vw->{-cmt}}])
		  ,"<br /></span>\n")
		 :())
		,($s->{-genselt}
		 ? ('<span class="MenuArea MenuComment" style="font-size: smaller;">'
		   ,$p->htmlescape($s->{-genselt})
		   ,"</span>\n")
		 :())
		,"<hr class=\"MenuArea MenuHeader\"/></div>\n";
    }
    my $c;
    my ($gt1, $gt2, $gm1, $gm2, $gi1, $gi2, $gv1, $gv2, $gs0);
    my $r;
    my $rh;
    if (!$dsub) {
       if ($s->{-genselg}) {
          eval('use POSIX');
          $s->pushmsg($s->{-genselg});
          $s->_explain($s->{-genselg});
          $c =$s->dbi->prepare($s->{-genselg});
          $c->execute;
          if ($gt2 =$c->fetchrow_arrayref) {
             $gt1  =defined($gt2->[3]) && $gt2->[3] lt $gt2->[0] ? $gt2->[3] : $gt2->[0];
             $gt2  =defined($gt2->[2]) && $gt2->[2] gt $gt2->[1] ? $gt2->[2] : $gt2->[1];
             if ($gt1 ||$gt2) {
                $gm1 =int($gt1 =~/(\d+)-(\d+)-(\d+)\s*(\d*):(\d*):(\d*)/ && (POSIX::mktime($6, $5, $4, $3, $2-1, $1 -1900)/86400)) +1;
                $gm2 =int($gt2 =~/(\d+)-(\d+)-(\d+)\s*(\d*):(\d*):(\d*)/ && (POSIX::mktime($6, $5, $4, $3, $2-1, $1 -1900)/86400)) +1;
                $gs0 =$vw && $vw->{-htmlg1}
                     ?$vw->{-htmlg1}
                     :'<td valign=top bgcolor=gray>#</td>';
                if ($gm1 >$gm2) {
                   $c =$gt1; $gt1 =$gt2; $gt2 =$c;
                   $c =$gm1; $gm1 =$gm2; $gm2 =$c;
                }
                $s->pushmsg("Gant margins retrieved: $gt1 (" .gmtime($gm1*86400) ."), $gt2 (" .gmtime($gm2*86400) .")");
             }
          }
       }
       $s->pushmsg($s->{-gensel});
       $s->_explain($s->{-gensel});
       $c =$s->dbi->prepare($s->{-gensel});
       $c->execute;
    }
    else {
       $dsub =&$dsub($s,$vw,$cnd,$sfdl,$rh);
    }
    my $lr=$s->qparamsw('LIMIT') ||($vw && $vw->{-listrnm}) ||$s->{-listrnm};
    my $rc =0;
    my @hr0=$vw && $vw->{-href} ? @{$vw->{-href}} :();
       $hr0[0] =$p->qurl if !$hr0[0];
       $hr0[1] =$s->pxcb('-cmd') if !$hr0[1];
       $hr0[2] ='-sel'   if !$hr0[2];
    my $mh =$vw && $vw->{-hrefc} ? $vw->{-hrefc} :0;
    my $mr =$#{$vfnl};
       $mh =$mr if $mh <0;
    local $_;
    print $vw && $vw->{-htmlts} ? $vw->{-htmlts}
        : $s->{-htmlts}         ? $s->{-htmlts}
        : $gm2 ? "<font style=\"font-size: smaller;\">\n<table class=\"ListTable\" rules=all border=1 cellspacing=0 frame=void style=\"font-size: x-small;\">\n"
                                  # rules=rows|all frame=void
      # : "<table class=\"ListTable\">\n";
        : "<table class=\"ListTable\" cellpadding=\"3%\">\n";
      # : "<table class=\"ListTable\" cellpadding=3>\n";
      # : "<table class=\"ListTable\" rules=all border=1 cellspacing=0 frame=void>\n";
    if ($opt !~/m/) {
       print '<thead><tr>'
            ,map {
             my $v =$sfdl->[$_]->{-lbl}||''; # ||$sfdl->[$_]->{-fld}
             ('<th align="left" valign="top" class="ListTable" title="'