File Coverage

blib/lib/LaTeX/Authors.pm
Criterion Covered Total %
statement 250 988 25.3
branch 27 250 10.8
condition 5 141 3.5
subroutine 12 40 30.0
pod 21 36 58.3
total 315 1455 21.6


line stmt bran cond sub pod time code
1             ######################################################################
2             #
3             # LaTeX::Authors
4             #
5             ######################################################################
6             #
7             # LaTeX::Authors is free software; you can redistribute it and/or modify
8             # it under the terms of the GNU General Public License as published by
9             # the Free Software Foundation; either version 2 of the License, or
10             # (at your option) any later version.
11             #
12             # LaTeX::Authors is distributed in the hope that it will be useful,
13             # but WITHOUT ANY WARRANTY; without even the implied warranty of
14             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15             # GNU General Public License for more details.
16             #
17             # You should have received a copy of the GNU General Public License
18             # along with ParaTools; if not, write to the Free Software
19             # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20             #
21             #######################################################################
22             #
23             # LaTeX::Authors try to find the authors and laboratories in a LaTeX file
24             # and return the information with xml tags.
25             #
26             # Author: Christian Rossi
27             # CCSD/CNRS (rossi@in2p3.fr) and LORIA/INRIA Lorraine (rossi@loria.fr)
28             #
29             # Based on latex.pm by José João Almeida (jj@di.uminho.py)
30             # http://natura.di.uminho.pt/~jj/perl/
31             #
32             # 2003/03/10 : version 0.8
33             # 2005/03/29 : version 0.81 (correct documentation Latex to LaTeX)
34             #
35             ########################################################################
36              
37              
38             package LaTeX::Authors;
39              
40 1     1   8577 use strict;
  1         3  
  1         39  
41              
42 1     1   4 use vars qw($VERSION);
  1         2  
  1         34  
43 1     1   5 use Exporter ();
  1         4  
  1         57  
44              
45             our @ISA = qw(Exporter);
46              
47             our @EXPORT = qw(&un_archive &find_tex_file &load_file_string &router
48             &string_byauthors_xml &string_byauthors_html &author_to_lab
49             &string_bylabs_html &string_bylabs_xml &string_onlyauthors_xml &string_onlylabs_xml);
50              
51 1     1   1234 use Text::Balanced qw (extract_bracketed);
  1         25915  
  1         11407  
