view release on metacpan or  search on metacpan

lib/App/PDFLibrarian/BibTeX.pm  view on Meta::CPAN

    $pdfinfo{Author} = remove_tex_markup($bibentry->get("author") // $bibentry->get("editor") . " ed.");
    $pdfinfo{Title} = remove_tex_markup($bibentry->get("title"));
    $pdfinfo{Subject} = remove_tex_markup($bibentry->get("abstract"));
    $pdf->infoMetaAttributes(keys(%pdfinfo));
    $pdf->info(%pdfinfo);
    $pdf->preferences(-displaytitle => 1);

    # write XMP metadata to PDF file
    my $xmp = "";
    eval {
      $xmp = $pdf->xmpMetadata() // "";
    };
    my $xmphead = "<?xpacket begin='' id='W5M0MpCehiHzreSzNTczkc9d'?>\n";
    my $xmpdata = encode('utf-8', $xml->documentElement()->toString(0), Encode::FB_CROAK);
    my $xmptail = "\n<?xpacket end='w'?>";
    my $xmplen = length($xmphead) + length($xmpdata) + length($xmptail);
    my $xmppadlen = length($xmp) - $xmplen;
    if ($xmppadlen <= 0) {
      $xmppadlen = max(4096, 2*length($xmp), 2*length($xmpdata)) - $xmplen;
    }
    my $xmppad = ((" " x 99) . "\n") x int(1 + $xmppadlen / 100);
    my $newxmp = $xmphead . $xmpdata . substr($xmppad, 0, $xmppadlen) . $xmptail;
    $pdf->xmpMetadata($newxmp);

    # write PDF file
    eval {
      $pdf->update();
      $pdf->end();
      1;
    } or do {
      chomp(my $error = $@);
      print STDERR "$Script: could not save PDF file '$pdffile': $error\n";
      $bibentry = undef;
    };

    return $bibentry;
  };
  @modbibentries = parallel_loop("writing BibTeX entries to %i/%i PDF files", \@modbibentries, $body);

  return @modbibentries;
}

