#! /usr/bin/perl

#    cpbibart - Copy articles in files referenced in a latex file.
#    Copyright (C) 2008, 2009 Johan Arvelius, some parts copyright 
#    Nicola Talbot as indicated in the code.
#
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
#  version 0.4, Johan Arvelius, Swedish Institute of Space Physics, 
#    johan.arvelius@irf.se

use Switch;
use File::Basename;
#use File::Copy;
use Cwd;

my $article = $source = 0;
my $usage = 0;
my @suffixes = ("pdf","ps","ps.gz");
foreach $argument (@ARGV) {
  switch ($argument) {
    case /^(?:-a|--article)$/ {
      $article = 1;
    }
    case /^(?:-b|--bibfile)$/ {
      $bibfile = 1;
    }
    case /^(-d|--directories)/ {
      $argument =~ /^(-d|--directories)=?(.*)/;
      if ($2){
	  print "  Directories to search for articles: $2\n";
	  @directories = split(/,/,$2);
      }else{
	  $usage = 1;
	  print STDERR "  cpbibart: argument $1 must provide directories\n";
      } 
    }
    case /^(-f|--sources)/ {
      $argument =~ /^(?:-f|--sources)=?(.*)/;
      $bibfile = 1;
      $source = 1;
      if($1){
	print "  Suffixes for source files to copy: $1\n";
	@sourcesuf = split(/,/,$1);
      }else{
	@sourcesuf = ("tex","bbl");
      }
    }
    case /^(-h|--help)$/ {
      $usage = 1;
    }
    case /^(-l|--link)$/ {
      $linkfiles = 1;
      $usebbl = 1;
    }
    case /^(-L|--latex)/ {
      $argument =~ /^(?:-L|--latex)=?(.*)/;
      $linkfiles = 1;
      $usebbl = 1;
      if($1){
	$latexcommand = $1;
      }else{
	$latexcommand = "latex";
      }
    }
    case /^-[r]/ {
      $restlist = 1;
    }
    case /^(-s|--suffixes)=?(.*)/ {
      $argument =~ /^(-s|--suffixes)=?(.*)/;
      if ($2){	
	  print "  Suffixes for articles to copy: $2\n";
	  @suffixes = split(/,/,$2);
      }else{
	  $usage = 1;
	  print STDERR "  cpbibart: argument $1 must provide suffixes\n";
      }     
    }
    case /^(-u|--aux)$/ {
      $useaux = 1;
    }
    case /^(-v|--verbose)$/ {
      $verbose = 1;
    }
    case "--debug"{
      $debug = 1;
    }
    case /^[-]/ {
      $usage = 1;
      print STDERR "\n cpbibart: Unknown option: $argument\n";
    }
    else { 
      if ($file){
	  if(substr($argument,-1) eq "/"){
	      $target = substr($argument,0,-1);
	  }else{
	      $target = $argument;
	  }
      }else{
        ($file,$sourcedir,$extension) = fileparse($argument,'\..*');
	if($extension eq "aux" && !$useaux && !$usebbl){
	  $useaux = 1;
	}elsif($extension eq "bbl" && !$useaux && !$usebbl){
	  $usebbl = 1;
	}
      }
    }
  }
}

if ($usage || !$target){
  print "\n  cpbibart - Copy articles in files referenced in a latex file.\n\n";
  print "  cpbibart reads the .bbl or .aux file from a latex run and copies files\n";
  print "  with filenames similar to cite keys in the latex file from a set of\n";
  print "  directories to a target directory.\n\n";
  print "  Usage:\n";
  print "   cpbibart [options] sourcefile targetdir \n\n";
  print "      sourcefile may be .bbl, .aux or only basename without suffix.\n\n";
  print "   options are:\n";
  print "     -a|--article   Copy typset article also to targetdir.\n";
  print "     -b|--bibfile   Generate a .bib file with the used citations.\n";
  print "        --debug     Print debug messages.\n";
  print "     -d|--directories=directory1[,directory2...]\n";
  print "                    Directories to search for articles.\n";
  print "     -f|--sources[=suffix1[,suffix2...]]\n";
  print "                    Copy full sources to article to targetdir.\n";
  print "                    Files with given suffixes will be copied.\n";
  print "                    Default is tex,bbl.\n";
  print "     -h|--help      Print this help.\n";
  print "     -l|--link      Add links to articles in the .bbl file. The .bbl file\n";
  print "                    generated by bibtex will be backed up in a .bbl~ file.\n";
  print "                    The links are inserted as latex \\url{} commands which needs\n";
  print "                    package url to be displayed or href to be working links.\n";
  print "     -L|--latex[=command]\n";
  print "                    run command on the texfile after regeneration of the .bbl\n";
  print "                    file. Default command is latex. Implies -l.\n";
  print "     -r             Print list of citations where no corresponding file is found\n";
  print "                    to STDOUT\n";
  print "     -s|--suffixes=suffix1[,suffix2[,...]]\n";
  print "                    Suffixes for articles to look for in priority order. Only\n";
  print "                    first match for each article will be copied. Default is pdf,\n";
  print "                    ps,ps.gz.\n";
  print "     -u|--aux       Read citation keys from .aux file instead of .bbl file.\n";
  print "     -v|--verbose   Print verbose output\n";
  exit;
}

