summaryrefslogtreecommitdiff
path: root/support/biblio/bibcheck.pl
blob: a6f962e7457845518a57c01dd59b04ce7a884637 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
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];
}