<>";
my $EWB_format="12;5;h";
my $EWB_sqldbase="";
my $EWB_sqlserver="";
srand(time());
my $PROGRAM_NAME;
{ my @a=split('/', $0);
$PROGRAM_NAME=$a[$#a];
}
my $rlist="";
my $ISASKTO = "";
sub read_form_buffer()
{ my $b=$ENV{"CONTENT_LENGTH"};
my $all=""; my $i;
for ($i=0; $i<$b;)
{ $all=$all.<>;
$i=length($all);
};
my $boundary=((split("\n", $all))[0]);
my @all=split($boundary, $all);
$i=0;
foreach $p(@all)
{
my ($a, $first)=(split("\n", $p));
($a, $b)=split(" name=\"", $first);
if ($b ne "")
{ my $name;
($name, $b)=split("\"", $b);
$parname[$i]=$name;
if (index($first, " filename=\"")<0)
{ my $rest;
$rest="";
for($k=4; $k<=(split("\n", $p)); $k++)
{ $rest=$rest.( (split("\n", $p))[$k]);
};
if ( ($rest) eq "")
{
$parvalue[$i]=((split("\n", $p))[3]);
$parvalue[$i]=substr($parvalue[$i], 0, length($parvalue[$i])-1);
$fltype[$i]="text";
if (substr($parvalue[$i],0, length("HidDenFieldDaTa")) eq
("HidDenFieldDaTa"))
{ $parvalue[$i]=fromasc(substr($parvalue[$i],length("HidDenFieldDaTa")));
};
}
else
{ my $k;
$parvalue[$i]="";
for($k=3; $k<=(split("\n", $p)); $k++)
{ $parvalue[$i]=$parvalue[$i].( (split("\n", $p))[$k])."\n";
};
$parvalue[$i]=substr($parvalue[$i], 0, length($parvalue[$i])-2);
};
$i++;
} else
{ #cerco il content_type
$fltype[$i]="file";
my $ctype=((split("\n", $p))[2]);
$ctype=substr($ctype, 0, length($ctype)-1);
#print "Ctype: [$ctype]\n";
$parvalue[$i] = "";
if (substr(uc($ctype), 0, length("Content-type: ")) eq "CONTENT-TYPE: ")
{ #trasferimento file di testo.
my @p=split("\n", $p);
$p[0]=""; $p[1]=""; $p[2]=""; $p[3]="";
$partype[$i]=substr($ctype, length("Content-type: "));
#printf("partype: $partype[$i]\n");
$parvalue[$i]=join("\n", @p);
$parvalue[$i]=substr($parvalue[$i], 4);
$parvalue[$i]=substr($parvalue[$i], 0, (length($parvalue[$i])-1));
}
$i++;
}
}
}
my $p, $r, $fn; my $cnp=0;
my @pnm; my @pvl;
foreach $p(@parname)
{ $fn=0;
my $cni=0;
foreach $r(@pnm)
{ if ($p eq $r)
{ $pvl[$cni]=$pvl[$cni].";".$parvalue[$cnp];
$fn=1;
};
$cni++;
};
if ( $fn==0 )
{ $pnm[$#pnm+1]=$p;
$pvl[$#pvl+1]=$parvalue[$cnp];
};
$cnp++;
};
@parname=@pnm;
@parvalue=@pvl;
my $p; my $cnt=0;
my @pv; my @tohide; my @hideval;
foreach $p(@parname)
{ if (substr($p, 0, length("EWcHECK_")) eq "EWcHECK_")
{ $p=substr($p, length("EWcHECK_"));
my $n=int($p);
$p=substr($p, length($n));
my $fnd=0;
for ($n=0; $n<=$#tohide; $n++)
{ if ($p eq $tohide[$n])
{ $fnd=1;
$hideval[$n]=$hideval[$n].";".$parvalue[$cnt];
};
};
if ($fnd!=1)
{ $n=$#tohide+1;
$tohide[$n]=$p;
$hideval[$n]=$parvalue[$cnt];
};
};
$cnt++;
};
$cnt=0;
foreach $p(@tohide)
{ my $a;
my $ctb=0;
foreach $a(@parname)
{ if ($a eq $p) { $parvalue[$ctb]=$hideval[$cnt]; }
$ctb++;
}
$cnt++;
};
if (get_par("___from_an_ask_to") ne "")
{
$ISASKTO = get_par("___from_an_ask_to");
}
}
sub get_par($)
{ my ($name)=@_;
my $res="";
my $n; my $i=0;
foreach $n(@parname)
{ if ($name eq EWconv($n))
{ if ($fltype[$i] ne "file") { $res=EWconv($parvalue[$i]); }
else { $res=$parvalue[$i]; };
};
$i++;
};
return $res;
};
sub EWload($)
{ open iif,"<".$_[0];
my $a=join("",
);
close iif;
return $a;
}
sub tab_wlock($)
{ my $name=$_[0];
$name=((split(":", $name))[0]);
my $i; my $d=0;
if (!tab_islock($name))
{ while (($i<10)&&($d==0))
{ if (!(open (III, "< ".checkpath()."TB".$name.".lck")))
{ if (!(open (OOO, "> ".checkpath()."TB".$name.".lck")))
{ print "Attenzione: non posso creare files.\n";
exit(0);
};
close OOO;$d=1;
}
else
{ close III; sleep (1); $i++;
}
}
}
push @EWlocked, $name;
}
sub tab_unlock($)
{ my $name=$_[0];
$name=((split(":", $name))[0]);
my @a; my $l;
my $count=0;
foreach $l(@EWlocked)
{ if (($l ne $name) || ($count>0)) { push @a,$l; }
if ($l eq $name) {++$count; };
}
@EWlocked=@a;
if ($count=1) { unlink(checkpath()."TB".$name.".lck"); };
}
sub tab_read($)
{ #esegue la lettura di una tabella gia bloccata.
my @t=split(":", $_[0]);
open III,"< ".checkpath().".TB$t[0].tab";
my $k=join("",);
my @r=split("\n",$k);
close III;
return @r;
};
sub addchar($)
{ my $a=join("#",split "", $_[0]);
$a=join(chr(0x0D),split("", $a));
return join("\n", split("", $a));
}
sub EWdate()
{ my @ti=localtime(time);
if ($ti[3] < 10)
{ $ti[3] = '0'.$ti[3];
};
$ti[4] = $ti[4] + 1;
if ($ti[4] < 10)
{ $ti[4] = '0'.$ti[4];
};
return $ti[3]." ".$ti[4]." ".($ti[5]+1900);
}
sub EWlessdate($$)
{ my ($d1,$d2)=@_;
my ($day1,$mon1,$yea1)=split(" ",$d1);
my ($day2,$mon2,$yea2)=split(" ",$d2);
my $num1=$day1+($mon1*31)+($yea1*31*12);
my $num2=$day2+($mon2*31)+($yea2*31*12);
return ($num1<$num2);
}
my @parname;
my @parvalue;
srand(time());
read_form_buffer();
if (get_par("EWjump")>0)
{ jumper(get_par("EWjump"));
};
my $ax,$bx,$cx,$dx,@as;
my $TB_bachecastage="bachecastage:idevento:descrizione:linkPDF:scadeil";
my $EWB_idevento="";
my $EWB_descrizione="";
my $EWB_linkPDF="";
my $EWB_scadeil="";
$ax="_templatebachecaofferte.htm";
$ax=EWload($ax);
$EWB_template=$ax;$ax="18:5:v";
$EWB_format=$ax;
my $EWB_EventiWEB; if ($ISASKTO) { $EWB_EventiWEB = get_par("EventiWEB"); };
$ax="";
$EWB_EventiWEB=$ax;
my $EWB_dataoggi; if ($ISASKTO) { $EWB_dataoggi = get_par("dataoggi"); };
$ax=(EWdate ());
$EWB_dataoggi=$ax;
my $EWB_dataoggi_scadeil; if ($ISASKTO) { $EWB_dataoggi_scadeil = get_par("dataoggi_scadeil"); };
$ax="";
$EWB_dataoggi_scadeil=$ax;$ax="bachecastage:idevento:descrizione:linkPDF:scadeil";
$tot=$ax;
$n=((split(":",$tot))[0]);
$ax=join("\n",@p);
push @as, $ax;
@p=split(":",substr($tot,length($n)+1));
tab_wlock($n);
$ax=join("\n",@f);
push @as, $ax;
@f=tab_read($tot);
tab_unlock($n);
$ax=join("\n",@aa);
push @as, $ax;
push @as, $ct;
push @as, $i;
push @as, $l;
push @as, $g;
$i=0;
$g=0;
push @as, $k;
area100:;
if ($g > $#f) { goto area102; };
$l=$f[$g]; $l=substr($l,0,length($l));
$k=0;
$i++;
@aa=split("#", $l);
$ct=0;
$code="";
foreach $p(@p)
{ $code=$code."\$EWB_".$p."=addchar(\$aa[$ct]);
";
$ct++;
};
eval($code);
$ax=$EWB_dataoggi;
push @as,$ax;
$ax=$EWB_scadeil;
$bx=pop @as;
$ax=EWlessdate($bx,$ax);
push @as,$ax;
$ax="1";
$bx=pop @as;
$ax=($bx eq $ax);
if (!($ax)) { goto area101;};
$ax=$EWB_EventiWEB;
push @as,$ax;
$ax="| ";
push @as,$ax;
$ax=$EWB_descrizione;
push @as,$ax;
$ax=" | | | ",$EWB_template));
exit (0);
goto areaend103;
area103:;
;
areaend103:;
$ax="
| Offerta | | | Leggi | ";
push @as,$ax;
$ax=$EWB_EventiWEB;
push @as,$ax;
$ax="
";
$bx=pop @as;
$ax=$bx.$ax;
$bx=pop @as;
$ax=$bx.$ax;
$EWB_EventiWEB=$ax;$ax=$EWB_EventiWEB;
$ax=print join(($ax), split("<>",$EWB_template));
exit(0);
sub jumper($)
{ my $lab=$_[0];
};
#Amethist easyweb v. 5.40(pre 6)
#Enrico Betti e Paride Dominici
sub checkpath()
{ my $a=$EWB_tabpath;
if (substr($a,length($a)-1,1) ne "/")
{ $a=$a."/";
}; return $a;
};
sub EWconv($)
{ my $a=$_[0];
$a=join("%3C", split("%253C", $a));
$a=~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$a=join("
", split("%0A", $a));
$a=join(" ", split("%09", $a));
$a=join("\"", split("%22", $a));
$a=join("<", split("%3C", $a));
return $a;
}
sub tab_islock($)
{ my $name=$_[0];
my $l; my $r=0;
foreach $l(@EWlocked)
{ if ($l eq $name) {$r=1;}
} return $r;
}
sub fromasc($)
{ my $a=$_[0];
my $r; my $i;
for($i=0; $i |