$startdir = cwd();
if (substr($target,0,1) eq "/"){
    $absolutetarget = $target;
}else{
    $absolutetarget = "$startdir/$target";
}

unless($useaux){
  $usebbl = 1;
}

unless(scalar(@directories)){
  if (eval "use File::HomeDir; 1"){
    my $home = File::HomeDir->my_home;
    if (-d "$home/papers"){
      @directories = ("$home/papers");
      &verbose("Setting directory to default $home/papers");
    }else{
      die "There's no directory $home/papers. Please provide the -d switch. \n";
    }
  }else{
    die "I don't know where to look for papers. Please provide the -d switch. \n";
  }
}
#if ($usebbl){
#  use lib ('/home/johan/perl/');
#  use latex;
#}
    
sub eatinitialspaces
{
    #This function is adopted from makedtx written by Dr Nicola Talbot
    #http://www.tug.org/texlive/Contents/live/texmf-dist/doc/latex/makedtx/
    #released under  The LaTeX Project Public License (lppl)
    #http://www.ctan.org/tex-archive/help/Catalogue/licenses.lppl.html
    #and included in the texlive distribution
    
   my ($STR) = @_;

   while (substr($STR,0,1) eq "\s")
   {
      $STR = substr($STR,1);
   }

   return $STR;
}

sub getnextgroup{
  getnextbracket("{}",@_);
}

sub getnextbracket
{
    #This function is adopted from makedtx written by Dr Nicola Talbot
    #http://www.tug.org/texlive/Contents/live/texmf-dist/doc/latex/makedtx/
    #released under  The LaTeX Project Public License (lppl)
    #http://www.ctan.org/tex-archive/help/Catalogue/licenses.lppl.html
    #and included in the texlive distribution
  
  my($bracketpair,$curline) = @_;
  my $startbracket = substr($bracketpair,0,1);
  my $endbracket = substr($bracketpair,1,1);

   $curline = eatinitialspaces($curline);

   # check to see if current string is blank

   if ($curline!~/[^\s]+/m)
   {
      return ("","",0);
   }

   if (($group = substr($curline,0,1)) ne $startbracket)
   {
       # next group hasn't been delimited with braces
       # return first non-whitespace character

       $curline = substr($curline,1);

       # unless it's a backslash, in which case get command name

       if ($group eq "\\")
       {
          if ($curline=~/([a-zA-Z]+)(^[a-zA-Z].*)/m)
          {
             $group = $1;

             $curline = $2;
          }
          else
          {
             # command is made up of backslash followed by symbol

             $curline=~/([\W_0-9\s\\])(.*)/m;

             $group = $1;

             $curline = $2;
          }
       }

       return ($group,$curline,1);
   }

   my $pos=index($curline, $startbracket);
   my $startpos=$pos;
   my $posopen=0;
   my $posclose=0;

   my $bracelevel = 1;

   my $done=0;

   while (!$done)
   {
      $pos++;

      $posopen = index($curline, $startbracket, $pos);

      # check to make sure it's not a \{

      while ((substr($curline, $posopen-1,1) eq "\\") and ($posopen > 0))
      {
         # count how many backlashes come before it.

         $i = $posopen-1;

         $numbs = 1;

         while ((substr($curline, $i-1,1) eq "\\") and ($i > 0))
         {
            $numbs++;
            $i--;
         }

         # is $numbs is odd, we have a \{, otherwise we have \\{

         if ($numbs%2 == 0)
         {
            last;
         }
         else
         {
            $posopen = index($curline, $startbracket, $posopen+1);
         }
      }

      $posclose= index($curline, $endbracket, $pos);

      # check to make sure it's not a \}

      while ((substr($curline, $posclose-1,1) eq "\\") and ($posclose > 0))
      {
         # count how many backlashes come before it.

         $i = $posclose-1;

         $numbs = 1;

         while ((substr($curline, $i-1,1) eq "\\") and ($i > 0))
         {
            $numbs++;
            $i--;
         }

         # is $numbs is odd, we have a \}, otherwise we have \\}

         if ($numbs%2 == 0)
         {
            last;
         }
         else
         {
            $posclose = index($curline, $endbracket, $posclose+1);
         }
      }

      if (($posopen==-1) and ($posclose==-1))
      {
         $done=1;
      }
      elsif ($posopen==-1)
      {
         $pos=$posclose;

         $bracelevel--;

         if ($bracelevel==0)
         {
            $group = substr($curline, $startpos+1, $pos-$startpos-1);

            $curline = substr($curline, $pos+1);

            return ($group,$curline,1);
         }
      }
      elsif ($posclose==-1)
      {
         $pos=$posopen;

         $bracelevel++;
      }
      elsif ($posopen<$posclose)
      {
         $pos=$posopen;

         $bracelevel++;
      }
      elsif ($posclose<$posopen)
      {
         $pos=$posclose;

         $bracelevel--;

         if ($bracelevel==0)
         {
            $group = substr($curline, $startpos+1, $pos-$startpos-1);

            $curline = substr($curline, $pos+1);

            return ($group,$curline,1);
         }
      }
   }

   # closing brace must be on another line

   return ("", $curline, 0);

}

