#!/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 ',"\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 = ) { $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',"\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!!! 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 - 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]; }