subs.pl
No OneTemporary
Actions

Size

37 KB

Subscribers

None

subs.pl
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 PointErrors where VALUE_ID=$list[0]");
	&dbase0("delete from Points 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.')\sTO\s('.$pmnum_patt.')$';
	$splitvalbin = '^('.$pmnum_patt.')\s$\sBIN\s=\s('.$pmnum_patt.')\sTO\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;
	# print "$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/^\cdsId:\s/){($dummy,$cds)=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"; }
	elsif ($ref[$nref]=~m/CONF/) { $type[$nref]="CONF"; }
	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];
	#print "$nds $dscomment[$nds]";
	}
	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($cds ne "" ) {&dbase0("update Papers set CdsId=$cds 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;
	if($dserr[$n][$err]=~m/,/){
	($dseplus,$dseminus)=split/,/,$dserr[$n][$err],2;
	if($dseplus=~m/\s*\+/) { $dseplus=~s/\+//; }
	if($dseminus=~m/\s*-/) { $dseminus=~s/-//; }
	}
	else{
	$dseplus=$dserr[$n][$err];
	$dseminus=$dserr[$n][$err];
	}
	$dsenorm="ABS";
	if($dseplus=~m/%\s$/) { $dseplus=~s/\s%//; $dsenorm="PCT"; }
	if($dseplus=~m/PCT\s$/) { $dseplus=~s/\s%//; $dsenorm="PCT"; }
	if($dseminus=~m/%\s$/) { $dseminus=~s/\s%//; $dsenorm="PCT"; }
	if($dseminus=~m/PCT\s$/) { $dseminus=~s/\s%//; $dsenorm="PCT"; }
	# print "inserting /$dsid/$dserr[$n][$err]/$posn/$dserrcom[$n][$err]/ in DatasetErrors<br>\n";
	&dbase0("insert into DatasetErrors set DATASET_ID=$dsid,PlusError='$dseplus',MinusError='$dseminus',Comment='$dserrcom[$n][$err]',Source='SYS',Norm='$dsenorm',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 = "";
	$width = "";
	$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$\sBIN\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';}
	elsif($bin[$n][$b][$j] =~ /^\s($pmnum_patt1)\s\+-\s($pmnum_patt1)\s$/){
	$focus=$1;
	$width=2*$2;
	$description=$bin[$n][$b][$j];
	print "$focus $width $description<br>\n";
	}
	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=$lenlow";
	}
	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'";
	}
	print "query:$query<br>\n";
	&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] =~ /^\sN\s\.?\s=\sYN/){}
	elsif($yqual[$n][$b][$q] =~ /^\sN\s\.?\s=\sRE/){
	$reacid++;
	@parts = split /;/,$yqual[$n][$b][$q];
	$re_extra="";
	if($parts[0] =~/^\sN\s\.?\s=\sRE(.)\s$/){ $re_extra=$1;}
	if($parts[1] =~/^\sV\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] =~ /^\sN\.?\s=(.)\s\;\sV\.?\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_patt1$/ \|\|$val[$nval]=~m/^$pmnum_patt2$/ \|\|$val[$nval]=~m/^$pmnum_patt3$/){} 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\|\|$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] =~ /(.)\sPCT/) {
	$norm[1]="PCT";
	$e[1] =~ s/\sPCT\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] =~ /(.)\sPCT/) {$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] =~ /(.)\sPCT/) {$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: Sun, Feb 23, 2:44 PM (22 h, 40 m)
Storage Engine: blob
Storage Format: Raw Data
Storage Handle: 4481475
Default Alt Text: subs.pl (37 KB)

subs.plNo OneTemporaryActions

subs.plView Options

File Metadata

Event Timeline

subs.pl
No OneTemporary
Actions

subs.pl
View Options