sub debug {
    if ($debug){
	my ($printstr) = @_;
	print "[DEBUG]: $printstr \n";
    }
}

sub verbose {
    if ($verbose){
	my ($printstr) = @_;
	print "$printstr \n";
    }
}

sub searcharticle {
  my ($filefound,$article) = @_;
  foreach $dir (@directories){
    if ($filefound){
	&verbose("breaking");
	last;
    }
    &verbose("looking in $dir");
    foreach $suf (@suffixes){
	&verbose("looking for $dir/$article.$suf");
	if (-e "$dir/$article.$suf"){
	  &verbose("found $dir/$article.$suf");
	  #copy( "$dir/$article.$suf", "$target")
	      #or print STDERR "couldn't copy file $dir/$article.$suf to $target : $!";
	  system("cp $dir/$article.$suf $target") == 0
	    or print STDERR "couldn't copy file $dir/$article.$suf to $target : $!";
	  $filefound = 1;
	  $articlefilename = "$article.$suf";
	  &verbose("copied $dir/$article.$suf to $target");
	  last;
	}
    }
  }
  unless ($filefound){
    if($verbose || $restlist){
      print "no file found for $article \n";
    }
  }
  return $filefound,$articlefilename;
}

if($target){
  if (-d $target){
    unless (-w $target){
      die "You don't have writing permissions to $target; exiting.\n";
    }
  }else{
    system("mkdir $target") == 0 or die "couldn't create directory $target: $!\n";
  }
}

my $filefound = 0;

