path: root/support/biblio/bibcheck.pl

#!/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];
}