summaryrefslogtreecommitdiff
path: root/support/biblio/bibcheck.pl
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /support/biblio/bibcheck.pl
Initial commit
Diffstat (limited to 'support/biblio/bibcheck.pl')
-rwxr-xr-xsupport/biblio/bibcheck.pl380
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];
+}