if($useaux){
  open(AUXFILE, "$sourcedir$file.aux") 
      or die "couldn't open file $sourcedir$file.aux for reading: $!\n";

  while (<AUXFILE>){
    if ($_ =~ /^\\bibcite{([\w\d]*)}/){
      $filefound = 0;
      ($filefound) = &searcharticle($filefound,$1);
    }
  }
}else{
  open(BBLFILE, "$sourcedir$file.bbl") 
      or die "couldn't open file $sourcedir$file.bbl for reading: $!\n";
  if($linkfiles){
    open(TMPFILE, "> \#$file.bbl") 
	or die "couldn't open file \#$file.bbl for writing: $!\n";
    print TMPFILE "%Processed by cpbibart.pl \n";
  }
  while ($nextline = <BBLFILE>){
    if($nextline eq "%Processed by cpbibart.pl \n"){
      $processed = 1;
      &verbose("$file.bbl already processed by cpbibart since earlier");
    }
    if($nextline eq "\n" && $filefound){
      print TMPFILE " [\\url{$articlefilename}]\n";
    }
    print TMPFILE "$nextline";
    if ($nextline =~ /^([^%]*)\\bibitem(.*)/){
      $beginline = $1;
      ($sqgroup,$restofline,$done) = getnextbracket("[]",$2);
      $startline = $.;
      &debug("bbl sq bibitem: $2");
      &debug("bbl squaregroup: $sqgroup");
      while (!$done){
	if ($nextline = <BBLFILE>){
	  print TMPFILE "$nextline";
	  $line = $line . " " . $nextline;
	  $restofline = $restofline . " " . $nextline;
	  ($group,$restofline,$done) = getnextbracket("[]",$restofline);
	  &debug("bbl bibitemloop: $beginline");
	}
	else{
	  die "EOF found whilst scanning mandatory argument to \\bibitem on line $startline\n";
	}
      }      
      &debug("bbl curly: $restofline");
      ($group,$restofline,$done) = getnextgroup($restofline);
      $startline = $.;
      &debug("bbl curlyrest: $restofline");
      &debug("bbl group: $group");
      while (!$done){	
	if ($nextline = <BBLFILE>){
	  print TMPFILE "$nextline";
	  $line = $line . " " . $nextline;
	  $restofline = $restofline . " " . $nextline;
	  ($group,$restofline,$done) = getnextgroup($restofline);
	  &debug("bbl bibitemloop: $beginline");
	}
	else{
	  die "EOF found whilst scanning argument to \\bibitem on line $startline\n";
	}
      }
      $filefound = 0;
      ($filefound,$articlefilename) = &searcharticle($filefound,$group);
    }
  }
}
close(BBLFILE);

if($bibfile){
  chdir "$sourcedir" or die "couldn't cd to $sourcedir: $!\n";
  if(system("aux2bib $file.aux > $absolutetarget/$file.bib") == 0){
    &verbose("generated $absolutetarget/$file.bib from $file.aux.");
  }else{
    print STDERR "couldn't generate .bib file\n";
    if(-e "$file.bib"){
      system("cp $file.bib $absolutetarget") == 0
	or print STDERR "couldn't copy file $sourcedir$file.bib to $absolutetarget : $!";
      &verbose("copied existing bibfile $sourcedir$file.bib to $absolutetarget instead.");
    }
  }
  chdir "$startdir" or die "couldn't cd to $startdir: $!\n";
}

if($linkfiles){
  close(TMPFILE);
  unless($processed){
    system("cp $sourcedir$file.bbl $sourcedir$file.bbl~") == 0
      or print STDERR "couldn't move file $sourcedir$file.bbl to $sourcedir$file.bbl~ : $!";
    system("cp \#$file.bbl $sourcedir$file.bbl") == 0
      or print STDERR "couldn't move file \#$file.bbl to $sourcedir$file.bbl : $!";
  }
}

if ($latexcommand){
  chdir "$sourcedir" or die "couldn't cd to $sourcedir: $!\n";
  &verbose("changed to $sourcedir running latexcommand: $latexcommand $file");
  system("$latexcommand $file");
  chdir "$startdir" or die "couldn't cd to $startdir: $!\n";
}

&verbose("source = $source ");
if ($source){
  foreach $suf (@sourcesuf){
    if (-e "$sourcedir$file.$suf"){
      system("cp $sourcedir$file.$suf $target") == 0
	or print STDERR "couldn't copy file $sourcedir$file.$suf to $target : $!";
      &verbose("copied $sourcedir$file.$suf to $target");
    }else{
      print STDERR "couldn't find file $sourcedir$file.$suf";
    }
  }
}

if($article){
  $filefound = 0;
  foreach $suf (@suffixes){
    &verbose("looking for $sourcedir$file.$suf ");
    if (-e "$sourcedir$file.$suf"){
      &verbose("found $sourcedir$file.$suf ");
      system("cp $sourcedir$file.$suf $target") == 0
	or print STDERR "couldn't copy file $sourcedir$file.$suf to $target : $!";
      $filefound = 1;
      &verbose("copied $sourcedir$file.$suf to $target");
      last;
    }
  }
}
__END__

=pod

=head1 NAME

cpbibart - Copy articles in files referenced in a latex file.

=head1 SYNOPSIS

cpbibart [options] sourcefile targetdir

cpbibart B<--help>

=head1 DESCRIPTION

B<cpbibart> is used to make a bundle of a LaTeX document and the
documents it cites. 