52              
53             our $VERSION = '0.81';
54              
55             =pod
56              
57             =head1 NAME
58              
59             LaTeX::Authors - Perl extension to extract authors and laboratories in a LaTeX file
60              
61             =head1 SYNOPSIS
62            
63              
64             Extraction from a string with latex commands:
65            
66             use LaTeX::Authors;
67             use strict;
68             my $tex_string = "\documentclass...";
69             my @article = router($tex_string);
70             my $string_xml = string_byauthors_xml(@article);
71             print $string_xml;
72            
73            
74             Extraction from a latex file:
75              
76             use LaTeX::Authors;
77             use strict;
78             my $file = shift;
79             my $tex_string = load_file_string($file);
80             my @article = router($tex_string);
81             my $string_xml = string_byauthors_xml(@article);
82             print $string_xml;
83            
84            
85             Extraction from a directory with latex files:
86            
87             use LaTeX::Authors;
88             use strict;
89             my $directory = shift;
90             #my $error= un_archive($directory);
91             my $file = find_tex_file($directory);
92             my $tex_string = load_file_string($file);
93             my @article = router($tex_string);
94             my $string_xml = string_byauthors_xml(@article);
95             print $string_xml;
96              
97            
98             =head1 DESCRIPTION
99            
100             LaTeX::Authors try to find the authors and laboratories in a LaTex file.
101             The output is an xml or html string. This is an example of the xml output:
102            
103            
104            
105             author1
106             lab1
107             lab2
108            
109            
110             ...
111            
112            
113              
114             The module try to found something like the \author and \affiliation latex command on the file.
115             With articles about physics try to found a collaboration name to work with more exotic way to show authors list.
116             It is especially design for article about physics where there is hundreds of authors.
117              
118             It can work on input with:
119             - an archiv file (tar, zip...), it's useful for arXiv file (function un_archiv)
120             - a directory with latex file (function find_tex_file)
121             - a latex file (function load_file_string)
122             - a string (function router)
123              
124             For the output it can produce:
125             - an xml string
126             - by author: author1 lab1 lab2 (string _byauthors_xml)
127             - by laboratory: lab1 author1 author2 (string_bylabs_xml)
128             - an html string
129             - by author (string_byauthors_html)
130             - by lab (string_bylabs_html)
131            
132            
133             =cut
134              
135             ###################################################
136              
137             =head1 FUNCTION
138              
139             =head2 C - uncompress, untar or unzip file in a directory
140              
141             Take the archive file and uncompress (useful for arXiv files)
142            
143             my $error = un_archive($directory);
144            
145             =cut
146              
147            
148             sub un_archive
149             {
150 0     0 1 0 my ($directory) = @_;
151 0         0 my $filename;
152             my @listfile;
153 0         0 my $error ="";
154            
155 0 0       0 if (!(chdir($directory))) {
156 0         0 $error = "dir";
157 0         0 return $error;
158             }
159              
160 0         0 @listfile = <*.uu>;
161 0         0 foreach $filename (@listfile) {
162 0         0 my $code = system("/bin/csh $filename >/dev/null 2>&1");
163 0 0       0 $error = "uu " if ($code);
164             }
165 0         0 foreach $filename (@listfile) {
166 0         0 unlink($filename);
167             }
168              
169 0         0 @listfile = <*.tar.gz>;
170 0         0 foreach $filename (@listfile) {
171 0         0 my $code = system("gzip -cd $filename | tar x >/dev/null 2>&1");
172 0 0       0 $error .= "tar.gz " if ($code);
173             }
174 0         0 foreach $filename (@listfile) {
175 0         0 unlink($filename);
176             }
177              
178 0         0 @listfile = <*.tgz>;
179 0         0 foreach $filename (@listfile) {
180 0         0 my $code = system("gzip -cd $filename | tar x >/dev/null 2>&1");
181 0 0       0 $error .= "tgz " if ($code);
182             }
183 0         0 foreach $filename (@listfile) {
184 0         0 unlink($filename);
185             }
186              
187 0         0 @listfile = <*.tar>;
188 0         0 foreach $filename (@listfile) {
189 0         0 my $code = system("tar xf $filename >/dev/null 2>&1");
190 0 0       0 $error .= "tar " if ($code);
191             }
192 0         0 foreach $filename (@listfile) {
193 0         0 unlink($filename) ;
194             }
195              
196 0         0 @listfile = <*.gz>;
197 0         0 foreach $filename (@listfile) {
198 0         0 my $code = system("gzip -d $filename");
199 0 0       0 $error .= "gz " if ($code);
200             }
201 0         0 foreach $filename (@listfile) {
202 0         0 unlink($filename) ;
203             }
204              
205 0         0 @listfile = <*.zip>;
206 0         0 foreach $filename (@listfile) {
207 0         0 my $code = system("unzip $filename");
208 0 0       0 $error .= "zip " if ($code);
209             }
210 0         0 foreach $filename (@listfile) {
211 0         0 unlink($filename);
212             }
213              
214 0         0 return $error;
215             }
216              
217              
218             ###################################################
219              
220              
221             =head2 C - Try to find the main tex file on a directory with multiple files
222              
223             my $texfile = find_tex_file($directory);
224              
225             =cut
226            
227             sub find_tex_file
228             {
229 0     0 1 0 my $directory = $_[0];
230              
231 0 0       0 if ($directory eq "") {
232             # Error: No working directory.
233 0         0 return "";
234             }
235 0 0       0 if (!(-d $directory)) {
236             # Error: Working directory doesn't exist.
237 0         0 return "";
238             }
239              
240 0 0       0 if (!(chdir($directory))) {
241             # Error: Can't cd to source directory.
242 0         0 return "";
243             }
244              
245 0         0 my @list_file_dir = <*.tex>;
246 0         0 my @list_file_sdir = <*/*.tex>;
247 0         0 my @list_file = (@list_file_dir,@list_file_sdir);
248 0         0 my $nbr_file = @list_file;
249            
250 0         0 my $tex_file;
251            
252 0 0       0 if ($nbr_file == 1) {
    0          
253 0         0 $tex_file = $list_file[0];
254             } elsif ($nbr_file > 1) {
255 0         0 foreach (@list_file) {
256 0         0 open(FILEGREP,"$_");
257 0         0 my $tempo_file = $_;
258 0         0 while () {
259 0         0 s/(^\s*|[^\\])%.*/$1/g;
260 0         0 s/^\s*\n$//g;
261 0 0 0     0 if ((/\\begin\{document\}/) || (/\\bye/) || (/\\documentstyle/) ) {
      0        
262 0         0 $tex_file = $tempo_file;
263 0         0 last;
264             }
265             }
266              
267             }
268             } else {
269            
270 0         0 my @list_file_dir = <*>;
271 0         0 my @list_file_sdir = <*/*>;
272 0         0 my @list_file = (@list_file_dir,@list_file_sdir);
273            
274 0         0 foreach (@list_file) {
275 0         0 open(FILEGREP,"$_");
276 0         0 my $tempo_file = $_;
277            
278 0         0 while () {
279 0         0 s/(^\s*|[^\\])%.*/$1/g;
280 0         0 s/^\s*\n$//g;
281            
282 0 0 0     0 if ((/\\begin\{document\}/) || (/\\bye/) || (/\\documentstyle/)) {
      0        
283 0         0 $tex_file = $tempo_file;
284 0         0 last;
285             }
286             }
287             }
288             }
289              
290 0         0 return $tex_file;
291              
292             }
293              
294              
295             ###################################################
296              
297              
298             =head2 C - Load a file and put the content to a string
299              
300             my $string = load_file_string($file);
301              
302             Also delete the latex comments (%...).
303              
304             =cut
305              
306             sub load_file_string
307             {
308 1     1 1 138 my $file = $_[0];
309 1         2 my $string;
310 1 50       39 open(TEXFILE,$file) or die "Error: can't open $file\n";
311 1         21 while () {
312 29         35 s/(^\s*|[^\\])%.*/$1/g;
313 29         81 s/^\s*\n$//g;
314 29         80 $string .= $_;
315             }
316 1         5 return $string;
317             }
318              
319              
320             ###################################################
321              
322              
323             =head2 C - Try to qelect the good function to extract the authors and laboratories and return an array
324             with the authors and the laboratories in the latex file.
325              
326             @article = router($string);
327              
328             =cut
329              
330             sub router
331             {
332 1     1 1 6 my $string= $_[0];
333 1         2 my ($aut,$aff,$add,$addeq,$ins,$and,$math_in_add,$math_in_aut,$altaff,$input_file,$report_fermilab);
334 0         0 my ($string_aut,$string_lab);
335 1         3 $string_aut = ""; $string_lab= "";
  1         2  
336 1         12 my @tab_chaine = split(/\n/,$string);
337 1         3 my @input;my @include;
338 1         3 foreach (@tab_chaine) {
339 17 100       34 if (/\\author/) {
340 1         2 $aut = 1; $string_aut = "author";
  1         2  
341             }
342            
343 17 50       32 if (/\\affiliation/) {
344 0         0 $aff = 1; $string_lab = "affiliation";
  0         0  
345             }
346             # aastex
347 17 50       31 if (/\\affil\{/) {
348 0         0 $aff = 1; $string_lab = "affil";
  0         0  
349             }
350 17 50       30 if (/\\address/) {
351 0         0 $add = 1 ; $string_lab = "address";
  0         0  
352             }
353              
354 17 50       30 if (/\\address\{(\s*(\\\w+ )+|\s*)\$\^/) {
355 0         0 $add= 1; $string_lab = "address"; $math_in_add = 1;
  0         0  
  0         0  
356             }
357 17 50       31 if (/address=/) {
358 0         0 $addeq = 1 ; $string_lab = "address";
  0         0  
359             }
360 17 50       34 if (/\\institute/) {
361 0         0 $ins = 1; $string_lab = "institute";
  0         0  
362             }
363 17 50       30 if (/\\altaffilmark/) {
364 0         0 $altaff = 1;
365             }
366             # na59
367             #if ((/\\input/) && ($chaine1 eq "") && ($chaine2 eq "")) {
368 17 50       29 if (/\\input/) {
369 0         0 my $sed_string = $string;
370             # delete space \input xyz -> \input{xyz}
371 0 0       0 $sed_string =~ s/\\input\s+([\.\/\w]+)/\\input\{$1\}/g if (@input == 0);
372 0 0       0 @input = greplatexcom("input",["t"],$sed_string) if (@input == 0);
373              
374             # my $input_file = $input[0]->{t}; bichop($input_file);
375             # L3 : \input toto.tex
376             # if ($input_file eq "") {
377             # space
378             # /\\input\s+(.*)/; $input_file = $1;
379             # }
380             # $input_file .= ".tex" if ((! -f $input_file) && ($input_file ne ""));
381              
382             #my $chaine_l = load_file_string($input_file);
383             #my @out = router($chaine_l);
384             #if (@out > 0) {return @out;}
385             }
386 17 50       33 if (/\\include/) {
387 0 0       0 @include = greplatexcom("include",["t"],$string) if (@include == 0);
388             }
389 17 50       34 if (/report.*Fermilab/) {
390 0         0 $report_fermilab = 1;
391             }
392             }
393              
394 1         6 my $coll_name = found_collaboration($string);
395              
396 1         3 $coll_name =~ tr/A-Z/a-z/;
397              
398             #print "aut=$aut aff=$aff add=$add addeq=$addeq ins=$ins coll = $coll_name ";
399              
400             #$coll_name ="H1";
401              
402 1         9 my @aut = greplatexcom("author",[["arg"],"t"],$string);
403              
404 1 50       7 if (bichop($aut[0]->{t}) =~ /\\and/) {
405 0         0 $and = 1;
406             }
407 1 50       4 if (bichop($aut[0]->{t}) =~ /\$\^/) {
408 0         0 $math_in_aut = 1;
409             }
410              
411             #print bichop($aut[0]->{t});
412              
413 1         6 my @addr= greplatexcom("address",[["arg"],"t"],bichop($aut[0]->{t}));
414            
415             # print "1= $addr[0]->{t} \n";
416 1         2 my $imbri;
417              
418 1 50 33     6 $imbri= 1 if ((defined $addr[0]->{t}) && ($addr[0]->{t} ne ""));
419            
420             #print "imbri = $imbri and= $and input = ". @input ." include = ". @include. "\n";
421             #print "math_in_aut = $math_in_aut math_in_add = $math_in_add
\n";
422              
423 1         1 my @doc;
424              
425 1 50 33     15 if (($string_aut ne "") && ($string_lab eq "") && ($coll_name ne "l3")) {
    0 33        
    0 0        
    0 0        
    0 0        
426 1 50       5 if ($math_in_aut) {
    50          
427 0         0 @doc = grepaut_math("$string_aut",$string);
428             } elsif ($altaff) {
429 0         0 @doc = grep_aut_altaff($string);
430             } else {
431 1         6 @doc = grepaut("$string_aut",$string);
432             }
433            
434             } elsif (($string_aut ne "") && ($string_lab ne "") && ($coll_name ne "zeus")) {
435 0 0 0     0 if ($imbri == 1) {
    0          
    0          
436 0         0 @doc= grepautadd("$string_aut","$string_lab",$string);
437             } elsif ($addeq == 1) {
438 0         0 @doc= grepautadd_eq("$string_aut","$string_lab",$string);
439             } elsif (($math_in_aut == 1) && ($math_in_add == 1)) {
440 0         0 @doc= grepautadd_math("$string_aut","$string_lab",$string);
441              
442             } else {
443 0         0 @doc= grepautaff("$string_aut","$string_lab",$string);
444             }
445             } elsif ($coll_name ne "") {
446             #my $function = "grep_article_" . $coll_name;
447             #print "$function\n";
448 0 0       0 if (@input != 0) {
449 0         0 foreach my $input_t (@input) {
450 0         0 $input_file = $input_t->{t}; bichop($input_file);
  0         0  
451             # L3 : \input toto.tex
452             # if ($input_file eq "") {
453             # # space
454             # /\\input\s+(.*)/; $input_file = $1;
455             #
456 0 0 0     0 $input_file .= ".tex" if ((! -f $input_file) && ($input_file ne ""));
457 0         0 my $string_input = load_file_string($input_file);
458             #print "
f1=$input_file ";
459             # @doc = router($string_l);
460 0         0 @doc = func_by_coll($string_input,$coll_name);
461 0 0       0 last if (@doc > 0);
462             }
463            
464             }
465 0 0       0 @doc = func_by_coll($string,$coll_name) if (@doc == 0);
466             } elsif ($report_fermilab == 1) {
467 0         0 @doc = extract_report_fermilab($string);
468             } elsif ((@input != 0) || (@include != 0)){
469 0         0 my @infile = (@input,@include);
470 0         0 foreach my $input_t (@infile) {
471 0         0 $input_file = $input_t->{t}; bichop($input_file);
  0         0  
472             # L3 : \input toto.tex
473             # if ($input_file eq "") {
474             # space
475             # /\\input\s+(.*)/; $input_file = $1;
476             # }
477 0 0 0     0 $input_file .= ".tex" if ((! -f $input_file) && ($input_file ne ""));
478             #print "
f2=$input_file ";
479 0         0 my $string_l = load_file_string($input_file);
480 0         0 @doc = router($string_l);
481 0 0       0 last if (@doc > 0);
482             }
483             }
484 1         9 return(@doc);
485             }
486              
487              
488             ##################################################
489             #
490             # Tools functions
491             #
492             # Useful if you want to complete the module
493             # with others author/lab pattern
494             #
495             #################################################
496              
497              
498             =head2 C - Try to found a collaboration name
499              
500             Useful for physics articles whrere there often a collaboration name. The authors list format can be found with the collaboration name. Used by the router function.
501              
502             =cut
503              
504             sub found_collaboration
505             {
506 1     1 1 2 my $string = $_[0];
507 1         33 my (@tex_line) = split(/\n/,$string);
508 1         3 foreach (@tex_line) {
509 17 50 33     610 last if ((/thebibliogeraphie/) || (/\\bibitem/));
510 17         81 /(?:\s+|{\s*)([^\s]+)\s+collaboration/i;
511 17         19 my $collaboration = "";
512 17 50 33     38 $collaboration = $1 if ((defined $1) && ($1 ne ""));
513 17 50       44 if ($collaboration ne "") {
514             # for: (name collaboration) -> return name and not (name
515 0         0 $collaboration =~ s/^\(//;
516             # \name\ -> name
517 0         0 $collaboration =~ s/\\//g;
518 0         0 return $collaboration;
519             }
520             }
521             }
522            
523              
524             ##################################################
525              
526              
527             =head2 C - Delete tex comment (%) on a string
528              
529             my $string_out = delete_comment($string_in);
530              
531             =cut
532              
533             sub delete_comment
534             {
535 0     0 1 0 my $string = $_[0];
536 0         0 $string =~ s/(^\s*|[^\\])%.*/$1/g;
537 0         0 $string =~ s/^\s*\n$//g;
538 0         0 return $string;
539             }
540              
541              
542             ##################################################
543              
544              
545             =head2 C - Double end chop
546              
547             With
548              
549             my $string_in = bichop("{aaa}")
550              
551             in $string_in there is:
552              
553             "aaa"
554              
555             =cut
556              
557             sub bichop
558             {
559 4     4 1 21 chop $_[0];
560 4         9 substr($_[0],0,1)="";
561 4         17 $_[0];
562             }
563              
564              
565             ##################################################
566              
567              
568             =head2 C - To get all the ocurrences of a latex command
569              
570             @l_section = greplatexcom("section",["title"],$string);
571             for $s (@l_section) {print $s->{title} };
572              
573             Optional arguments can be described with "[name]". See this example:
574              
575             @class = greplatexcom("documentclass",[["args"],"class"],$string);
576             print $class[0]->{class} ;
577              
578             With \documentclass[xyz]{abc}
579              
580             $class[0]->{args} = xyz
581             $class[0]->{class} = abc
582              
583             =cut
584              
585             sub greplatexcom
586             {
587 2     2 1 5 my ($name,$listofargnames,$string) = @_ ;
588 2         4 my @rf=();
589 2         40 my ($begin, @list) = split(/\\$name\b/,$string);
590 2         6 foreach (@list) {
591 1         2 chomp;
592 1         3 my %r = ();
593            
594             ###STRICT
595 1         1 my $n;
596             ###
597 1         2 for $n (@$listofargnames) {
598 2 100       10 if (ref($n) eq "ARRAY") {
599 1         6 ($r{$n->[0]},$_) = extract_bracketed($_,"[");
600 1 50       116 delete $r{$n->[0]} unless (defined $r{$n->[0]});
601             } else {
602 1         3 ($r{$n},$_) = extract_bracketed($_,"{");
603             }
604             }
605 1         496 push(@rf,\%r);
606             }
607 2         8 return @rf;
608             }
609              
610              
611             ###################################################
612              
613              
614             =head2 C - To get a latex environment contents
615              
616             $abstract_string = theenv("abstract",$string);
617              
618             C returns the contents of the environment "abstract".
619              
620             For example if:
621              
622             $string ="\begin{abstract}
623             xyz...
624             \end{abstract}";
625              
626             after theenv in $abstract_string there is the string:
627              
628             xyz...
629              
630             =cut
631              
632             sub theenv
633             {
634 0     0 1 0 my($a,$b) = @_;
635 0         0 my @r = greplatexenv($a,[],$b);
636 0         0 return $r[0]->{'env'};
637             }
638              
639              
640             ###################################################
641              
642              
643             =head2 C - To get all the latex environments contents
644              
645             @array = theenvs("sloppypar",$string);
646              
647             C returns the contents of all the environment "sloopypar".
648              
649             =cut
650              
651             sub theenvs
652             {
653 0     0 1 0 my($a,$b)= @_;
654 0         0 my @string;
655 0         0 my @r=greplatexenv($a,[],$b);
656 0         0 foreach my $env (@r) {
657             # $r[0]->{'env'};
658 0         0 push(@string,$env->{'env'});
659             }
660 0         0 return(@string);
661             }
662              
663              
664             ###################################################
665              
666              
667             =head2 C - To get all ocurrences of a latex environment
668              
669             @a = greplatexenv("letter",["to"],$string) ;
670              
671             C returns a list of all the ocurrences of environment "letter",
672             reading its first argument to the "to" field and saving its content in the
673             "env" field;
674              
675             =cut
676              
677             sub greplatexenv
678             {
679 0     0 1 0 my ($name,$listofargnames,$string) = @_ ;
680 0         0 my @rf=();
681 0         0 my ($begin, @list) = split(/\\begin{$name}/,$string);
682 0         0 foreach (@list) {
683 0         0 chomp;
684 0 0       0 if (/\\end{$name}/) {
685 0         0 $_=$`;
686             } else {
687 0         0 next;
688             }
689 0         0 my %r = ();
690             ###STRICT
691 0         0 my $n;
692             ###
693 0         0 for $n (@$listofargnames) {
694 0 0       0 if (ref($n) eq "ARRAY") {
695 0         0 ($r{$n->[0]},$_) = extract_bracketed($_,"[");
696 0 0       0 delete $r{$n->[0]} unless (defined $r{$n->[0]});
697             } else {
698 0         0 ($r{$n},$_) = extract_bracketed($_,"{");
699             }
700             }
701 0         0 $r{'env'} = $_;
702 0         0 push(@rf,\%r);
703             }
704 0         0 return @rf;
705             }
706              
707              
708             ###################################################
709              
710              
711             =head2 C - Return a hash with all the "newcommand" occurrences
712              
713             %listnewcom = newcommand($string);
714              
715             If you have
716              
717             $string="\newcommand[xyz]{abc}";
718              
719             so after newcommand:
720              
721             $listnewcom{xyz} = "abc";
722              
723             =cut
724            
725             sub newcommand
726             {
727 0     0 1 0 my $string = $_[0];
728 0         0 my %listnewcom;
729 0         0 my @newcom= greplatexcom("newcommand",["args","val"],$string);
730              
731 0         0 for my $s (@newcom) {
732 0         0 $s->{args} = bichop($s->{args});
733 0         0 $listnewcom{$s->{args}} = bichop($s->{val});
734             }
735 0         0 return %listnewcom;
736             }
737              
738              
739             ###################################################
740              
741              
742             =head2 C - Return a hash with all the command occurences
743              
744             For example with:
745              
746             my $command_name = "command";
747             %list = list_index($command_name,$string);
748              
749             \command[index]{xyz...} -> $list{index} = "xyz...";
750              
751             Generalize the function newcommand with any command.
752              
753             =cut
754              
755             sub list_index
756             {
757 0     0 1 0 my ($command,$string) = @_;
758 0         0 my %listnewcom;
759              
760 0         0 my @newcom = greplatexcom($command,[["args"],"val"],$string);
761              
762 0         0 for my $s (@newcom) {
763              
764 0         0 $s->{args} = bichop($s->{args});
765              
766 0         0 $s->{args} =~ s/^\s*//g;
767 0         0 $s->{args} =~ s/\s*$//g;
768            
769 0         0 $s->{val} =~ s/^\s*//g;
770 0         0 $s->{val} =~ s/\s*$//g;
771            
772 0         0 $listnewcom{$s->{args}} = bichop($s->{val});
773             }
774 0         0 return %listnewcom;
775             }
776            
777              
778             ###################################################
779              
780              
781             =head2 C - Transform the latex caracters with accent to standard caracters
782              
783             my $string_out = accent($string_in);
784            
785             =cut
786              
787             sub accent
788             {
789 2     2 1 4 ($_) = @_;
790              
791 2         4 s/{\\`a}/à/g;
792 2         4 s/{\\'a}/á/g;
793 2         3 s/{\\^a}/â/g ;
794 2         4 s/{\\"a}/ä/g;
795 2         3 s/{\\\*a}/å/g;
796 2         4 s/{\\ae}/æ/g;
797              
798 2         3 s/{\\`A}/À/g;
799 2         3 s/{\\'A}/Á/g;
800 2         3 s/{\\"A}/Ä/g;
801 2         3 s/{\\\*A}/Å/g;
802 2         2 s/{\\~A}/Ã/g;
803 2         3 s/{\\AE}/Æ/g;
804              
805 2         3 s/\\`{\\?a}/à/g ;
806 2         3 s/\\'{\\?a}/á/g ;
807 2         4 s/\\^{\\?a}/â/g ;
808 2         3 s/\\"{\\?a}/ä/g ;
809 2         3 s/\\\*{\\?a}/å/g ;
810 2         2 s/\\{ae}/æ/g ;
811              
812 2         4 s/\\`a/à/g ;
813 2         3 s/\\'a/á/g ;
814 2         13 s/\\^a/â/g ;
815 2         3 s/\\"a/ä/g ;
816 2         4 s/\\\*a/å/g ;
817 2         3 s/\\ae/æ/g ;
818 2         4 s/\\~a/ã/g ;
819              
820 2         3 s/\\`A/À/g ;
821 2         3 s/\\'A/Á/g ;
822 2         2 s/\\"A/Ä/g ;
823 2         3 s/\\\*A/Å/g ;
824 2         3 s/\\~A/Ã/g;
825 2         4 s/\\AE/Æ/g;
826              
827 2         2 s/\\c{c}/ç/g ;
828 2         3 s/\\c{C}/Ç/g ;
829              
830             # s/{\\,c}/ç/g ;
831             # s/{\\,C}/Ç/g ;
832             # s/\\,c/ç/g ;
833             # s/\\,C/Ç/g ;
834              
835 2         3 s/{\\'e}/é/g ;
836 2         3 s/{\\`e}/è/g ;
837 2         2 s/{\\^e}/ê/g ;
838 2         10 s/{\\"e}/ë/g ;
839              
840 2         7 s/\\'e/é/g ;
841 2         3 s/\\`e/è/g ;
842 2         9 s/\\^e/ê/g ;
843              
844 2         4 s/\\'{\\?e}/é/g ;
845 2         2 s/\\`{\\?e}/è/g ;
846 2         4 s/\\"{\\?e}/ë/g ;
847            
848 2         4 s/{\\'E}/É/g ;
849 2         3 s/{\\"E}/Ë/g ;
850              
851 2         3 s/\\'E/É/g ;
852 2         5 s/\\"E/Ë/g ;
853              
854 2         3 s/{\\^i}/î/g ;
855 2         3 s/{\\'i}/í/g ;
856 2         2 s/{\\"I}/Ï/g ;
857 2         3 s/{\\'I}/Í/g ;
858              
859 2         5 s/\\'\\?i ?/í/g ;
860 2         3 s/{?\\'{\\?i}}?/í/g ;
861              
862 2         3 s/\\^i/î/g ;
863 2         2 s/\\"I/Ï/g ;
864 2         3 s/\\'I/Í/g ;
865              
866 2         4 s/{\\'O}/Ó/g;
867              
868 2         2 s/{\\"O}/Ö/g;
869 2         4 s/\\"{O}/Ö/g;
870            
871 2         3 s/{\\'o}/ó/g;
872 2         2 s/{\\^o}/ô/g ;
873 2         4 s/{\\"o}/ö/g ;
874 2         3 s/{\\`o}/ò/g ;
875 2         4 s/{\\~o}/õ/g ;
876              
877 2         2 s/\\^o/ô/g ;
878 2         3 s/\\"o/ö/g ;
879 2         3 s/\\`o/ò/g ;
880 2         3 s/\\~o/õ/g ;
881              
882 2         3 s/\\'o/ó/g;
883 2         4 s/\\'O/Ó/g;
884 2         3 s/\\"O/Ö/g;
885            
886 2         2 s/\\`{\\?o}/ò/g ;
887              
888 2         3 s/{\\~n}/ñ/g ;
889            
890 2         3 s/\\~n/ñ/g ;
891              
892 2         4 s/{\\`u}/ù/g ;
893 2         2 s/{\\^u}/û/g ;
894 2         3 s/{\\^u}/û/g ;
895 2         4 s/{\\"u}/ü/g ;
896              
897 2         8 s/\\`u/ù/g ;
898 2         3 s/\\^u/û/g ;
899 2         3 s/\\^u/û/g ;
900 2         3 s/\\"u/ü/g ;
901            
902 2         3 s/\\"{\\?u}/ü/g ;
903              
904 2         2 s/{\\'y}/ý/g ;
905 2         3 s/{\\'Y}/Ý/g ;
906            
907 2         38 s/\\'y/ý/g ;
908 2         5 s/\\'Y/Ý/g;
909            
910 2         3 s/\\.{I}/İ/g;
911 2         2 s/\\c{S}/Ş/g;
912 2         3 s/\\c{s}/ş/g;
913 2         2 s/\\v{c}/č/g;
914            
915 2         3 s/\\'c/ć/g;
916 2         3 s/\\'C/Ć/g;
917            
918 2         2 s/\\v c/č/g;
919            
920 2         4 s/\\v{C}/Č/g;
921 2         2 s/\\v{S}/Š/g;
922 2         3 s/\\v{s}/š/g;
923 2         3 s/\\v{Z}/Ž/g;
924 2         3 s/\\v Z/Ž/g;
925            
926 2         2 s/\\v{z}/ž/g;
927 2         2 s/\\v z/ž/g;
928            
929 2         3 s/\\.Z/Ż/g;
930 2         4 s/\\.z/ż/g;
931            
932 2         3 s/\\'{N}/Ń/g;
933            
934 2         3 s/\\L /Ł/g;
935 2         9 s/\\l /ł/g;
936 2         3 s/{\\l}/ł/g;
937            
938 2         3 s/\\'{N}/Ń/g;
939 2         3 s/\\'{n}/ń/g;
940            
941 2         4 s/\\'N/ń/g;
942 2         3 s/\\'n/ń/g;
943            
944 2         3 s/{\\ss}/ß/g;
945              
946             # delete tex command
947             # \{\xyz text\} -> text
948 2         3 s/\{\\\w+ ([^\}]*)\}/$1/g;
949              
950             # \xyz{text} -> ""
951 2         2 s/\\\w+\{[^\}]+\}//g;
952            
953             # \xyz text -> text
954 2         5 s/\\\w+ / /g;
955            
956             # space and ,
957 2         20 s/[\n\t\s]+/ /g;
958 2         7 s/^\s*//g;
959 2         21 s/\s*$//g;
960              
961 2         3 s/~/ /g ;
962 2         3 s/\\\\/,/g ;
963              
964 2         3 s/\\ / /g ;
965              
966 2         2 s/on leave from//g;
967 2         10 s/Also with //g;
968 2         3 s/Also at //g;
969             # ,, -> ,
970 2         11 s/,+/,/g ;
971              
972             # , , -> ,
973 2         21 s/,\s*,/,/g ;
974            
975 2         4 s/^, and / /g;
976 2         4 s/^,\s*//g;
977 2         4 s/^and\s//g;
978            
979             # IN^2P^3 -> IN2P3
980 2         3 s/IN\$\^\{2\}\$P\$\^\{3\}\$/IN2P3/g;
981              
982 2         3 s/\\&/and/g;
983            
984             # s/[\n\t\s]+/ /g;
985              
986             # , at the begin and at the end
987 2         5 s/^\s*,\s*//g;
988 2         9 s/\s*,\s*$//g;
989              
990             # space begin end
991 2         8 s/^\s*//g;
992 2         21 s/\s*$//g;
993              
994 2         8 return $_;
995              
996             }
997            
998              
999             ######################################################################
1000             #
1001             # output function
1002             #
1003             #####################################################################
1004              
1005              
1006             =head2 C - Retrun a string with xml tags all the authors and lab found in an article
1007            
1008             my $string = string_byauthors_xml(@article);
1009              
1010            
1011            
1012             author1
1013             lab1
1014             lab2
1015            
1016            
1017             ...
1018            
1019            
1020              
1021             =cut
1022              
1023             ##
1024             #
1025             # @article in an array with ($ref_item1, $ref_item2,...)
1026             #
1027             # @$item is an array with (author, lab1, lab2,...)
1028             #
1029             ##
1030              
1031             sub string_byauthors_xml
1032             {
1033 1     1 1 7 my (@article) = @_;
1034 1         2 my $string;
1035 1 50       4 $string = "
\n" if (@article > 0);
1036 1         2 foreach my $item (@article) {
1037 1         3 $string .= " \n";
1038 1         3 my ($author,@labo) = @$item;
1039 1         4 $string .= " " . accent($author) . "\n";
1040 1         3 foreach my $lab (@labo) {
1041 1         3 $string .= " " . accent($lab) . "\n";
1042             }
1043 1         3 $string .= " \n";
1044             }
1045 1 50       5 $string .= "\n" if (@article > 0);
1046 1         4 return $string;
1047             }
1048              
1049             #######################################################################
1050              
1051             =head2 C - Retrun a string with xml tags all the authors found in an article
1052            
1053             my $string = string_onlyauthors_xml(@article);
1054            
1055            
1056             author1
1057             author2
1058             ...
1059            
1060              
1061             =cut
1062              
1063             sub string_onlyauthors_xml
1064             {
1065 0     0 1 0 my (@article) = @_;
1066 0         0 my $string;
1067 0 0       0 $string = "
\n" if (@article > 0);
1068 0         0 foreach my $item (@article) {
1069 0         0 my ($author,@labo) = @$item;
1070 0         0 $string .= " " . accent($author) . "\n";
1071             }
1072 0 0       0 $string .= "\n" if (@article > 0);
1073 0         0 return $string;
1074             }
1075              
1076              
1077             #######################################################################
1078              
1079              
1080             =head2 C - Convert the author array to a lab array
1081              
1082             my @array_lab = author_to_lab(@array_author);
1083              
1084             (author1, lab1, lab2)(author2, lab1, lab3) -> (lab1,author1,author2)(lab2,author1)(lab3,author2)
1085            
1086             =cut
1087              
1088             sub author_to_lab
1089             {
1090 0     0 1 0 my (@article) = @_;
1091 0         0 my %author;
1092             my @article_lab;
1093              
1094 0         0 foreach my $item (@article) {
1095 0         0 my ($author,@labo) = @$item;
1096 0         0 foreach my $lab (@labo) {
1097 0         0 my @lab_authors;
1098             # for the sort
1099 0         0 $lab = accent($lab);
1100 0 0       0 @lab_authors = @{$author{$lab}} if defined($author{$lab});
  0         0  
1101 0         0 push( @lab_authors,$author);
1102 0         0 $author{$lab} = \@lab_authors;
1103             }
1104             }
1105 0         0 foreach my $lab (sort keys %author) {
1106 0         0 unshift(@{$author{$lab}}, $lab);
  0         0  
1107 0         0 push( @article_lab, $author{$lab});
1108             }
1109 0         0 return @article_lab;
1110             }
1111              
1112              
1113             ############################################################
1114              
1115              
1116             =head2 C - Return a string with xml tags all the lab and authors found in an article
1117            
1118             my $xml_string = string_bylabs_xml(@article);
1119              
1120            
1121            
1122             lab1
1123             authors1
1124             authors2
1125            
1126            
1127             ...
1128            
1129            
1130              
1131             =cut
1132              
1133             ##
1134             #
1135             # @article in an array with ($ref_item1, $ref_item2,...)
1136             #
1137             # @$item is an array with (lab1, author1, author2,...)
1138             #
1139             ##
1140              
1141             sub string_bylabs_xml
1142             {
1143 0     0 1 0 my (@article) = @_;
1144 0         0 my $string;
1145 0         0 my @article_bylab = author_to_lab(@article);
1146 0 0       0 $string = "
\n" if (@article > 0);
1147 0         0 foreach my $item (@article_bylab) {
1148 0         0 $string .= " \n";
1149 0         0 my ($lab,@authors) = @$item;
1150 0         0 $string .= " " . accent($lab) . "\n";
1151 0         0 foreach my $author (@authors) {
1152 0         0 $string .= " " . accent($author) . "\n";
1153             }
1154 0         0 $string .= " \n";
1155             }
1156 0 0       0 $string .= "\n" if (@article > 0);
1157 0         0 return $string;
1158             }
1159              
1160              
1161             ############################################################
1162              
1163              
1164             =head2 C - Return a string with xml tags all the lab found in an article
1165            
1166             my $string = string_onlylabs_xml(@article);
1167              
1168            
1169             lab1
1170             lab2
1171             ...
1172            
1173              
1174             =cut
1175              
1176             sub string_onlylabs_xml
1177             {
1178 0     0 1 0 my (@article) = @_;
1179 0         0 my $string;
1180 0         0 my @article_bylab = author_to_lab(@article);
1181 0 0       0 $string = "
\n" if (@article > 0);
1182 0         0 foreach my $item (@article_bylab) {
1183            
1184 0         0 my ($lab,@authors) = @$item;
1185 0         0 $string .= " " . accent($lab) . "\n";
1186             }
1187 0 0       0 $string .= "\n" if (@article > 0);
1188 0         0 return $string;
1189             }
1190              
1191              
1192             ########################################################
1193              
1194              
1195             =head2 C - Return a string with all the authors and lab using html tags
1196              
1197             my $string_out = string_by_authors_html(@article);
1198            
1199            
1200             author1
1201            

1202            
1203            
  • lab1
  • 1204            
  • lab2
  • 1205            
    1206            

    1207            
    1208             =cut
    1209              
    1210             sub string_byauthors_html
    1211             {
    1212 0     0 1 0 my (@article) = @_;
    1213 0         0 my $string;
    1214 0         0 my $number = @article;
    1215 0         0 $string = "

    Number of authors: $number

    \n";

    1216 0         0 my $i = 1;
    1217 0         0 foreach my $item (@article) {
    1218 0         0 $string .= "
    \n";
    1219 0         0 my ($author,@labs) = @$item;
    1220 0         0 $string .= "$i

    ";

    1221 0         0 $string .= "

    " . accent($author) . "\n

      ";
    1222 0         0 foreach my $lab (@labs) {
    1223 0         0 $string .= "
  • " . accent($lab) . "
  • \n";
    1224             }
    1225 0         0 $string .= "

    \n";

    1226 0         0 $i = $i + 1;
    1227             }
    1228 0         0 $string .= "\n";
    1229 0         0 return $string;
    1230             }
    1231              
    1232              
    1233             #############################
    1234              
    1235              
    1236             =head2 C - PrintReturn a string with all the laboratories with authors using html tags
    1237            
    1238            
    1239             lab1
    1240            

    1241            
    1242            
  • author1
  • 1243            
  • author2
  • 1244            
    1245            

    1246            
    1247             =cut
    1248              
    1249             sub string_bylabs_html
    1250             {
    1251 0     0 1 0 my (@article) = @_;
    1252 0         0 my $string;
    1253 0         0 my @article_bylab = author_to_lab(@article);
    1254 0         0 my $number = @article_bylab;
    1255 0         0 $string = "

    Number of labs: $number

    \n";

    1256 0         0 my $i = 1;
    1257 0         0 foreach my $item (@article_bylab) {
    1258 0         0 $string .= "
    \n";
    1259 0         0 my ($lab,@authors) = @$item;
    1260 0         0 $string .= "$i

    ";

    1261 0         0 $string .= "

    " . accent($lab) . "\n

      ";
    1262 0         0 foreach my $author (@authors) {
    1263 0         0 $string .= "
  • " . accent($author) . "
  • \n";
    1264             }
    1265 0         0 $string .= "

    \n";

    1266 0         0 $i = $i + 1;
    1267             }
    1268 0         0 $string .= "\n";
    1269 0         0 return $string;
    1270             }
    1271              
    1272              
    1273             #######################################################################
    1274             #
    1275             # Generic functions to extract the authors and laboratories in a latex string
    1276             #
    1277             # In these function $name1 is the string command for author list (author)
    1278             # and $name2 the string command for laboratory (institution).
    1279             # Don't use \ in the command name.
    1280             #
    1281             # eg: grepautaff("author,"adr",$tex_string);
    1282             #
    1283             #######################################################################
    1284              
    1285             ########################################################################
    1286             #
    1287             # pattern 1:
    1288             #
    1289             # \auteur
    1290             # \adr
    1291             #
    1292             # \author[ref_adr1]{name1}
    1293             # \adr[ref_adr1]{name1}
    1294             # \thanksref \thanks
    1295             #
    1296             #######################################################################
    1297              
    1298             sub grepautaff
    1299             {
    1300 0     0 0 0 my ($name1,$name2,$string_tex) = @_ ;
    1301              
    1302 0         0 my @article_t=();
    1303            
    1304             # get lab name in \newcommand
    1305            
    1306 0         0 my %list_index_author;
    1307             my %list_index_labo;
    1308            
    1309             #
    1310              
    1311 0         0 my $and;
    1312              
    1313 0         0 my %laliste;
    1314            
    1315             # for $file (@mfile){
    1316             # print "file: $file \n";
    1317 0         0 %laliste = newcommand($string_tex);
    1318            
    1319 0         0 my %thanks;
    1320 0         0 my %thanks_index = list_index("thanks",$string_tex);
    1321              
    1322 0         0 my ($debut_string,@texte_tex) = split(/\\$name1/,$string_tex);
    1323            
    1324             # open(A,$file) or die "cant open $file\n";
    1325             # ;
    1326             # while(){
    1327            
    1328 0         0 foreach (@texte_tex) {
    1329 0         0 chomp;
    1330              
    1331 0         0 my @item = ();
    1332             # print "$name2\n";;
    1333 0 0       0 $_ =~ s/\\altaffiliation/\\affiliation/g if ($name2 eq "affiliation");
    1334             #print "s1=$_ \n" ;
    1335             #my $author;
    1336             # traite crochet []
    1337              
    1338 0         0 my ($textecrochet,$texteapres) = extract_bracketed($_,"[");
    1339             #print "1 = $textecrochet \n";
    1340              
    1341 0         0 my ($author,$suitetexte) = extract_bracketed($texteapres,"{");
    1342              
    1343             #print "s1=$_ \n" ;
    1344              
    1345 0         0 $author = bichop($author);
    1346             # au1 \AND au2
    1347              
    1348 0 0       0 if ($author =~ /\\and/) {
    1349 0         0 $and = 1;
    1350             }
    1351              
    1352             #print "
    1=$author";
    1353 0         0 $_ =$author;
    1354 0         0 my ($index_th) = /\\thanksref\{(\w+)\}$/;
    1355             #my $index_th = $1;
    1356 0         0 $author = accent($author);
    1357 0         0 my $string_thanks = $thanks_index{$index_th};
    1358              
    1359 0         0 $string_thanks =~ s/Present address://;
    1360             # $string_thanks =~ s/on leave from//;
    1361 0 0 0     0 $thanks{$author} = $string_thanks if (($index_th ne "") &&($thanks_index{$index_th} =~ /address/));
    1362             #print "
    2=$author --- $string_thanks --- $index_th";
    1363              
    1364 0         0 $textecrochet = bichop($textecrochet);
    1365 0 0       0 $list_index_author{$author} = $textecrochet if ($textecrochet ne "");
    1366             #print "
    a= $author \n";
    1367 0         0 $author =~ s/, and/ and/;
    1368            
    1369 0 0       0 push(@item,$author) if ($author ne "");
    1370             #print "s2=$suitetexte \n" ;
    1371              
    1372 0         0 my ($vide,@next) = split(/\\$name2/,$suitetexte);
    1373              
    1374              
    1375 0         0 foreach my $texte (@next) {
    1376             #my $labo;
    1377             #print "t= $texte \n";
    1378 0         0 my ($textecrochet,$texteapres) = extract_bracketed($texte,"[");
    1379             #print "2 = $textecrochet \n";
    1380              
    1381 0         0 my ($labo,$xyz) = extract_bracketed($texteapres,"{");
    1382             #print "0 =$labo \n";
    1383 0         0 $labo = bichop($labo);
    1384 0         0 $labo =~ s/^ \s*//g;
    1385 0         0 $labo =~ s/\s*$//g;
    1386              
    1387 0 0       0 $textecrochet = bichop($textecrochet) if ($textecrochet ne "");
    1388             #print "
    $textecrochet = $labo \n";
    1389 0         0 $list_index_labo{$textecrochet} = $labo ;
    1390              
    1391 0 0       0 $labo = $laliste{$labo} if ($laliste{$labo} ne "");
    1392 0         0 $labo = accent($labo);
    1393             #print "2 = $labo \n";
    1394 0 0       0 push(@item,$labo) if ($labo ne "");
    1395             }
    1396 0         0 push(@article_t,\@item);
    1397              
    1398             } # A
    1399             # } #$file
    1400              
    1401              
    1402             #return @article_t;
    1403 0         0 my @article;
    1404 0 0       0 if ($and == 0) {
    1405             ####
    1406             # traite \aut{A and B} \lab l -> A l , B l
    1407             # et aussi \au A \au B \lab l -> A l , B l
    1408             # \au[ind_lab]{aut} \lab[ind_lab]{lab} -> aut lab
    1409             # \author[ind_lab1,ind_lab2]{name1}
    1410              
    1411             #my @article;
    1412 0         0 my @listeattente;
    1413 0         0 foreach my $s (@article_t) {
    1414 0         0 my ($auto,@labo) = @$s;
    1415              
    1416 0         0 my $labo1 = $labo[0];
    1417              
    1418              
    1419 0 0       0 if ($list_index_author{$auto} ne "") {
        0          
    1420 0         0 my @item;
    1421              
    1422 0         0 my $index_labo = $list_index_author{$auto};
    1423             #print "
    a=$auto";
    1424 0         0 push(@item,$auto);
    1425              
    1426              
    1427             # \author[lab1,lab2]{name1}
    1428              
    1429 0         0 my @tab_index_lab = split(/,/,$index_labo);
    1430              
    1431 0         0 foreach (@tab_index_lab) {
    1432            
    1433             #push(@item,$list_index_labo{$index_labo});
    1434             #print "
    $_ = $list_index_labo{$_}";
    1435 0         0 push(@item,$list_index_labo{$_});
    1436              
    1437             }
    1438 0 0       0 push(@item,$thanks{$auto}) if ($thanks{$auto} ne "");
    1439             #push(@item,@labo);
    1440 0         0 push (@article,\@item);
    1441              
    1442              
    1443             } elsif ($labo1 ne "") {
    1444             # autre
    1445              
    1446 0         0 foreach my $auteurwait (@listeattente) {
    1447              
    1448 0         0 my @item;
    1449 0         0 push(@item,$auteurwait);
    1450 0         0 push(@item,@labo);
    1451 0         0 push (@article,\@item);
    1452             }
    1453              
    1454 0         0 my @auteuritem=split(/,| and /,$auto);
    1455 0         0 foreach my $unauteur (@auteuritem) {
    1456              
    1457 0         0 my @item;
    1458 0         0 push(@item,$unauteur);
    1459 0         0 push(@item,@labo);
    1460 0         0 push (@article,\@item);
    1461             }
    1462              
    1463 0         0 @listeattente = ();
    1464              
    1465             #@listeauteur = ();
    1466             # last
    1467              
    1468              
    1469             } else {
    1470              
    1471 0         0 push(@listeattente,$auto);
    1472             }
    1473              
    1474             } # foreach authorrwait
    1475              
    1476             } else # $and = 1
    1477             {
    1478             #my @article;
    1479              
    1480 0         0 foreach my $s (@article_t) {
    1481              
    1482 0         0 my ($aute,$labo) = @$s;
    1483              
    1484 0         0 my @auteur = split(/\\and/,$aute);
    1485 0         0 my @labo = split(/\\and/,$labo);
    1486              
    1487 0         0 my $nbre = @auteur;
    1488              
    1489 0         0 my $i = 0;
    1490              
    1491 0         0 foreach (@auteur) {
    1492 0         0 my @doc2;
    1493              
    1494 0         0 push(@doc2,$_);
    1495 0         0 push(@doc2,$labo[$i]);
    1496              
    1497 0         0 $i = $i +1;
    1498 0         0 push(@article,\@doc2),
    1499             } #for @auteur
    1500              
    1501             } # for s
    1502            
    1503              
    1504             } # and =1
    1505              
    1506 0         0 @article;
    1507             } #sub
    1508              
    1509              
    1510            
    1511             #########################################################################
    1512             #
    1513             # pattern 2:
    1514             #
    1515             # aastex
    1516             #
    1517             # \author{ author1\altaffilmark{1}, author2\altaffilmark{2} }
    1518             # \altaffiltext{1}{lab1}
    1519             # \altaffiltext{2}{lab2}
    1520             #
    1521             #########################################################################
    1522              
    1523             sub grep_aut_altaff
    1524             {
    1525 0     0 0 0 my ($string_tex) = @_ ;
    1526 0         0 my @article;
    1527             # for list_index: transform {1} -> [1]
    1528 0         0 $string_tex =~ s/\\altaffiltext{([^}]+)}/\\altaffiltext[$1]/g;
    1529 0         0 my %listlab = list_index("altaffiltext",$string_tex);
    1530 0         0 my @author_string = greplatexcom("author",["t"],$string_tex);
    1531 0         0 my $authors = bichop($author_string[0]->{t});
    1532 0         0 my @authors_array = split(/,/,$authors);
    1533 0         0 foreach (@authors_array)
    1534             {
    1535 0         0 /([^\\]+)\\altaffilmark{([^\\]+)}/;
    1536 0         0 my @item;
    1537 0         0 push(@item,$1);
    1538 0         0 push(@item,$listlab{$2});
    1539 0         0 push(@article,\@item);
    1540             }
    1541 0         0 return @article;
    1542             }
    1543              
    1544             #########################################################################
    1545             #
    1546             # pattern 3:
    1547             #
    1548             # \author{ author \\ lab}
    1549             #
    1550             #########################################################################
    1551              
    1552             sub grepaut
    1553             {
    1554 1     1 0 2 my ($name1,$string_tex) = @_ ;
    1555              
    1556 1         2 my @article;
    1557             #print "in grepaut\n";
    1558 1         11 my ($debut_string,@texte_tex) = split(/\\$name1/,$string_tex);
    1559              
    1560 1         3 foreach (@texte_tex) {
    1561 1         2 chomp;
    1562              
    1563 1         2 my @item = ();
    1564            
    1565 1         4 my ($textecrochet,$textafter) = extract_bracketed($_,"[");
    1566             #print "1 = $textecrochet \n";
    1567             #print "2= $texteapres\n";
    1568 1         67 my ($authorLab,$suitetexte) = extract_bracketed($textafter,"{");
    1569              
    1570             #print "s1=$_ \n" ;
    1571              
    1572 1         392 $authorLab = bichop($authorLab);
    1573             # au1 \AND au2
    1574             #print "a=$authorLab\n";
    1575              
    1576 1         7 my ($author,@lab)=split(/\\\\/,$authorLab);
    1577             #print "a=$author\n";
    1578              
    1579 1         8 my @tab_author = split(/,| and /,$author);
    1580             #print $tab_author[0];
    1581              
    1582 1         1 my $lab_string;
    1583 1         3 foreach (@lab) {
    1584 5         8 s/\\and/./g;
    1585 5         6 s/,$/, /g;
    1586 5         11 $lab_string .= $_ . ",";
    1587             }
    1588 1         6 $lab_string =~ s/^\s*//g;
    1589              
    1590             #print "l=$lab_string\n";
    1591 1         2 foreach (@tab_author) {
    1592 1         2 my @item;
    1593 1         2 push(@item,$_);
    1594 1         2 push(@item,$lab_string);
    1595 1         3 push(@article,\@item);
    1596             }
    1597              
    1598 1         6 return @article;
    1599              
    1600            
    1601             }
    1602             }
    1603              
    1604             #########################################################################
    1605             #
    1606             # pattern 4:
    1607             #
    1608             # \author{ author1 \lab{address}}
    1609             #
    1610             #########################################################################
    1611              
    1612             sub grepautadd
    1613             {
    1614 0     0 0   my ($name1,$name2,$string_tex) = @_ ;
    1615            
    1616 0           my @rf=();
    1617              
    1618 0           my ($debut_string,@texte_tex) = split(/\\$name1/,$string_tex);
    1619              
    1620 0           foreach (@texte_tex) {
    1621 0           chomp;
    1622              
    1623 0           my $aut_lab;
    1624              
    1625             my %ref;
    1626              
    1627 0           ($aut_lab,$_) = extract_bracketed($_,"{");
    1628              
    1629 0           $aut_lab = bichop($aut_lab);
    1630 0           $aut_lab =~ s/^\s//g;
    1631 0           $aut_lab =~ s/\s$//g;
    1632              
    1633              
    1634 0           my (@suite) = split(/\\$name2/,$aut_lab);
    1635              
    1636 0           my @r;
    1637              
    1638 0           my $begin = 1;
    1639              
    1640 0           my $rnom;
    1641 0           foreach my $texte (@suite) {
    1642 0           my $courant;
    1643 0 0         if ($begin == 0) {
    1644             # [lab_index] -> lab_name
    1645 0           my $laref;
    1646             my $leadr;
    1647              
    1648 0           ($laref,$courant) = extract_bracketed($texte,"[");
    1649 0           ($leadr,$courant) = extract_bracketed($texte,"{");
    1650              
    1651 0           $laref = bichop($laref);
    1652 0           $leadr = bichop($leadr);
    1653              
    1654 0 0         $ref{$laref} = $leadr if ($laref ne "");
    1655              
    1656             # push address
    1657 0 0         if ($texte =~ /mark\[(.*)\]/) {
    1658 0           my $relf = $1;
    1659 0           my $leadr = $ref{$relf};
    1660 0           $leadr = accent($leadr);
    1661 0           push(@r,$leadr);
    1662              
    1663             } else {
    1664 0           $leadr =~ s/\\.*{.*}//g;
    1665 0           $leadr = accent($leadr);
    1666 0           push(@r,$leadr);
    1667             }
    1668            
    1669 0 0         if ($rnom ne "") {
    1670 0           my @tab = @r;
    1671 0           push(@rf,\@tab);
    1672             }
    1673              
    1674             } # begin == 0
    1675              
    1676 0           @r = ();
    1677 0 0         $courant = $texte if ($begin == 1);
    1678 0           $courant =~ s/\n/ /g;
    1679 0           $courant =~ s/\\.*{.*}//g;
    1680 0           $courant =~ s/^mark\[.*\]//g;
    1681 0 0         $rnom = $courant if (!($texte =~ /mark\[(.*)\]/));
    1682 0           my $chaine = accent($courant);
    1683              
    1684             # push author
    1685              
    1686 0 0 0       push(@r,$chaine) if ( (! ($texte =~ /mark\[(.*)\]$/)) && (($begin == 1 )|| ($courant =~ /,|and/) )) ;
          0        
    1687 0           $begin = 0;
    1688             }
    1689              
    1690             } # A
    1691              
    1692             #} # file
    1693              
    1694 0           return @rf;
    1695             } #fonc
    1696              
    1697              
    1698             #####################################################
    1699             #
    1700             # pattern 5:
    1701             #
    1702             # for aip articles
    1703             #
    1704             # \aut{nom}{address={adr1},altaddress={adr2}}
    1705             #
    1706             #####################################################
    1707              
    1708              
    1709             sub grepautadd_eq
    1710             {
    1711 0     0 0   my ($name1,$name2,$string_tex) = @_ ;
    1712             #print $string_tex;
    1713 0           my @article=();
    1714            
    1715 0           my ($debut_string,@texte_tex) = split(/\\$name1/,$string_tex);
    1716              
    1717 0           foreach (@texte_tex) {
    1718 0           chomp;
    1719             #print ;
    1720 0           my $aut;
    1721             my $lab;
    1722              
    1723 0           my @item;
    1724              
    1725 0           ($aut,$lab) = extract_bracketed($_,"{");
    1726              
    1727 0           $aut = bichop($aut);
    1728 0           $lab = bichop($lab);
    1729 0           $aut =~ s/^\s//g;
    1730 0           $aut =~ s/\s$//g;
    1731              
    1732 0           push(@item,$aut);
    1733              
    1734 0           my ($begin,@suite) = split(/${name2}=/,$lab);
    1735            
    1736             # my @r;
    1737             # my $begin = 1;
    1738              
    1739             # my $rnom;
    1740            
    1741 0           foreach my $texte (@suite) {
    1742             #print "t=$texte \n";
    1743 0           my ($leadr,$courant) = extract_bracketed($texte,"{");
    1744 0           $leadr = bichop($leadr);
    1745             #print "adr=$leadr \n";
    1746 0           push(@item,$leadr);
    1747             }
    1748 0           push(@article,\@item);
    1749             }
    1750 0           return(@article);
    1751             }
    1752              
    1753              
    1754             #########################################################
    1755             #
    1756             # pattern 6:
    1757             #
    1758             # \author{name1$^1$, name2
    1759             # \\
    1760             # $^1§ labo\\
    1761             # }
    1762             #
    1763             #########################################################
    1764              
    1765              
    1766             sub grepaut_math
    1767             {
    1768 0     0 0   my ($name1,$string_tex) = @_ ;
    1769              
    1770 0           my @article=();
    1771              
    1772 0           my @grep_author_lab = greplatexcom("$name1",[["arg"],"t"],$string_tex);
    1773 0           my $author_lab = bichop($grep_author_lab[0]->{t});
    1774              
    1775 0           my ($authors,@labs) = split(/\\\\/,$author_lab);
    1776              
    1777 0           my $lab_string;
    1778              
    1779 0           foreach (@labs) {
    1780 0           $lab_string .= $_;
    1781             }
    1782              
    1783 0           my @tab_authors = split(/\$/,$authors);
    1784              
    1785 0           my ($empty,@tab_address) = split(/\$/,$lab_string);
    1786              
    1787 0           my %labo;
    1788              
    1789 0           my $i = 0;
    1790 0           my $indice;
    1791              
    1792 0           foreach (@tab_address) {
    1793 0 0         if (!($i % 2)) {
    1794             #print "
    i=$_\n";
    1795 0           /\^{?([\w\\]+)}?/;
    1796             #print "i1= $1\n";
    1797             #s/^\^//;
    1798 0           $indice = $1;
    1799             } else {
    1800 0           s/Present address://; $labo{$indice} = $_; $indice = "";
      0            
      0            
    1801             }
    1802             # print "
    la=$_\n";
    1803 0           $i = $i +1;
    1804             }
    1805              
    1806 0           my @list_author;
    1807             my %name;
    1808 0           my $author;
    1809 0           $i = 0;
    1810              
    1811 0           foreach (@tab_authors) {
    1812              
    1813 0 0         if ($i % 2) {
    1814 0           /\^{?([\w,()\\]+)}?/;
    1815             # print "
    $i l=$_\na=$1\n";
    1816              
    1817 0           $name{$author} = $1;
    1818 0           push(@list_author,$author);
    1819 0           $author = "";
    1820             } else {
    1821             #s/^\s*and //;
    1822             #s/,$//;
    1823             # print "
    $i b=$_\n";
    1824 0           $author = $_;
    1825 0           $author =~ s/,\s*\\newauthor//g;
    1826             # print "
    $i au=$author\n";
    1827             }
    1828 0           $i =$i + 1;
    1829             # print "
    $_";
    1830              
    1831             }
    1832              
    1833 0           foreach (@list_author) {
    1834 0           my @item;
    1835             #print "$_
    ";
    1836 0           push(@item,$_);
    1837             #print "
    $_ $name{$_}";
    1838 0           my @tab_indice = split(/,/,$name{$_});
    1839 0           foreach (@tab_indice) {
    1840 0           push(@item,$labo{$_});
    1841             }
    1842 0           push(@article,\@item);
    1843             }
    1844 0           return @article;
    1845              
    1846             }
    1847              
    1848              
    1849             ########################################################
    1850             #
    1851             # pattern 7:
    1852             #
    1853             # \aut {name1,$^1$ name2,$^2$ name3,$^{1,2}$}
    1854             # \lab {$^1$lab1 $^2$lab2}
    1855             #
    1856             # \aut{name1 $^1$}
    1857             # \aut[name2 $^2$}
    1858             # \lab{$^1$ lab1}
    1859             # \lab{$^2$ lab2}
    1860             #
    1861             ########################################################
    1862              
    1863              
    1864             sub grepautadd_math
    1865             {
    1866 0     0 0   my ($name1,$name2,$string_tex) = @_ ;
    1867              
    1868 0           my @article=();
    1869              
    1870 0           my $authors;
    1871             my $address;
    1872              
    1873 0           my @aut = greplatexcom("$name1",["t"],$string_tex);
    1874 0           foreach (@aut) {
    1875 0           $authors .= bichop($_->{t}). ", ";
    1876             }
    1877              
    1878             #(bichop($aut[0]->{t})
    1879 0           my @addr= greplatexcom("$name2",[["arg"],"t"],$string_tex);
    1880 0           foreach (@addr) {
    1881 0           $address .= bichop($_->{t}). ", ";
    1882             }
    1883            
    1884 0           my @tab_authors = split(/\$/,$authors);
    1885             #print"
    ";
    1886 0           my $i = 0;
    1887 0           my %name;
    1888             my %labo;
    1889 0           my @list_author;
    1890              
    1891 0           my ($empty,@tab_address) = split(/\$/,$address);
    1892              
    1893 0           my $indice;
    1894             my $author;
    1895              
    1896 0           foreach (@tab_address) {
    1897 0 0         if (!($i % 2)) {
    1898             #print "i=$_\n";
    1899 0           /\^{?([\w,()]+)}?/;
    1900             #print "i1= $1\n";
    1901             #s/^\^//;
    1902 0           $indice = $1;
    1903             } else {
    1904 0           $labo{$indice} = $_; $indice = "";
      0            
    1905             }
    1906             #print "la=$_\n";
    1907 0           $i = $i +1;
    1908             }
    1909              
    1910 0           $i = 0;
    1911              
    1912 0           foreach (@tab_authors) {
    1913 0 0         if ($i % 2) {
    1914 0           /\^{?([\w,()]+)}?/;
    1915             #/\^{?\(?([\w,]+)\)?}?/;
    1916             #print "l=$_\na=$1\n";
    1917 0           $name{$author} = $1;
    1918 0           push(@list_author,$author);
    1919 0           $author = "";
    1920             } else {
    1921 0           s/^\s*and //;
    1922 0           s/,$//;
    1923             #print "b=$_\n";
    1924 0           $author = $_;
    1925              
    1926             }
    1927 0           $i =$i + 1;
    1928              
    1929             }
    1930              
    1931 0           foreach (@list_author) {
    1932 0           my @item;
    1933             #print "$_
    ";
    1934 0           push(@item,$_);
    1935              
    1936 0           my @tab_indice = split(/,/,$name{$_});
    1937 0           foreach (@tab_indice) {
    1938 0           push(@item,$labo{$_});
    1939             }
    1940 0           push(@article,\@item);
    1941             }
    1942 0           return @article;
    1943             }
    1944              
    1945              
    1946             #################################################################
    1947             #
    1948             # Functions for collaboration (physics)
    1949             #
    1950             # Collaborations now available: h1, aleph, l3, na59, babar, zeus
    1951             #
    1952             # Each function try to extract authors and lab with the special
    1953             # pattern used by a collaboration
    1954             #
    1955             ################################################################
    1956              
    1957             ################################################################
    1958             #
    1959             # Call the good function to extract authors and labs for
    1960             # articles with a collaboration name
    1961             #
    1962             ################################################################
    1963              
    1964            
    1965             sub func_by_coll
    1966             {
    1967 0     0 0   my ($string,$collaboration) = @_;
    1968 0           my @article;
    1969 0 0         @article = extract_article_h1($string) if ($collaboration eq "h1");
    1970 0 0         @article = extract_article_aleph($string) if ($collaboration eq "aleph");
    1971 0 0         @article = extract_article_l3($string) if ($collaboration eq "l3");
    1972 0 0         @article = extract_article_na59($string) if ($collaboration eq "na59");
    1973 0 0         @article = extract_article_babar($string) if ($collaboration eq "babar");
    1974 0 0         @article = extract_article_zeus($string) if ($collaboration eq "zeus");
    1975 0           return(@article);
    1976             }
    1977              
    1978              
    1979             ###################################################################
    1980             #
    1981             # Collaboration 1: Na59
    1982             #
    1983             # Extract authors and lab for article of Na59 collaboration
    1984             #
    1985             # external file with \author and \affiliation
    1986             #
    1987             ###################################################################
    1988              
    1989              
    1990             sub extract_article_na59
    1991             {
    1992 0     0 0   my ($string) = @_;
    1993 0           my $chaine_file = $string ;
    1994 0           return grepautaff("author","affiliation",$chaine_file);
    1995             }
    1996              
    1997              
    1998             ##################################################################
    1999             #
    2000             # Collaboration 2: H1
    2001             #
    2002             # Extract authors and lab for article of H1 collaboration
    2003             #
    2004             # external file
    2005             # I.~Name$^{24}$
    2006             # ...
    2007             # $ ^{24}$ lab name \\
    2008             #
    2009             ###################################################################
    2010              
    2011              
    2012             sub extract_article_h1
    2013             {
    2014 0     0 0   my ($string) = @_;
    2015 0           my $chaine_file = $string ;
    2016             #print $chaine_file;
    2017              
    2018 0           my $out_author = 0;
    2019              
    2020 0           my @tab_au;
    2021             my @tab_lab;
    2022 0           my %name_lab;
    2023 0           my $i;
    2024 0           my $ligne_lab;
    2025 0           my $chaine;
    2026 0           my $author;
    2027 0           my $index;
    2028              
    2029             #while (<>)
    2030              
    2031 0           my @tab_chaine = split(/\n/,$chaine_file);
    2032              
    2033              
    2034 0           foreach (@tab_chaine) {
    2035             # author
    2036             #print "l=$_\n";
    2037              
    2038 0 0 0       if ((/(^[^\s]+.*)\$\^{([\s\w,]+)}\$(,?)\s/) && ($out_author == 0)) {
    2039             #print "$_\n";
    2040 0 0         $out_author = 1 if ($3 eq "");
    2041             #print "out = $out_author $3 \n";
    2042            
    2043 0           my $auteur = $1;
    2044 0           $auteur = accent($auteur);
    2045             #print "x=$auteur $1 $2\n";
    2046              
    2047 0           my $index_lab = $2;
    2048 0           $index_lab =~ s/^\s*//;
    2049 0           $index_lab =~ s/\s*$//;
    2050              
    2051 0           my @liste_t = split(/,/,$index_lab);
    2052 0           my @liste;
    2053             my $chaine;
    2054              
    2055 0           foreach (@liste_t) {
    2056 0 0         push (@liste,$_) if (/\d+/);
    2057             }
    2058              
    2059             # print $_;
    2060             #print "a=$auteur";
    2061              
    2062             #foreach my $in (@liste)
    2063             #{
    2064             #print " i=$in";
    2065             #}
    2066             #print "\n";
    2067              
    2068             #$tab_aut{$auteur} = \@liste;
    2069              
    2070 0           $tab_au[$i] = $auteur;
    2071 0           $tab_lab[$i] = \@liste;
    2072 0           $i = $i + 1;
    2073              
    2074             #print "$i $tab_lab[$i][0] \n";
    2075             }
    2076             #print "n=" . @tab_au . "\n";
    2077              
    2078             # lab
    2079 0 0 0       if ( (/\$\s*\^{(\d+)}\$(.*?)(\$.*\$)?\s\\\\/) && ($out_author == 1) ) {
        0 0        
        0 0        
        0 0        
    2080             #print "ligne1= $1 $2\n";
    2081 0           my $index= $1;
    2082 0           my $labo = $2;
    2083 0           $index =~ s/^\s*//g;
    2084 0           $index =~ s/\s*$//g;
    2085             #print "ligne= $1 --- $2\n";
    2086 0           $labo = accent($labo);
    2087 0           $name_lab{$index} = $labo;
    2088             #print "li=$index $labo\n";
    2089             # more than 1 line
    2090             } elsif ( (/\$\s*\^{(\d+)}\$(.*)\s*/) && ($out_author == 1) ) {
    2091              
    2092 0           $ligne_lab = 1;
    2093 0           $chaine = $2;
    2094 0           $index = 0;
    2095 0           $index = $1;
    2096 0           $index =~ s/^\s*//g;
    2097 0           $index =~ s/\s*$//g;
    2098              
    2099             #print "12= $1 $2\n";
    2100             } elsif ( (!/\\\\$/) && ($ligne_lab == 1) ) {
    2101             #print "3s $_";
    2102 0           /(.*)/;
    2103             #print "3=$1\n";
    2104 0           $chaine .= " $1";
    2105              
    2106             } elsif ( (/(.*?)(\$.*\$)?\s*\\\\$/) && ($ligne_lab == 1) ) {
    2107              
    2108             #print "4=$1\n";
    2109 0           $chaine .= " $1";
    2110             #print "$chaine\n";
    2111 0           $chaine = accent($chaine);
    2112 0           $name_lab{$index} = $chaine;
    2113 0           $ligne_lab = 0;
    2114 0           $chaine = "";
    2115             }
    2116             }
    2117              
    2118 0           my @total;
    2119              
    2120 0           my $nb_aut= @tab_au;
    2121              
    2122             #foreach my $author (keys %tab_aut)
    2123 0           my $j;
    2124              
    2125 0           for ($j=0 ;$j < $nb_aut; $j++) {
    2126             #print "au=$author\n";
    2127 0           my @tableau;
    2128              
    2129 0           push(@tableau,$tab_au[$j]);
    2130              
    2131             #print "j $j = $tab_au[$j] \n";
    2132              
    2133             #print "t= $tab_au[$j] \n";
    2134              
    2135 0           my $adr = $tab_lab[$j];
    2136 0           foreach my $lab (@$adr) {
    2137             #print " l= $lab\n";
    2138             #print " nl= $name_lab{$lab} \n";
    2139 0           push(@tableau,$name_lab{$lab});
    2140            
    2141             }
    2142 0           push(@total,\@tableau)
    2143             }
    2144              
    2145             #print_item(@total);
    2146              
    2147 0           return(@total);
    2148              
    2149             #print "ok \n";
    2150             }
    2151              
    2152              
    2153             ###############################################################
    2154             #
    2155             # collaboration 3: Aleph
    2156             #
    2157             # Extract authors and lab for article of Aleph collaboration
    2158             #
    2159             # \begin{sloopypar}
    2160             # aut1,
    2161             # aut2,
    2162             # \command
    2163             # name1
    2164             # name2
    2165             # \end
    2166             #
    2167             ##############################################################
    2168              
    2169              
    2170             sub grep_article_aleph
    2171             {
    2172 0     0 0   my ($string) = @_;
    2173 0           my $chaine_file = $string ;
    2174 0           my %index_tab = list_index("footnotetext",$chaine_file);
    2175              
    2176 0           my @liste = theenvs("sloppypar",$chaine_file);
    2177              
    2178             #print "l=$liste \n";
    2179 0           my @article;
    2180             my %liste_index;
    2181 0           foreach my $list (@liste) {
    2182 0           my @tab_chaine = split(/\n/,$list);
    2183              
    2184 0           my $lab;
    2185 0           my $in_author = 0;
    2186 0           my $in_lab = 0;
    2187 0           my $ok_lab= 0;
    2188 0           my %foot_note;
    2189             my @author_wait;
    2190 0           foreach (@tab_chaine) {
    2191              
    2192             #if ((/^\s*\\\w+/) && (! /^\\mbox{/) && ($in_author == 1)){ print "1=$_\n";
    2193             # $in_author = 0; $in_lab = 1; }
    2194              
    2195              
    2196 0 0 0       if ( ((/^\s*\\nopagebreak/) || (/^\s*\\samepage/)) && ($in_author == 1) ) { #print "1=$_\n";
        0 0        
        0 0        
        0 0        
        0 0        
          0        
          0        
    2197 0           $in_author = 0; $in_lab = 1;
      0            
    2198             } elsif ((/^\w+,?/) && ($in_lab == 0)) {
    2199 0           $in_author = 1;
    2200 0           s/\s*\$\^{(\w+)}\$\s*$//; my $index = $1; s/,//; push(@author_wait,$_) ;
      0            
      0            
      0            
    2201 0           my $newlab = $index_tab{$index} ;
    2202             #print "21=$_\n";
    2203 0 0         $foot_note{$_} = $newlab if ($newlab ne "");
    2204             #print "$_ XXXXXXX i=$index --- $newlab\n";
    2205             } elsif ((/^\s*\\mbox{(.*)}/) && ($in_lab == 0)) {
    2206 0           $in_author = 1; $_ = $1;
      0            
    2207 0           s/\s*\$\^{(\w+)}\$\s*$//; s/,//; my $index = $1; push(@author_wait,$_) ;
      0            
      0            
      0            
    2208 0           my $newlab = $index_tab{$index} ;
    2209             #print "22=$_\n";
    2210 0 0         $foot_note{$_} = $newlab if ($newlab ne "");
    2211             } elsif ((/^\w+,?/) && ($in_lab == 1)) {
    2212 0           s/;
    2213             }
    2214             $//; #print "3=$_\n";
    2215 0           $lab .= "$_ "; $ok_lab = 1;
      0            
    2216             } elsif ((/^\s*\\\w+/) && ($in_lab == 1) && ($ok_lab == 1)) { #print "4=$_\n";
    2217 0           $in_author = 0; $in_lab = 0;
      0            
    2218              
    2219 0           foreach (@author_wait) {
    2220 0           my @item;
    2221              
    2222 0           push (@item,$_);
    2223              
    2224 0           $lab =~ s/\$\^{[\w,]+}\$\s*$//;
    2225 0           $lab =~ s/\\footnotemark\[\w*\]//;
    2226 0           push (@item,$lab);
    2227 0           $foot_note{$_} =~ s/^Now at //;
    2228 0           $foot_note{$_} =~ s/^Also at //;
    2229 0           $foot_note{$_} =~ s/Permanent address: //;
    2230 0 0 0       push(@item,$foot_note{$_}) if (($foot_note{$_} ne "") && (! ($foot_note{$_} =~ /^(Research|Deceased|Supported)/)));
    2231 0           push(@article,\@item);
    2232             }
    2233              
    2234             }
    2235              
    2236             }
    2237             }
    2238 0           return(@article);
    2239             }
    2240              
    2241             ##############################################################
    2242             #
    2243             # Collaboration 4: L3
    2244             #
    2245             # Extract authors and lab for article of the L3 collaboration
    2246             #
    2247             # external file (\input)
    2248             #
    2249             # name1\r\tute\reflab\
    2250             # name2\r\tute{\reflab1,\reflab2}\
    2251             #
    2252             # \item[\reflab1] lab1
    2253             # \item[\reflab2] lab2
    2254             #
    2255             #################################################################
    2256            
    2257              
    2258             sub extract_article_l3
    2259             {
    2260 0     0 0   my ($string) = @_;
    2261 0           my $tex_string = $string;
    2262              
    2263 0           $tex_string =~ s/\\item/\}\\item/g;
    2264             # \1 -> $1
    2265 0           $tex_string =~ s/(\\item\[.*\])/$1\{/g;
    2266              
    2267             #print $tex_string;
    2268              
    2269 0           my %index_tab = list_index("item",$tex_string);
    2270              
    2271 0           my @article;
    2272              
    2273             #my @liste = theenvs("sloppypar",$chaine_file);
    2274             #\r\tute
    2275            
    2276             my %name;
    2277              
    2278 0           my @tab_line = split(/\n/,$tex_string);
    2279 0           my @line_author =grep (/\\r\\tute|\\rlap.\\tute/, @tab_line);
    2280             #my @author_index =
    2281              
    2282 0           map (s/\\r\\tute|\\rlap.\\tute/ / , @line_author);
    2283              
    2284 0           foreach (@line_author) {
    2285 0           my @item;
    2286 0           my ($author,$index_labo) = split(/\s/);
    2287             # add space : J.C. smith -> J. C. Smith
    2288             #$author =~ s/([^\.]+)$/~$1/;
    2289 0           $author =~ s/\./\. /g;
    2290 0           push(@item,$author);
    2291             #print "$index_labo ";
    2292              
    2293 0           my @tab_index_lab = split(/,/,$index_labo);
    2294              
    2295 0           foreach (@tab_index_lab) {
    2296 0           s/^{//;
    2297 0           s/}?\\$//;
    2298             #print "$_ ";
    2299 0           my $lab = $index_tab{$_};
    2300 0           $lab =~ s/\$\^?{\\\w+}\$\s*$//;
    2301 0           push(@item,$lab);
    2302             #print "$author $index_tab{$_}\n";
    2303             }
    2304             #print "$author\n";
    2305 0           push(@article,\@item);
    2306             }
    2307 0           return(@article);
    2308             #exit;
    2309             }
    2310              
    2311              
    2312             ####################################################################
    2313             #
    2314             # Collaboration 5: Babar
    2315             #
    2316             # Extract authors and lab for article of the Babar collaboration
    2317             #
    2318             # \begin{center}
    2319             # author1,
    2320             # author2
    2321             # \inst{lab}
    2322             # author3,\footnote{note}
    2323             # \end{center}
    2324             #
    2325             #####################################################################
    2326            
    2327              
    2328             sub extract_article_babar
    2329             {
    2330 0     0 0   my ($string) = @_;
    2331 0           my @article;
    2332             my $authors_labs_string;
    2333 0           my @array = theenvs("center",$string);
    2334 0           my $center_string;
    2335 0           foreach $center_string (@array) {
    2336 0           $authors_labs_string = $center_string;
    2337 0 0         last if ($center_string =~ /\\inst/s);
    2338             }
    2339            
    2340 0           my @labo = greplatexcom("inst",["lab"],$authors_labs_string);
    2341 0           my @footnote = greplatexcom("footnote",["note"],$authors_labs_string);
    2342 0           my $i = 0;
    2343 0           my $j = 0;
    2344 0           my %otherlab;
    2345             my @authors_array;
    2346            
    2347 0           my @line_array = split(/\n/,$authors_labs_string);
    2348              
    2349 0           foreach my $line (@line_array) {
    2350 0 0 0       if ((!($line =~ /~/)) && (!($line =~ /\\inst/))) {
    2351 0           next;
    2352             }
    2353 0 0 0       if (($line =~ /\~/) && (! ($line =~ /\\inst/))) {
    2354 0 0         if ($line =~ /\\footnote\{/) {
    2355             # print "
    $line -- $j -- $footnote[$j]->{note}
    ";
    2356 0           my $footlab = $footnote[$j]->{note};
    2357 0           bichop($footlab);
    2358 0           $footlab =~ s/Also with //;
    2359             # print "
    s=$footlab
    ";
    2360 0           $line =~ s/,\\footnote{.*//;
    2361 0           $otherlab{$line} = $footlab;
    2362 0           $j = $j + 1;
    2363             }
    2364              
    2365 0 0         if ($line =~ /\\footnotemark\[(\d+)\]/) {
    2366 0           my $note = $1; $line =~ s/,\\footnotemark\[.*//;
      0            
    2367 0           $note = $note -1;
    2368             # print "
    mark ". $line . " -- " . $note . " -- ". $footnote[$note]->{note} . "
    ";
    2369 0           my $footlab = bichop($footnote[$j - 1]->{note});
    2370 0           $footlab =~ s/Also with //;
    2371 0           $otherlab{$line} = $footlab;
    2372             }
    2373              
    2374 0           $line =~ s/,$//;
    2375 0           push(@authors_array,$line);
    2376             }
    2377 0 0         if ($line =~ /\\inst/) {
    2378 0           bichop($labo[$i]->{lab});
    2379 0           foreach (@authors_array) {
    2380 0           my @item;
    2381 0           push(@item,$_);
    2382 0           push(@item,$labo[$i]->{lab});
    2383 0 0 0       push(@item,$otherlab{$_}) if (($otherlab{$_} ne "") && ($otherlab{$_} ne "Deceased"));
    2384 0           push(@article,\@item);
    2385             }
    2386 0           @authors_array = ();
    2387 0           $i = $i + 1;
    2388             }
    2389             }
    2390 0           return @article;
    2391             }
    2392              
    2393            
    2394             ####################################################################
    2395             #
    2396             # Collaboration 6: Zeus
    2397             #
    2398             # Extract authors and lab for article of the Zeus collaboration
    2399             #
    2400             # author1,
    2401             # author2,
    2402             # author3\\
    2403             # {\it lab1}~$^{a}$
    2404             # author3$^{ 1}$,
    2405             #
    2406             # \newpage
    2407             #
    2408             ######################################################################
    2409              
    2410             sub extract_article_zeus
    2411             {
    2412 0     0 0   my ($string) = @_;
    2413 0           my @article;
    2414 0           my @line_array = split(/\n/,$string);
    2415 0           my $begin; my $in_lab;
    2416 0           my @authors;
    2417 0           my $string_lab;
    2418 0           foreach (@line_array)
    2419             {
    2420 0 0 0       if ((/\\Large/) && (/zeus/i)) { $begin = 1; }
      0 0 0        
        0 0        
        0 0        
        0 0        
        0 0        
        0 0        
          0        
          0        
          0        
          0        
          0        
          0        
    2421 0           elsif (($begin == 1) && (/\\newpage/)) { $begin = 0; last;}
      0            
    2422             elsif (($begin == 1) && (/,\s*$/) && (!(/\{\\it /)) && ($in_lab != 1)) {
    2423 0           s/\$\^\{[^}]+\}\$//;
    2424 0           my $author = $_;
    2425 0 0         if (/\\mbox/){ my @author_tempo = greplatexcom("mbox",["author"],$_); $author = bichop($author_tempo[0]->{author});}
      0            
      0            
    2426 0           push(@authors,$author); }
    2427 0           elsif (($begin == 1) && (/\\\\\s*$/) && (!(/\{\\it /)) && ($in_lab != 1)) { s/\$\^\{[^}]+\}\$//g;
      0            
    2428 0           my $author = $_;
    2429 0 0         if (/\\mbox/){ my @author_tempo = greplatexcom("mbox",["author"],$_); $author = bichop($author_tempo[0]->{author});}
      0            
      0            
    2430 0           push(@authors,$author);}
    2431 0           elsif (($begin == 1) && (/\{\\it /)) {$string_lab .= $_; $in_lab = 1; }
      0            
    2432             elsif (($begin == 1) && ($in_lab == 1) && (!(/\\par/))) {$string_lab .= $_;}
    2433             elsif (($begin == 1) && ($in_lab == 1) && (/\\par/)) {
    2434 0           $string_lab =~ s/^\s*//g;
    2435 0           my ($thelab,$next) = extract_bracketed($string_lab,"{");
    2436 0           $in_lab = 0; $string_lab ="";
      0            
    2437 0           $thelab = bichop($thelab); $thelab =~ s/\\it\s*//g;
      0            
    2438            
    2439 0           foreach (@authors)
    2440 0           { my @item;
    2441 0           push(@item,$_);
    2442 0           push(@item,$thelab);
    2443 0           push(@article,\@item);
    2444             }
    2445            
    2446 0           @authors = ();
    2447             }
    2448            
    2449             }
    2450 0           return @article;
    2451             }
    2452              
    2453             ####################################################################
    2454             #
    2455             # Collaboration 7: Fermilab
    2456             #
    2457             # Extract authors and lab for article with Fermilab report
    2458             #
    2459             # \begin{center}
    2460             # author1,$^1$
    2461             # author2,$^$2
    2462             # author3
    2463             # \end{center}
    2464             # \begin{enumerate}
    2465             # \item lab1
    2466             # \item lab2
    2467             # \end{enumerate}
    2468             #
    2469             # arXiv: hep-ex/0304017
    2470             #
    2471             ######################################################################
    2472              
    2473             sub extract_report_fermilab
    2474             {
    2475 0     0 0   my ($string) = @_;
    2476 0           my @article;
    2477 0           my @center = theenvs("center",$string);
    2478 0           my @enumerate = theenvs("enumerate",$string);
    2479 0           my $string_authors = $center[1];
    2480 0           my $string_labs = $enumerate[0];
    2481 0           my @labs = split(/\\item/,$string_labs);
    2482 0           my ($empty,@authors) = split(/\n/,$string_authors);
    2483            
    2484 0           foreach (@authors)
    2485             {
    2486 0           my @item;
    2487 0           s/\^\*,//g;
    2488 0           /([\w~\.-]+),?\$\^{?([\d]+)}?\$/;
    2489 0           push(@item,$1);
    2490 0           push(@item,$labs[$2]);
    2491 0           push(@article,\@item);
    2492             #print "
    $_ --- $1 --- $2";
    2493             }
    2494 0           return @article;
    2495             }
    2496            
    2497             1;
    2498              
    2499              
    2500             __END__