diff options
Diffstat (limited to 'support/biblio/bibcheck.pl')
-rwxr-xr-x | support/biblio/bibcheck.pl | 380 |
1 files changed, 380 insertions, 0 deletions
diff --git a/support/biblio/bibcheck.pl b/support/biblio/bibcheck.pl new file mode 100755 index 0000000000..a6f962e745 --- /dev/null +++ b/support/biblio/bibcheck.pl @@ -0,0 +1,380 @@ +#!/usr/bin/perl +use strict; + + +my $BIBCHECK_VERSION = '1.0'; + +############################################# +# reserved names in the references file +my $reservedLABEL='LABEL'; +my $reservedTYPE ='TYPE' ; +my $reservedDBFILE = 'DBFILE'; +my $reservedLINE = 'LINE'; + + +my $reservedAUTHORL='AUTHORL'; +my $reservedAUTHORF='AUTHORF'; #??? po moemu uzhe ne nuzhen!!! ------------??????? +my $reservedAUTHOR ='AUTHOR'; #must be in the form '5;' - 5=five authors must be shown. +# ';'=1st author from the 2nd should be separated by ';' +my $reservedAND_SEPARATOR='|'; #what have to be put before the last author goes after this!!! + + +my $reservedCOMMENTSYMBOL = '%'; +my $SEPARATOR = "----------\n"; + +# +############################################## + +#my @REFS_FILES = ('refers1.db'); +my @REFS_FILES; + +my @ALLREFS; #Keeps all data about refs. Is array of hashes + #for example this piece of code + # + #foreach $item (@ALLREFS) + #{ + # print ${$item}{"AUTHOR"},"\n"; + #}; + # + #will print all ''AUTHOR'' fields + + +my $TOTALLINES = 0; +my $TOTALERRORS= 0; +#----------------------------------------- +#OPTIONS + +my $verbosity_level=1; # 5 is max + +my $option_do_not_exit_on_empty_label = 0; + +my $optionsEXITAFTERERRORS = 5; + # after this number of errors it will exit + # is set by the option "-e" + # "0" means "infinity" +#------------------------------------------- + +&read_inline_arguments; + + + +&check_for_important_arguments; + +if ($verbosity_level > 0) +{print "\nThis is bibcheck utility version $BIBCHECK_VERSION\n"; + print 'Author R.Stepanyan <rstepanyan@yahoo.com>',"\n\n"}; +print 'refs databases are <'; +foreach my $qq (@REFS_FILES) {print "$qq "}; +print ">.\n\n"; + + +my $REFS_FILE; +my $current_ref_number=0; +foreach $REFS_FILE (@REFS_FILES) +{ #print $REFS_FILE, "-------\n"; + &read_ref_datafile($REFS_FILE); # all data will be stored in @ALLREFS - array of hashes + if($verbosity_level > 4) + {print "read_ref_datafile <$REFS_FILE> done...\n";} +}; +if($verbosity_level > 4){print "\n";} + +&check_uniq_labels; + +if($verbosity_level > 0) +{ + print "Processed ",scalar(@ALLREFS)," records in $TOTALLINES lines of ",scalar(@REFS_FILES)," db-file(s).\n"; +} + +exit(0); +# +# +# +################################################################ +################################################################ +################################################################ +################################################################ +################################################################ +# +# +sub read_ref_datafile +#________________________________________________ +#reads references file. Data stored in @ALLREFS +#structure of the refs-file: +#LABEL=3dFlex +#TYPE=article +#AUTHORL=subbotin +#TITLE={Microphase separation within comb-like copolymer with attractive side-chains: computer simulations1.} +#JOURNAL= Macromol. Theory and Simul1. +#----------<10pieces> +# +#At the end should be Enter, so better to put EOF after it in the +#next line +# +{ my $line; + my @fields; my %CURRENT_RECORD; + + my $it_is_label=1; + + my $item; + my $REFS_FILE = @_[0]; + + my $line_number=0; # at which line of the current file we are at the moment + + open(RF, $REFS_FILE)|| die "Could not open $REFS_FILE: $!"; + while($line = <RF>) + { $line_number++; + $TOTALLINES++; + next if $line =~ /^\s*$/; # skip blank lines + next if (substr(trim($line),0,1) eq $reservedCOMMENTSYMBOL); + if($line ne $SEPARATOR) + { + $line=trim($line); + @fields = split(/=/, $line); + + @fields = trim(@fields); + + + if($fields[0] eq $reservedLABEL) + { # if this is label + if($CURRENT_RECORD{$fields[0]} ne '') #there is already a label + {print STDERR "Record at line $line_number at $REFS_FILE has multiple LABELs\n"; + &one_more_error; + } + + $CURRENT_RECORD{$fields[0]} = trim($fields[1]); + + if($CURRENT_RECORD{$fields[0]} eq '') + {print STDERR "Empty label at line $line_number at $REFS_FILE\n"; + unless($option_do_not_exit_on_empty_label){exit(1)}; # normally - exit after this error + &one_more_error; + } + + $CURRENT_RECORD{$reservedDBFILE} = $REFS_FILE; + $CURRENT_RECORD{$reservedLINE} = $line_number; + + + } + else + { + if($fields[0] eq $reservedTYPE) + { if($CURRENT_RECORD{$reservedTYPE} ne '') + {print STDERR "Record at line $line_number at $REFS_FILE has multiple TYPEs\n"; + &one_more_error; + } + $CURRENT_RECORD{$reservedTYPE}="$fields[1]" ; + } + + }; + + + } + else + { + if($CURRENT_RECORD{$reservedLABEL} eq '') + {print STDERR "Record has no LABEL above line $line_number at $REFS_FILE\n"; + unless($option_do_not_exit_on_empty_label){exit(1)}; # normally - exit after this error + &one_more_error; + } + + if($CURRENT_RECORD{$reservedTYPE} eq '') + {print STDERR "Record has no TYPE near line $line_number at $REFS_FILE\n"; &one_more_error; + } + + %{$ALLREFS[$current_ref_number]} = %CURRENT_RECORD; + + # Now erase everything from the hash!!! + my @allkeysfromhash = keys %CURRENT_RECORD; + foreach $item (@allkeysfromhash){delete($CURRENT_RECORD{$item})}; + + $current_ref_number++; #print "-------\n"; + + }; + }; + + close(RF); +}; + +#------------------------------------------------------- +sub check_uniq_labels +{ + +my $i=0; +my $j=0; + + + +for($i=0; $i<scalar(@ALLREFS)-1; $i++) +{ + # print ${$ALLREFS[$i]}{"$reservedLABEL"}, "\n"; #will print all labels + + for($j=$i+1; $j<scalar(@ALLREFS); $j++) + { + if(${$ALLREFS[$i]}{"$reservedLABEL"} eq ${$ALLREFS[$j]}{"$reservedLABEL"}) + { + print STDERR 'Label <',${$ALLREFS[$i]}{"$reservedLABEL"}; + print STDERR '>',"\n", ${$ALLREFS[$i]}{"$reservedLINE"}," --> "; + print STDERR ${$ALLREFS[$i]}{"$reservedDBFILE"}," and "; + print STDERR ${$ALLREFS[$j]}{"$reservedLINE"}," --> "; + print STDERR ${$ALLREFS[$j]}{"$reservedDBFILE"},"\n\n" ; + &one_more_error; + } + } + +} + +}; + +#------------------------------------------------------- + +######################################################### + + +sub read_inline_arguments +{my $DD='--'; my $D='-'; + my $counter=0; my $current=''; + my $guess; + +for($counter=0;$counter<scalar(@ARGV);$counter++) +{ + #print "$item \n"; + $current = $ARGV[$counter]; + +#------------------------------------------------------------ + #first check if it has '--' at the beginning + ($guess) = ($current =~/$DD([^ ]*)/); + if(($guess ne '')&&(substr($current,0,2) eq $DD)) + { + my $nothing=0; + SWITCH: { + if ($guess eq "help") {&print_help_info; exit(0);} + if ($guess eq "version"){&print_version_info; exit(0);} + + #options + if ($guess eq "noexit") + { $option_do_not_exit_on_empty_label=1; last SWITCH; } + if ($guess eq "errors") #number of errors to exit + { $counter++; $optionsEXITAFTERERRORS=$ARGV[$counter]; last SWITCH; } + + #reserved words + if ($guess eq 'separator') + { $counter++; $SEPARATOR=$ARGV[$counter]; last SWITCH; } + + $nothing = 1; + }; + if($nothing){print STDERR "Unknown option <$current>!!! Exiting!\n"; exit(1);} + else{next}; + }; + #------------------------------------------------------------------- + #second: check if it has '-' at the beginning + ($guess) = ($current =~/$D([^ ]*)/); + if(($guess ne '')&&(substr($current,0,1) eq $D)) + { + my $nothing=0; + SWITCH: { + #options + if ($guess eq "h") + { &print_help_info; exit(0)} + + if ($guess eq "d") + { my $itis=1; my $whatis=''; + while($itis) + { + $counter++; + unless($counter < scalar(@ARGV)){$counter--;last SWITCH;} + $whatis = $ARGV[$counter]; + if((substr($whatis,0,2) eq $DD)||(substr($whatis,0,1) eq $D)) + {$counter--; $itis=0;} + else{$REFS_FILES[$itis-1] = $whatis; $itis++}; + }; + if(scalar(@REFS_FILES)<1){print STDERR "Invalid format of -d option";} + last SWITCH; + } + if ($guess eq "v") + { $counter++; $verbosity_level=$ARGV[$counter]; last SWITCH; } + if ($guess eq "e") #number of errors to exit + { $counter++; $optionsEXITAFTERERRORS=$ARGV[$counter]; last SWITCH; } + #reserved words + #if ($guess eq 'etal') + # { $counter++; $reservedET_AL=$ARGV[$counter]; last SWITCH; } + $nothing = 1; + }; + if($nothing){print "Unknown option <$current>!!! Exiting!\n"; exit(1);} + else{next}; + }; + #--------------------------------------------------------------------- + #so, this is not switch + print STDERR "Unknown option <$current>!!! Exiting!\n"; exit(1); + +} + +}; + +#---------------------------------- +sub check_for_important_arguments +{ + + if(scalar(@REFS_FILES) == 0) + {print STDERR "You must select at least one refs dbase file with -d option!!!"; + print STDERR "Exiting!\n"; + exit(1) + }; + +}; +#----------------------------------- +sub print_version_info +{ +print "bibcheck utility v.$BIBCHECK_VERSION \n"; +print "Written by R.Stepanyan.\n\n"; +print "This is free software. There is NO warranty! \n"; +print "Redistribution of this software is covered by the terms of"; +print "the GNU General Public License.\n"; +print "For more information, please, contact rstepanyan\@yahoo.com\n"; +}; +#----------------------------------- +sub print_help_info +{ +print "This is bibcheck-utility from the Biblio package v.$BIBCHECK_VERSION \n"; +print "It checks your database file (references) for\n"; +print "the presence and consistency of LABELS\n"; +print "bibcheck [keys] -d dbasefile(s)\n"; +print "\n"; +print "-v <number> - verbosity level (0-5)\n"; +print "-h (--help) - this help\n"; +print "--noexit - don\'t exit but go on if an empty label is found\n"; +print "--separator - separator of the records in the DB-file\n"; +print "--version - version information\n"; +print "\n"; +print "About the other parameters see readme.1st \n"; +print "\n"; +#print "\n"; +}; + +#-------------------------------------------------------- +sub one_more_error +{ +if($optionsEXITAFTERERRORS > 0) +{ + if(++$TOTALERRORS >= $optionsEXITAFTERERRORS) + {print STDERR "Too many errors ($TOTALERRORS). Exiting!!!\n"; + exit(1); + }; +} +}; + + + + + + + + + +################################################################## +sub trim { + my @out = @_; + for (@out) { + s/^\s+//; + s/\s+$//; + } + return wantarray ? @out : $out[0]; +} |