I<Note that at the moment only files with
filenames similar to the cite key used in the latex document and an
extension can be found. If you don't practice this behaivour this
program is of no use to you. Sorry :(>

B<cpbibart> reads the .bbl or .aux file from a latex run and copies
files with filenames similar to cite keys in the latex file from a set
of directories to a target directory, creating the target directory if
it doesn't exist. The set of directories to search for articles may be
set by the B<-d> option.

As the .bbl file is used bibtex must be run before cpbibart

=over 4

=item 1. [pdf]latex

=item 2. bibtex

=item 3. cpbibart

=back

Optionally the typeset file and/or the source code for it may also be
copied to the target directory by providing the B<-a> or B<-f>
options. In that case links to the copied references may optionally be
put in the bibliography by the B<-l> or B<-L> option. This is done by
manipulation of the bbl file and a rerun of latex (with B<-L>) in the
source directory thus overwriting the existent typeset file and .bbl
file before copying to the target directory. For the links to work the
href package must be loaded in the latex document.

If the the I<-l> or I<-L> switches that overwrites .bbl and .dvi or
.pdf files the originals is received again by a rerun of bibtex and
latex.  

=over 4

=item 1. [pdf]latex

=item 2. bibtex

=item 3. cpbibart

=item 4. bibtex

=item 5. [pdf]latex

=back

A bibtex .bib file including the cited references may also be
generated with the aux2bib program if present, and added to the target
directory with the B<-b> option.

=head1 OPTIONS

=over 4

=item B<-a>, B<--article> Copy typset article also to targetdir.

=item B<-b>, B<--bibfile> Generate a .bib file with the used
citations.

=item B<--debug> Print debug messages.

=item B<-d>I<directory1[,directory2...]>,
               B<--directories>=I<directory1[,directory2...]>
               Directories to search for articles.

=item B<-f>I<[suffix1[,suffix2...]]>,
               B<--sources>I<[=suffix1[,suffix2...]]> Copy full
               sources to article to targetdir.  Files with given
               suffixes will be copied.  Default is tex,bbl.

=item B<-h>, B<--help> Print this help.

=item B<-l>, B<--link> Add links to articles in the .bbl file. The
               .bbl file generated by bibtex will be backed up in a
               .bbl~ file.  The links are inserted as latex \\url{}
               commands which needs package url to be displayed or
               href to be working links.

=item B<-L>I<[command]>, B<--latex>I<[=command]> run command on the
               texfile after regeneration of the .bbl file. Default
               command is latex. Implies -l.

=item B<-r> Print list of citations where no corresponding file is
               found to STDOUT

=item B<-s>I<suffix1[,suffix2[,...]]>,
               B<--suffixes>=I<suffix1[,suffix2[,...]]> Suffixes for
               articles to look for in priority order. Only first
               match for each article will be copied. Default is pdf,
               ps,ps.gz.

=item B<-u>, B<--aux> Read citation keys from .aux file instead of
.bbl file.

=item B<-v>, B<--verbose> Print verbose output

=back

=head1 DIAGNOSTICS

B<cpbibart> is usually running silently with only error messages to
STDERR. However some helpful progress output can be achieved by the
B<-v> option. A list of citations in the text to which no
corresponding files have been found can be generated by the B<-r>
option. The debug option B<--debug> is probably not of any use.

A usage message can is written to STDOUT by the B<-h> option.

=head1 EXAMPLE

cpbibart -a -dpapers -f -Lpdflatex -r foo.bbl mytargetdir

will

=over 4

=item 1. Copy the papers cited in the article foo.tex to mytargetdir.

=item 2. Print a list of papers not found to STDOUT.

=item 3. Backup foo.bbl to foo.bbl~.

=item 4. Insert links to the found papers in foo.bbl.

=item 5. Run the command C<pdflatex foo>.

=item 6. Copy foo.tex, foo.bbl, the newly generated foo.pdf (and if present since earlier foo.ps) to mytargetdir.  

=back

=head1 BUGS

Probably

=head1 RESTRICTIONS

Only files with names similar to the citekeys are found.

Only for UN*X-like systems.

=head1 AUTHORS

Johan Arvelius, johan.arvelius@irf.se

Code from Dr Nicola Talbot included.

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008, 2009 Johan Arvelius, some parts copyright 
Nicola Talbot as indicated in the code.

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.