sub edit_bib_in_fh {
  my ($oldfh, @bibentries) = @_;
  die unless blessed($oldfh) eq 'File::Temp';

  # save checksums of BibTeX entries
  my %checksums;
  foreach my $bibentry (@bibentries) {
    $checksums{$bibentry->get('file')} = $bibentry->get('checksum');
  }

  # edit and re-read BibTeX entries, allowing for errors
  my @errors;
  while (1) {

    while (1) {

      # open new temporary file for editing BibTeX entries
      my $fh = File::Temp->new(SUFFIX => '.bib', EXLOCK => 0) or croak "$Script: could not create temporary file";
      binmode($fh, ":encoding(iso-8859-1)");

      # write header message
      if (@errors > 0) {
        print $fh wrap("% ", "% ", <<"EOF");
PDFLibrarian has encountered several errors in parsing the following BibTeX records. These errors are indicated with comments next to the line where the errors occurred.

All errors MUST be corrected before the BibTeX records can be written back to the PDF file given by the 'file' field in each record.

To ABORT ANY CHANGES from being written, simply delete the relevant records, or the entire contents of this file.
EOF
      } else {
        print $fh wrap("% ", "% ", <<"EOF");
PDFLibrarian has extracted the following BibTeX records for editing. Any changes to the records will be written back to the PDF file given by the 'file' field in each record.

To ABORT ANY CHANGES from being written, simply delete the relevant records, or the entire contents of this file.
EOF
      }
      if (%bibtex_macros > 0) {
        print $fh "%\n% Available BibTeX macros:\n";
        foreach my $macro (keys %bibtex_macros) {
          print $fh "% $macro: $bibtex_macros{$macro}\n";
        }
      }
      print $fh "\n";

      # build hash of errors by line number
      my %errorsbyline;
      foreach (@errors) {
        if (defined($_->{from})) {
          push @{$errorsbyline{$_->{from}}}, $_->{msg};
        } else {
          push @{$errorsbyline{0}}, $_->{msg};
        }
      }

      # write any error messages without line numbers
      if (defined($errorsbyline{0})) {
        foreach (@{$errorsbyline{0}}) {
          print $fh "% ERROR: $_\n";
        }
        delete $errorsbyline{0};
        print $fh "\n";
      }

      # write contents of old temporary file, with any error messages inline
      $oldfh->flush();
      $oldfh->seek(0, SEEK_SET);
      while (<$oldfh>) {
        chomp;
        my $line = sprintf("%i", $oldfh->input_line_number);
        foreach (@{$errorsbyline{$line}}) {
          print $fh "% ERROR: $_\n";
        }
        delete $errorsbyline{$line};
        s/\s+$//;
        next if /^%/;
        next if /^$/;
        print $fh "$_\n";
        if (/^}$/) {
          print $fh "\n";
        }
      }
      $fh->flush();

      # write any remaining error messages
      foreach (keys %errorsbyline) {
        foreach (@{$errorsbyline{$_}}) {
          print $fh "% ERROR: $_\n";
        }
      }

      # print index of all currently-defined keywords
      print $fh keyword_display_str();

      # save handle to new temporary file; old temporary file is deleted
      $oldfh = $fh;

      # edit BibTeX entries
      my $editor = $ENV{'VISUAL'} // $ENV{'EDITOR'} // 'editor';
      printf STDERR "$Script: opening %i BibTeX entries in editing program '$editor' ...\n", scalar(@bibentries);
      system($editor, $fh->filename) == 0 or croak "$Script: could not edit file '$fh->filename' with editing program '$editor'";

      # try to re-read BibTeX entries
      read_bib_from_file(\@errors, \@bibentries, $fh->filename);

      # error if duplicate BibTeX keys are found
      foreach my $dupkey (find_dup_bib_keys(@bibentries)) {
        push @errors, { msg => "duplicated key '$dupkey'" };
      }

      foreach my $bibentry (@bibentries) {

        # error if required fields are empty
        foreach my $bibfield ($structure->required_fields($bibentry->type)) {
          my $bibfieldvalue = $bibentry->get($bibfield) // "";
          $bibfieldvalue =~ s/[{}]//g;
          if ($bibfieldvalue eq "") {
            push @errors, { msg => "entry '@{[$bibentry->key]}' is missing required field '${bibfield}'" };
          }
        }

        # error if BibTeX entries contain field names which differ by 's', e.g. 'keyword' and 'keywords'
        foreach my $bibfield ($bibentry->fieldlist()) {
          if ($bibentry->exists($bibfield) && $bibentry->exists($bibfield . "s")) {
            push @errors, { msg => "entry '@{[$bibentry->key]}' contains duplicate fields '${bibfield}' and '${bibfield}s'" };
          }
        }
      }

      # BibTeX entries have been successfully read
      last if @errors == 0;

    }

    {
      # open new temporary file for editing BibTeX entries
      my $fh = File::Temp->new(SUFFIX => '.bib', EXLOCK => 0) or croak "$Script: could not create temporary file";
      binmode($fh, ":encoding(iso-8859-1)");

      # format and print BibTeX entries
      write_bib_to_fh({ fh => $fh }, format_bib({}, @bibentries));
      $fh->flush();

      # save handle to new temporary file; old temporary file is deleted
      $oldfh = $fh;

      # try to re-read BibTeX entries
      read_bib_from_file(\@errors, \@bibentries, $fh->filename);
    }

    # BibTeX entries have been successfully read
    last if @errors == 0;

  }

  # restore checksums of BibTeX entries
  foreach my $bibentry (@bibentries) {
    $bibentry->set('checksum', $checksums{$bibentry->get('file')});
  }

  return @bibentries;
}

sub find_dup_bib_keys {
  my (@bibentries) = @_;

  # find duplicate keys in BibTeX entries
  my %keycount;
  foreach my $bibentry (@bibentries) {
    ++$keycount{$bibentry->key};
  }

  return grep { $keycount{$_} > 1 } keys(%keycount);
}

sub format_bib_authors {
  my ($nameformat, $maxauthors, $etal, @authors) = @_;

  # format authors
  my $authorformat = new Text::BibTeX::NameFormat($nameformat);
  foreach my $author (@authors) {
    $author = $authorformat->apply($author);
    $author = remove_tex_markup($author);
    if ($author =~ /\sCollaboration$/i) {
      $author =~ s/\s.*$//;
    }
  }

  if (@authors > 0) {

    # limit number of authors to '$maxathors'
    if (defined($maxauthors) && $maxauthors > 0 && @authors > $maxauthors) {
      @authors = ($authors[0], $etal);
    }

    # replace 'others' with preferred form of 'et al.'
    $authors[-1] = $etal if $authors[-1] eq "others";