Page MenuHomeHEPForge
Files F8309689

subs.pl_save4
No OneTemporary
Actions

subs.pl_save4
View Options

#!/usr/bin/perl
sub dbase0{
($query) = @_;
$sth = $dbh->prepare($query);
$rc = $sth->execute();
}
sub dbase2{
($query) = @_;
$sth = $dbh->prepare($query);
$rc = $sth->execute();
if ($rc ne '0E0') {$result = $dbh->selectall_arrayref($sth); $rc = 1;}
}
sub trim{
$_[0] =~ s/^\s+//;
$_[0]=~ s/\s+$//;
}
sub filter{
# $_[0] =~ s/>/&gt\;/g;
# $_[0] =~ s/</&lt\;/g;
# $_[0] =~ s/>=/&ge\;/g;
# $_[0] =~ s/<=/&le\;/g;
# $_[0] =~ s/</&lt\;/g;
# $_[0] =~ s/</&lt\;/g;
}
sub deletePaperId{
($PAPERID) = @_;
&dbase2("select DATASET_ID from Datasets where _paper_PAPER_ID=$PAPERID");
$numd=0;
foreach $row (@$result){@list = split /\t/,join("\t",@$row);
$DATASETID[++$numd] = $list[0];
}
foreach $nd (1...$numd){
&dbase2("select AXIS_ID from XAxes where _dataset_DATASET_ID=$DATASETID[$nd]");
$numxax=0;
foreach $row (@$result){@list = split /\t/,join("\t",@$row);
$XAXISID[++$numxax] = $list[0];
}
foreach $nxax (1...$numxax){
&dbase2("select VALUE_ID from Bins where _xAxis_AXIS_ID=$XAXISID[$nxax]");
foreach $row (@$result){@list = split /\t/,join("\t",@$row);
&dbase0("delete from Bins where VALUE_ID=$list[0]");
}
&dbase0("delete from XAxes where AXIS_ID=$XAXISID[$nxax]");
}
&dbase2("select AXIS_ID from YAxes where _dataset_DATASET_ID=$DATASETID[$nd]");
$numyax=0;
foreach $row (@$result){@list = split /\t/,join("\t",@$row);
$YAXISID[++$numyax] = $list[0];
}
foreach $nyax (1...$numyax){
&dbase2("select VALUE_ID from Points where _yAxis_AXIS_ID=$YAXISID[$nyax]");
foreach $row (@$result){@list = split /\t/,join("\t",@$row);
&dbase0("delete from Points where VALUE_ID=$list[0]");
&dbase0("delete from PointErrors where VALUE_ID=$list[0]");
}
&dbase2("select PROPERTY_ID from AxisProperties where _yAxis_AXIS_ID=$YAXISID[$nyax]");
foreach $row (@$result){@list = split /\t/,join("\t",@$row);
&dbase0("delete from BaseProperties where PROPERTY_ID=$list[0]");
}
&dbase2("select REACTION_ID from AxisReactions where _yAxis_AXIS_ID=$YAXISID[$nyax]");
foreach $row (@$result){@list = split /\t/,join("\t",@$row);
&dbase0("delete from InitialStates where REACTION_ID=$list[0]");
&dbase0("delete from FinalStates where REACTION_ID=$list[0]");
}
&dbase0("delete from YAxisComments where AXIS_ID=$YAXISID[$nyax]");
&dbase0("delete from AxisProperties where _yAxis_AXIS_ID=$YAXISID[$nyax]");
&dbase0("delete from AxisReactions where _yAxis_AXIS_ID=$YAXISID[$nyax]");
&dbase0("delete from YAxes where AXIS_ID=$YAXISID[$nyax]");
}
&dbase0("delete from DatasetComments where DATASET_ID=$DATASETID[$nd]");
&dbase0("delete from DatasetErrors where DATASET_ID=$DATASETID[$nd]");
&dbase0("delete from DsReactions where DATASET_ID=$DATASETID[$nd]");
&dbase0("delete from DsObservables where DATASET_ID=$DATASETID[$nd]");
&dbase0("delete from DsPlabs where DATASET_ID=$DATASETID[$nd]");
&dbase0("delete from Datasets where DATASET_ID=$DATASETID[$nd]");
}
&dbase0("delete from PaperAuthors where PAPER_ID=$PAPERID");
&dbase0("delete from PaperRefs where PAPER_ID=$PAPERID");
&dbase0("delete from PaperMods where PAPER_ID=$PAPERID");
&dbase0("delete from PaperExpts where PAPER_ID=$PAPERID");
&dbase0("delete from PaperComments where PAPER_ID=$PAPERID");
&dbase0("delete from Papers where PAPER_ID=$PAPERID");
}
sub addPaperId{
($PAPERID,$textin) = @_;
$LINE = "";
$nds = 0;
$ncr = 0;
$ndes = 0;
$nref=0;
$data = 'off';
$qflag = 'off';
$tabletrigger = 'no'; # will be set to "yes" if the "TABLE" keyword is used to indicate start of new table.
$pmnum_patt1 = '[-+]?[\d]+\.?[\d]*';
$pmnum_patt2 = '[-+]?\.[\d]+';
$pmnum_patt3 = '[-+]?[\d]+\.?[\d]*\s*[eE]+\s*[+-]?\s*[\d]+';
$pmnum_patt = $pmnum_patt1.'|'.$pmnum_patt2.'|'.$pmnum_patt3;
$num_patt1 = '[\d]+\.?[\d]*';
$num_patt2 = '\.[\d]+|[\d]+\.?[\d]*\s*[eE]+\s*[+-]?\s*[\d]+';
$num_patt = $num_patt1.'|'.$num_patt2;
$number = '^\s*('.$pmnum_patt.')\s*$';
$splitname = '^\s*(.*)\s+IN\s+(.*)$';
$splitvalue = '^('.$pmnum_patt.')\s*TO\s*('.$pmnum_patt.')$';
$splitvalbin = '^('.$pmnum_patt.')\s*\(\s*BIN\s*=\s*('.$pmnum_patt.')\s*TO\s*('.$pmnum_patt.')\s*\)$';
$splitvalpm = '^('.$pmnum_patt.')\s*\+-\s*('.$num_patt.')$';
$splitgt = '^(.*)\s*>\s*('.$pmnum_patt.')$';
$splitlt = '^(.*)\s*<\s*('.$pmnum_patt.')$';
@INPUT2 = split /\n+/,$textin;
$n=-1;
for ($lcount=0; $lcount<=$#INPUT2; $lcount++){
@input = split/\s+/,$INPUT2[$lcount];
if($#input>-1){
$INPUT[++$n]=$INPUT2[$lcount];
}
}
# print "max lcount $#INPUT\n";
for ($lcount=0; $lcount < $#INPUT; $lcount++) {
$line = $INPUT[$lcount];
if(length($line) > 1){
chomp $line;
if($line !~ m/^\*data:\s*/ && $line !~ m/^\*dataend:\s*/){
$LINE = $LINE." ".$line;
#the new version??
if($data eq 'off'){
while($INPUT[$lcount+1]!~m/^\s*\*/){
$LINE .= $INPUT[$lcount+1];
$lcount++;
}
}
&trim($LINE);
# chop $LINE; # take off the ; at the end
$LINE =~ s/&\s/&/g; # remove the space after the ampersand
if($LINE =~ m/^\*spiresId:\s*/){($dummy,$irn)=split/\s*:\s*/,$LINE,2;}
elsif($LINE =~ m/^\*inspireId:\s*/){($dummy,$ins)=split/\s*:\s*/,$LINE,2;}
elsif($LINE =~ m/^\*durhamId:\s*/){($dummy,$red)=split/\s*:\s*/,$LINE,2;}
elsif($LINE =~ m/^\*doi:\s*/){($dummy,$doi)=split/\s*:\s*/,$LINE,2;}
elsif($LINE =~ m/^\*status:\s*/){
($dummy,$des)=split/\s*:\s*/,$LINE,2;
@LINE=split/\s+/,$des;
$who[++$ndes] = $LINE[5];
$when[$ndes] = $LINE[1]." ".$LINE[2]." ".$LINE[3]
}
elsif($LINE =~ m/^\*comment:\s*/){($dummy,$comment[++$ncr]) = split/\s*:\s*/,$LINE,2;}
elsif($LINE =~ m/^\*author:\s*/){($dummy,$author)=split/\s*:\s*/,$LINE,2;}
elsif($LINE =~ m/^\*reference:\s*/){
$nref++;
$LINE=~s/ARXIV:/ARXIV;/;
$LINE=~s/http:/http;/;
$LINE=~s/https:/https;/;
if($LINE=~m/^(.*)\((\d+)\)\s*$/) { $dref[$nref]=$2; $LINE=$1; }
@LINE=split /\s*:\s*/,$LINE;
$ref[$nref]=$LINE[1];
if ($#LINE==2) { $dref[$nref]=$LINE[2];}
$ref[$nref]=~s/ARXIV;/ARXIV:/;
$ref[$nref]=~s/http;/http:/;
$ref[$nref]=~s/https;/https:/;
if($ref[$nref]=~m/^PL/
|| $ref[$nref]=~m/^PR/
|| $ref[$nref]=~m/^EP/
|| $ref[$nref]=~m/^JHEP/
|| $ref[$nref]=~m/^ZP/
|| $ref[$nref]=~m/^NP/
|| $ref[$nref]=~m/^SJNP/
|| $ref[$nref]=~m/^YF/
|| $ref[$nref]=~m/^NC/ ) { $type[$nref]="JOUR";}
elsif ($ref[$nref]=~m/^http/) { $type[$nref]="AUX"; }
else {$type[$nref]="PREP";}
}
elsif($LINE =~ m/^\*experiment:\s*/){
@LINE=split/\s*:\s*/,$LINE;
@expt = split /\s*;\s*/,$LINE[1];
foreach $ne (0...$#expt){
$exp[$ne+1]=$expt[$ne];
$collider[$ne+1]='';
if($exp[$ne+1] =~ m/^([-\w]+)-\w+$/){$collider[$ne+1] = $1;}
}
$nexpt = $#expt+1;
}
elsif($LINE =~ m/^\*detector:\s*/){
@LINE=split/\s*:\s*/,$LINE;
@det = split /;/,$LINE[1];
foreach $ne (0...$#det){
$de[$ne+1] = $det[$ne];
}
$ndet = $#det+1;
}
elsif($LINE =~ m/^\*dataset:\s*/){
$tabletrigger = "yes";
$nds++;
$nreac[$nds] = 0;
$ndsreac[$nds] = 0;
$ndsobs[$nds] = 0;
$nqual[$nds]=0;
$qflag='off';
}
elsif($LINE =~ m/^\*location:\s*/){
if($tabletrigger eq "no"){
$nds++;
$nreac[$nds] = 0;
$ndsreac[$nds] = 0;
$ndsobs[$nds] = 0;
$ndserr[$nds] = 0;
$nqual[$nds]=0;
$qflag='off';
}
@LINE=split/\s*:\s*/,$LINE;
$location[$nds] = 'Location: '.$LINE[1];
}
elsif($LINE =~ m/^\*dscomment:\s*/){
@LINE=split/\s*:\s+/,$LINE,2;
$dscomment[$nds] = $LINE[1];
}
elsif($LINE =~ m/^\*title:\s*/){
$title = "";
@LINE=split/\s*:\s+/,$LINE,2;
$title = $LINE[1];
}
elsif($LINE =~ m/^\*reackey:\s*/){
@LINE=split/\s*:\s*/,$LINE,2;
@reacs = split /\s*;\s*/,$LINE[1];
$dsreac[$nds][++$ndsreac[$nds]]=$reacs[0];
}
elsif($LINE =~ m/^\*dserror:\s*/){
@LINE=split/\s*:\s*/,$LINE;
$dserr[$nds][++$ndserr[$nds]]=$LINE[1];
$dserrcom[$nds][$ndserr[$nds]]=$LINE[2];
}
elsif($LINE =~ m/^\*obskey:\s*/){
@LINE=split/\s*:\s*/,$LINE,2;
@obss = split /\s*;\s*/,$LINE[1];
$dsobs[$nds][++$ndsobs[$nds]]=$obss[0];
}
elsif($LINE =~ m/^\*yheader:\s*/){
$qflag='off';
@line = split /\s*:\s*/,$LINE;
$nyhead[$nds]=1;
$yhead[$nds][$nyhead[$nds]] = $line[1];
if($#line>1){
foreach $yh (2...$#line){
$yhead[$nds][++$nyhead[$nds]] = $line[$yh];
}
}
}
elsif($LINE =~ m/^\*xheader:\s*/){
$qflag='off';
@line = split /\s*:\s*/,$LINE;
$nxhead[$nds]=1;
$xhead[$nds][$nxhead[$nds]] = $line[1];
# print " $nds $nxhead[$nds] $xhead[$nds][$nxhead[$nds]]<br>\n";
if($#line>1){
foreach $xh (2...$#line){
$xhead[$nds][++$nxhead[$nds]] = $line[$xh];
print " $nds $nxhead[$nds] $xhead[$nds][$nxhead[$nds]]<br>\n";
}
}
}
elsif($LINE =~ m/^\*qual:\s*/){
$qflag='on';
}
elsif($data eq 'on'){
#print "setting data<br>";
if($LINE =~ m/;/) { $splitter = ";"; }
else { $splitter = ":"; }
@parts = split/$splitter/,$LINE;
$nbins[$nds]++;
foreach $b (1...$nx[$nds]){
$bin[$nds][$b][$nbins[$nds]] = $parts[$b-1];
&trim($bin[$nds][$b][$nbins[$nds]]);
#print "$b $bin[$nds][$b][$nbins[$nds]]<br>";
}
foreach $b ($nx[$nds]+1...$nx[$nds]+$ny[$nds]){
$point[$nds][$b-$nx[$nds]][$nbins[$nds]] = $parts[$b-1];
#print "$b $point[$nds][$b-$nx[$nds]][$nbins[$nds]]<br>";
}
}
else {
}
if($qflag eq 'on'){
$qual[$nds][++$nqual[$nds]] = $LINE;
#print "QUAL $nds $nqual[$nds] $qual[$nds][$nqual[$nds]]<br>\n";
}
$LINE = "";
}
elsif($line =~ m/^\*data:\s*/){
$qflag='off';
$data = 'on';
$nbins[$nds]=0;
$nx[$nds] = ($line =~ tr/x//);
$ny[$nds] = ($line =~ tr/y//);
if($ny[$nds] > 1 && $nyhead[$nds] == 1){
foreach $yh (2...$ny[$nds]){
$yhead[$nds][++$nyhead[$nds]] = $yhead[$nds][1];
}
}
}
elsif($line =~ m/^\*dataend:\s*/){
# print "data off<br>";
$data = 'off';
}
else{
}
} # end of non-zero line loop
} # end of overall for loop
###############################################################
foreach $d (1...$nds){
foreach $q (1...$nqual[$d]){
@qqual = split /\s*:\s*/,$qual[$d][$q];
foreach $y (1...$ny[$d]){
if($#qqual==2){
$yqual[$d][$y][$q] = "N = $qqual[1]; V = $qqual[2]";
} else {
$yqual[$d][$y][$q] = "N = $qqual[1]; V = $qqual[$y+1]";
}
#print "$d $q $y $ny[$d] $yqual[$d][$y][$q]<br>\n";
}
}
}
#
# $title = `ssh h1 '$export/home/whalley/spires/getTitleFromIRN $irn'`;
# $date = `ssh h1 'spires/getDateFromIRN $irn'`;
# chomp $title;
# chomp $date;
################################################################
# if($title eq "") { $title = "no title";}
$date = "0000";
$npaper=$PAPERID;
if($red eq "") { $red=$npaper; }
# print "inserting /$npaper/$irn/$ins/$red/$titl/ in Papers<br>\n";
&dbase0("insert into Papers set PAPER_ID=$npaper,HepdataId=$npaper,Title='$title'");
if($irn ne "" ) {&dbase0("update Papers set SpiresId=$irn where PAPER_ID=$npaper");}
if($ins ne "" ) {&dbase0("update Papers set InspireId=$ins where PAPER_ID=$npaper");}
if($red ne "" ) {&dbase0("update Papers set RedId=$red where PAPER_ID=$npaper");}
if($doi ne "" ) {&dbase0("update Papers set DOI='$doi' where PAPER_ID=$npaper");}
foreach $d (1...$ndes){
# print "inserting /$npaper/$irn/$when[$d]/$who[$d]/$title/ in PaperMods<br>\n";
&dbase0("insert into PaperMods set PAPER_ID=$npaper,ModComment='$when[$d]',Modifier='$who[$d]'");
}
foreach $nc (0...$ncr-1){
&filter($comment[$nc+1]);
# print "Inserting paper comment into PaperComments<br>\n";
&dbase0("insert into PaperComments set PAPER_ID=$npaper,element='$comment[$nc+1]',Posn='$nc'");
}
#print "inserting /$npaper/$author/ in PaperAuthors<br>\n";
&dbase0("insert into PaperAuthors set PAPER_ID=$npaper,element='$author'");
foreach $nr (1...$nref){
#print "inserting /$npaper/$ref[$nr]/$dref[$nr]/$type[$nr]/$date[$nr]/ in PaperRefs<br>\n";
&dbase0("insert into PaperRefs set PAPER_ID=$npaper,Description='$ref[$nr]',date='$dref[$nr]',type='$type[$nr]'");
}
foreach $ne (1...$nexpt){
#print "inserting /$npaper/$de[$ne]/$exp[$ne]/$collider[$ne]/ in PaperExpts<br>\n";
&dbase0("insert into PaperExpts set PAPER_ID=$npaper,InformalName='$de[$ne]',ExptName='$exp[$ne]',Lab='$collider[$ne]'");
}
&dbase2("select max(DATASET_ID) from Datasets");
foreach $row (@$result){@list = split /\t/,join("\t",@$row);
$dsid = $list[0];
}
&dbase2("select max(AXIS_ID) from YAxes");
foreach $row (@$result){@list = split /\t/,join("\t",@$row);
$yaxisid = $list[0];
}
$axisid=$yaxisid;
&dbase2("select max(AXIS_ID) from XAxes");
foreach $row (@$result){@list = split /\t/,join("\t",@$row);
$xaxisid = $list[0];
}
if($xaxisid > $axisid) { $axisid=$xaxisid;}
&dbase2("select max(VALUE_ID) from Points");
foreach $row (@$result){@list = split /\t/,join("\t",@$row);
$yvalueid = $list[0];
}
&dbase2("select max(VALUE_ID) from Bins");
foreach $row (@$result){@list = split /\t/,join("\t",@$row);
$xvalueid = $list[0];
}
$valueid=$yvalueid;
if($xvalueid>$yvalueid) { $valueid=$xvalueid; }
&dbase2("select max(REACTION_ID) from AxisReactions");
foreach $row (@$result){@list = split /\t/,join("\t",@$row);
$reacid = $list[0];
}
&dbase2("select max(PROPERTY_ID) from BaseProperties");
foreach $row (@$result){@list = split /\t/,join("\t",@$row);
$propid = $list[0];
}
foreach $n (1...$nds){
$dsid++;
#print "inserting /$dsid/$n/$npaper/ in Datasets<br>\n";
&dbase0("insert into Datasets set DATASET_ID=$dsid,LocalId=$n,_paper_PAPER_ID=$npaper");
&filter($dscomment[$n]);
#print "inserting /$dsid/$dscomment[$n]/ in DatasetComments<br>\n";
&dbase0("insert into DatasetComments set DATASET_ID=$dsid,Comments='$dscomment[$n]',Posn=0");
#print "inserting /$dsid/$location[$n]/ in DatasetComments<br>\n";
&dbase0("insert into DatasetComments set DATASET_ID=$dsid,Comments='$location[$n]',Posn=1");
foreach $r (1...$ndsreac[$n]){
$posn=$r-1;
&filter($dsreac[$n][$r]);
#print "inserting /$dsid/$dsreac[$n][$r]/$posn/ in DsReactions<br>\n";
&dbase0("insert into DsReactions set DATASET_ID=$dsid,DsReactions='$dsreac[$n][$r]',Posn=$posn");
}
foreach $o (1...$ndsobs[$n]){
$posn=$o-1;
#print "inserting /$dsid/$dsobs[$n][$o]/$posn/ in DsObservables<br>\n";
&dbase0("insert into DsObservables set DATASET_ID=$dsid,DsObservables='$dsobs[$n][$o]',Posn=$posn");
}
foreach $p (1...$ndsplab[$n]){
$posn=$p-1;
&dbase0("insert into DSPlabs set DATASET_ID=$dsid,DsPlabs='$dsplab[$n][$p]',Posn=$posn");
}
foreach $err (1...$ndserr[$n]){
$posn=$err-1;
print "inserting /$dsid/$dserr[$n][$err]/$posn/$dserrcom[$n][$err]/ in DatasetErrors<br>\n";
&dbase0("insert into DatasetErrors set DATASET_ID=$dsid,PlusError='$dserr[$n][$err]',MinusError='$dserr[$n][$err]',Comment='$dserrcom[$n][$err]',Source='SYS',Norm='PCT',LocalId=$posn");
}
foreach $b (1...$nx[$n]){
$axisid++;
&dbase0("insert into XAxes set AXIS_ID=$axisid,LocalId=$b,_dataset_DATASET_ID=$dsid,Header='$xhead[$n][$b]'");
foreach $j (1...$nbins[$n]){
$valueid++;
$low = "";
$high = "";
$focus = "";
$relation = "";
$description = "";
if($bin[$n][$b][$j] =~ /^\s*($pmnum_patt1)\s*$/){ $focus = $1;}
elsif($bin[$n][$b][$j] =~ /^\s*($pmnum_patt1)\s+($pmnum_patt1)$/){ $high = $2; $low = $1;}
elsif($bin[$n][$b][$j] =~ /^\s*($pmnum_patt1)\s+($pmnum_patt1)\s+($pmnum_patt1)$/){
undef @xxx;
undef @xxx1;
$xxx1[0]=$1;
$xxx1[1]=$2;
$xxx1[2]=$3;
@xxx = sort { $a <=> $b } @xxx1;
$low=$xxx[0];
$focus=$xxx[1];
$high=$xxx[2];
}
elsif($bin[$n][$b][$j] =~ /^\s*($pmnum_patt1)\s*\(\s*BIN\s*=\s*($pmnum_patt1)\s+TO\s+($pmnum_patt1)\s*\)\s*$/){$focus=$1; $high = $3;$low = $2;}
elsif($bin[$n][$b][$j] =~ /^\s*($pmnum_patt1)\s+TO\s+($pmnum_patt1)\s*$/){ $high = $2; $low = $1;}
elsif($bin[$n][$b][$j] =~ /^\s*<\s*($pmnum_patt)\s*$/){$high = $1; $relation='LESS';}
elsif($bin[$n][$b][$j] =~ /^\s*>\s*($pmnum_patt)\s*$/){$low = $1; $relation='GREATER';}
elsif($bin[$n][$b][$j] =~ /^\s*<=\s*($pmnum_patt)\s*$/){$high = $1; $relation='LESSEQUALS';}
elsif($bin[$n][$b][$j] =~ /^\s*>=\s*($pmnum_patt)\s*$/){$low = $1; $relation='GREATEREQUALS';}
else{$description = $bin[$n][$b][$j];}
$query = "insert into Bins set _xAxis_AXIS_ID=$axisid,VALUE_ID=$valueid,LocalId=$j";
if($focus ne "") {
&trim($focus);
if(index($focus,'.') > 0) {
$lenfocus = length($focus) - index($focus,'.') - 1;
} else {
$lenfocus=0;
}
$query .= ",Focus='$focus',FocusLength=$lenfocus";
}
if($low ne "") {
&trim($low);
if(index($low,'.') > 0) {
$lenlow = length($low) - index($low,'.') - 1;
} else {
$lenlow=0;
}
if($lenfocus==""){$lenfocus=$lenlow;}
$query .= ",LowValue='$low',LowValueLength=$lenfocus";
}
if($high ne "") {
&trim($high);
if(index($high,'.') > 0) {
$lenhigh = length($high) - index($high,'.') - 1;
} else {
$lenhigh=0;
}
if($lenfocus==""){$lenfocus=$lenhigh;}
$query .= ",HighValue='$high',HighValueLength=$lenhigh";
}
if($relation ne "") {
$query .= ",Relation='$relation'";
} else {
$query .= ",Relation='EQUALS'";
}
if($width ne "") {
$query .= ",Width='$width'";
}
if($description ne "") {
&filter($description);
$query .= ",Description='$description'";
}
&dbase0($query);
}
}
foreach $b (1...$ny[$n]){
$axisid++;
&dbase0("insert into YAxes set AXIS_ID=$axisid,LocalId=$b,_dataset_DATASET_ID=$dsid,Header='$yhead[$n][$b]'");
$commpos=0;
foreach $q (1...$nqual[$n]){
if($yqual[$n][$b][$q] =~ /^\s*N\s*\.?\s*=\s*YN/){}
elsif($yqual[$n][$b][$q] =~ /^\s*N\s*\.?\s*=\s*RE/){
$reacid++;
@parts = split /;/,$yqual[$n][$b][$q];
$re_extra="";
if($parts[0] =~/^\s*N\s*\.?\s*=\s*RE(.*)\s*$/){ $re_extra=$1;}
if($parts[1] =~/^\s*V\s*\.?\s*=\s*(.*)\s*$/){
$reacfull = $1;
($is,$fs) = split /\s*-->\s*/,$1,2;
@is2 = split /\s+/,$is;
@fs2 = split /\s+/,$fs;
$nfs = 0;
undef @fs;
foreach $m2 (0...$#fs2){
if($m2 == 0){
$fs[0] = $fs2[0];
$fsmult[0] = 1;
$fsrel[0] = 'EQUALS';
$nfs++;
}
else {
$fsmatch = -1;
foreach $n (0...$#fs) { if($fs2[$m2] eq $fs[$n]) { $fsmatch = $n;} }
if($fsmatch > -1){$fsmult[$fsmatch]++;}
else {
$fs[$nfs]=$fs2[$m2];
$fsmult[$nfs] = 1;
$fsrel[$nfs]='EQUALS';
$nfs++;
}
}
}
$nis = 0;
undef @is;
foreach $m2 (0...$#is2){
if($m2 == 0){
$is[0] = $is2[0];
$ismult[0] = 1;
$isrel[0] = 'EQUALS';
$nis++;
}
else {
$ismatch = -1;
foreach $n (0...$#is) { if($is2[$m2] eq $is[$n]) { $ismatch = $n;} }
if(ifsmatch > -1){$ismult[$ismatch]++;}
else {
$is[$nis]=$is2[$m2];
$ismult[$nis] = 1;
$isrel[$nis]='EQUALS';
$nis++;
}
}
}
&dbase0("insert into AxisReactions set REACTION_ID=$reacid,_yAxis_AXIS_ID=$axisid");
foreach $i (0...$#is){
&dbase0("insert into InitialStates set REACTION_ID=$reacid,Multiplicity=$ismult[$i],ParticleName='$is[$i]'");
}
foreach $f (0...$#fs){
if($fs[$f] ne '<' && $fs[$f] ne '>'){
&dbase0("insert into FinalStates set REACTION_ID=$reacid,Multiplicity=$fsmult[$f],ParticleName='$fs[$f]',MultRelation='$fsrel[$f]'");
}
}
}
$commre = " RE$re_extra : $reacfull\n";
&filter($commre);
&trim($commre);
&dbase0("insert into YAxisComments set AXIS_ID=$axisid,Posn=$commpos,Comments='$commre'") ;
$commpos++;
}
else{
if($yqual[$n][$b][$q] =~ /^\s*N\.?\s*=(.*)\s*\;\s*V\.?\s*=\s*(.*)\s*$/){
$left = $1;
$right = $2;
# $left =~ s/SQRT\(S\)/sqrts/;
$name = "$left";
$unit = "num";
$low = "";
$high = "";
if($left =~ /$splitname/){
$name = $1;
$unit = $2;
}
if($right =~ /$number/){
$propid++;
$low = $right;
$high = $right;
&trim($low); &trim($high); &trim($name); &trim($unit);
$unit =~ s/EV/eV/;
&dbase0("insert into BaseProperties set PROPERTY_ID=$propid,Name='$name',LowValue=$low,HighValue=$high,Unit='$unit'");
&dbase0("insert into AxisProperties set PROPERTY_ID=$propid,_yAxis_AXIS_ID=$axisid");
}
elsif($right =~ /$splitvalue/){
$propid++;
$low = $1;
$high = $2;
&trim($low); &trim($high); &trim($name); &trim($unit);
$unit =~ s/EV/ev/;
&dbase0("insert into BaseProperties set PROPERTY_ID=$propid,Name='$name',LowValue=$low,HighValue=$high,Unit='$unit'");
&dbase0("insert into AxisProperties set PROPERTY_ID=$propid,_yAxis_AXIS_ID=$axisid");
}
elsif($right =~ /$splitvalbin/){
$propid++;
$focus = $1;
$low = $2;
$high = $3;
&trim($low); &trim($high); &trim($name); &trim($unit); &trim($focus);
$unit =~ s/EV/ev/;
&dbase0("insert into BaseProperties set PROPERTY_ID=$propid,Focus=$focus,Name='$name',LowValue=$low,HighValue=$high,Unit='$unit'");
&dbase0("insert into AxisProperties set PROPERTY_ID=$propid,_yAxis_AXIS_ID=$axisid");
}
else{
&trim($left);
&trim($right);
&filter($left);
&filter($right);
$xxx = "$left : $right";
&dbase0("insert into YAxisComments set AXIS_ID=$axisid,Posn=$commpos,Comments='$xxx'");
$commpos++;
}
}
}
}
foreach $j (1...$nbins[$n]){
$valueid++;
$val = $point[$n][$b][$j];
if($val !~ /^\s*-\s*$/){
$value = $val;
$rel = 'EQUALS';
&trim($val);
@val=split/\s+/,$val;
$style='input';
foreach $nval (0...$#val){ if($val[$nval]=~m/^$pmnum_patt$/){} else { $style='bdms'; } }
if($style eq 'input'){
$val = "$val[0]";
foreach $nval (1...$#val){ $val[$nval]=~s/^\+//; }
$next=1;
$nerr=1;
while ($next<=$#val){
$pm='true';
if($next<$#val){
if($val[$next]<0.0||$val[$next+1]<0.0){ $pm='false'; }
}
if($pm eq 'true') {
if($nerr==1) { $val .= " +- $val[$next]";}
elsif($nerr==2) { $val .= " (DSYS=$val[$next]";}
else { $val .= ",DSYS=$val[$next]";}
$next += 1;
}
else{
if($nerr==1) { $val .= " +$val[$next],$val[$next+1]"; }
elsif($nerr==2) { $val .= " (DSYS=+$val[$next],$val[$next+1]"; }
else { $val .= ",DSYS=+$val[$next],$val[$next+1]"; }
$next += 2;
}
$nerr += 1;
}
if($nerr>2) { $val .= ")"; }
}
if($val =~ /^\s*([\w\.\+\-]+)\s+\+\-\s+(.+)$/ || $val =~ /^\s*([\w\.\s\+\-]+)\s+(\+[\w\.\s\+\-]+\s*,\s*\-[\w\.\s\+\-]+.+)$/){
$value=$1;
$rest=$2;
$nerr = 1+ ($rest =~ tr/=/=/);
if($rest =~ /(.*)\((.*)\)/){
$e[1] = $1;
$syst = $2;
if($e[1] =~ /(.*)\s*PCT/) {
$norm[1]="PCT";
$e[1] =~ s/\s*PCT\s*//g;
} else {
$norm[1]="ABS";
}
&trim($e[1]);
if($e[1] =~ /^\s*[\+]?($num_patt)\s*,\s*[-]?($num_patt)\s*$/) {$plus[1] = $1;$minus[1] = $2;}
elsif($e[1] =~ /^\s*[\+]?($num_patt)\s*,\s*[\+]?($num_patt)\s*$/) { $plus[1] = $1;$minus[1] = $2; }
elsif($e[1] =~ /^\s*[-]?($num_patt)\s*,\s*[-]?($num_patt)\s*$/) { $plus[1] = -$1;$minus[1] = $2; }
elsif($e[1] =~ /^\s*\+-($num_patt)\s*,\s*[-]?($num_patt)\s*$/) { $plus[1] = -$1;$minus[1] = $2; }
elsif($e[1] =~ /^\s*[-]?($num_patt)\s*,\s*[\+]?($num_patt$)\s*/) { $plus[1] = $2;$minus[1] = $1; }
else{$plus[1] = $e[1];$minus[1] = $e[1];}
# print " $plus[1] $minus[1]<br/>\n";
@dsys = split /,D/,$syst;
foreach $ds (0...$#dsys){
($type,$e[$ds+2]) = split /=/,$dsys[$ds];
if($e[$ds+2] =~ /(.*)\s*PCT/) {$e[$ds+2]=$1; $norm[$ds+2]="PCT";} else { $norm[$ds+2]="ABS";}
&trim($e[$ds+2]);
$e[$ds+2] =~ s/\s*PCT//;
if($e[$ds+2] =~ /^\s*[\+]?($num_patt)\s*,\s*[-]?($num_patt)\s*$/) { $plus[$ds+2] = $1;$minus[$ds+2] = $2; }
elsif($e[$ds+2] =~ /^\s*[\+]?($num_patt)\s*,\s*[\+]?($num_patt)\s*$/) { $plus[$ds+2] = $1;$minus[$ds+2] = $2; }
elsif($e[$ds+2] =~ /^\s*[-]?($num_patt)\s*,\s*[-]?($num_patt)\s*$/) { $plus[$ds+2] = -$1;$minus[$ds+2] = $2; }
elsif($e[$ds+2] =~ /^\s*\+-($num_patt)\s*,\s*[-]?($num_patt)\s*$/) { $plus[$ds+2] = -$1;$minus[$ds+2] = $2; }
elsif($e[$ds+2] =~ /^\s*[-]?($num_patt)\s*,\s*[\+]?($num_patt)\s*$/) { $plus[$ds+2] = -$1;$minus[$ds+2] = $2; }
else{$plus[$ds+2] = $e[$ds+2];$minus[$ds+2] = $e[$ds+2];}
if ($type =~ m/SYS/) {$source[$ds+2]='SYS'; $source[1]='STAT';}
elsif($type eq 'STAT') {$source[$ds+2]='STAT'; $source[1]='TOTAL';}
else {$source[$ds+2]='UNKNOWN'; $source[1]='UNKNOWN';}
}
}
else{
$e[1] = $rest;
if($e[1] =~ /(.*)\s*PCT/) {$e[1]=$1; $norm[1]="PCT";} else { $norm[1]="ABS";}
&trim($e[1]);
if($e[1] =~ /^\s*[\+-]?($num_patt)\s*,\s*[\+-]?($num_patt)\s*/) { $plus[1] = $1;$minus[1] = $2; }
else{$plus[1] = $e[1];$minus[1] = $e[1];}
$source[1]='UNKNOWN';
}
}
else{
$nerr=0;
if ( $val =~ /^\s*\>\=\s*(.+)$/ ){ $rel = 'GREATEREQUALS'; $value = $1;}
elsif( $val =~ /^\s*\>\s*(.+)$/ ){ $rel = 'GREATER'; $value = $1;}
elsif( $val =~ /^\s*\<\=\s*(.+)$/ ){ $rel = 'LESSEQUALS'; $value = $1;}
elsif( $val =~ /^\s*\<\s*(.+)$/ ){ $rel = 'LESS'; $value = $1;}
else{$value=$val; $rel='EQUALS'; $nerr=0;}
}
$comment = "";
if($value =~ m/\(CL=/){
($value,$comment) = split /\(CL=/,$value;
if($comment =~ m/\)$/){ chop $comment; }
}
&trim($value);
if(index($value,'.') > 0) {
$lenval = length($value) - index($value,'.') - 1;
} else {
$lenval=0;
}
&dbase0("insert into Points set _YAxis_AXIS_ID=$axisid,VALUE_ID=$valueid,LocalId=$j,Value=$value,ValueLength=$lenval,Relation='$rel'");
foreach $e (1...$nerr){
if($plus[$e] =~ m/^\s*\+/){ $plus[$e] = substr($plus[$e],1);}
if($minus[$e] =~ m/^\s*\-/){ $minus[$e] = substr($minus[$e],1);}
$query = "insert into PointErrors set VALUE_ID=$valueid,LocalId=$e";
if($plus[$e] =~ m/.\*$/) {
$len = index($plus[$e],"\*")-index($plus[$e],"\.")-1;
$query .= ",PlusErrorLength=$len";
chop $plus[$e];
}
$query .= ",PlusError=$plus[$e]";
if($minus[$e] =~ m/.\*$/) {
$len = index($minus[$e],"\*")-index($minus[$e],"\.")-1;
$query .= ",MinusErrorLength=$len";
chop $minus[$e];
}
$query .= ",MinusError=$minus[$e]";
$query .= ",Source='$source[$e]',Norm='$norm[$e]'";
if($comment ne "" || $comment != null){
$query .= ",Comment='$comment'";
} else {
$query .= ",Comment=''";
}
&dbase0($query);
}
if($nerr == 0 && $comment ne ""){
$xxx = "CL=$comment";
&dbase0("insert into PointErrors set VALUE_ID=$valueid,LocalId=$e,PlusError='0.0,MinusError='0.0,Source='UNKNOWN',Norm='ABS',Comment='$xxx'");
}
}
}
}
}
}
1;

File Metadata

Mime Type
text/x-perl
Expires
Sat, Dec 21, 4:11 PM (21 h, 16 m)
Storage Engine
blob
Storage Format
Raw Data
Storage Handle
4004703
Default Alt Text
subs.pl_save4 (36 KB)

Event Timeline