#!/usr/bin/perl
# Program Name: PDF Metadata Editor
# Program URL: http://www.arilabs.com/software/pdfmeta/pdfmeta.pl
# Filename: pdfmeta.pl
# Version: 1.3
# Last Modified: 2005-06-02
# Author: Brian High <bkh AT arilabs DOT com>
# Copyright: Analytical Resources, Inc. (2005)
# License: GNU GPL version 2 or greater. See LICENSE below.
# Requires: pdftk version 1.12 or greater, Perl/Tk
# pdftk must be in your environment's PATH
# Tested under: Mandrake 10.1.0 (KDE 3.2.3-99, Perl 5.8.5-3, Perl-Tk
# 804.027-2), Debian unstable (Kanotix 2005-01, KDE 3.3.2-1,
# Perl 5.8.4-6, Perl-Tk 800.025-2), Win2K Pro, and
# WinXP Pro (SP2) with ActivePerl 5.8.6.811.
# Known Issues: (1) Under Windows XP Pro SP2 and ActivePerl 5.8.6.811,
# Windows will not let me drop files onto Perl script icons,
# so you can use the drag-and-drop built into the script
# to select the PDF file (by dropping the file onto the
# listbox widget) or you can simply run the script
# from the command line. This issue is a function of
# how Windows works and may be addressed by some sort
# or "registry hack"[1] or "power toy". Anyway, if you
# really want to be able to drop PDFs right onto your
# script icon, you can simply create a DOS batch file
# or WSH/VBS script which will run pdfmeta.pl. Example:
# Type this one-liner into a file <pdfmeta.bat>:
# @perl pdfmeta.pl %1
# And save the file in the same folder as pdftk.exe and
# pdfmeta.pl. Then make a shortcut to pdfmeta.bat and
# place that shortcut on your desktop. Modify the shortcut
# properties so that the console window it brings up will
# be "minimized".
# Right-Click -> Properties -> Run: Minimized
# Rename the shortcut: PDF Metadata Editor
# (2) While the drag-and-drop (XDND, remote) works fine
# under Mandrake's KDE, it does not under Debian's (Kanotix)
# KDE. This may have something to do with window manager
# settings. I just get a cursor of a circle with a line
# through it. I will have to look into this...
#
# [1] For a discussion of your registry hacking options, see:
# http://www.perlmonks.org/?node=122205
# This program provides a simple and limited graphical interface for
# pdftk. It only provides the functionality to modify PDF metadata
# (document properties) fields.
# Usage: [ perl ] pdfmeta.pl [ <filename> ]
#
# You can either run from the command line, with or without a filename,
# or you can drag a file onto the script icon, if your desktop supports it,
# or you can execute the script by clicking the icon and you will be
# offered a drag and drop interface.
# NOTE: You must have write permissions for the directory which
# contains the original PDF file, as well as for the original
# PDF file itself.
# NOTE: Modify the @fieldnames array to use a different set of document
# properties (metadata fields). Use only standard PDF field names:
# Title, Author, Subject, Keywords, Creator, Producer, CreationDate,
# ModDate, and Trapped.
# PDFTK can be found here: http://www.accesspdf.com/pdftk/
# See also: http://hacks.oreilly.com/pub/h/2422
# Here is the pdftk man page section on the update_info feature:
#
# update_info <info data filename | - | PROMPT>
# Changes the metadata stored in a single PDF's
# Info dictionary to match the input data file.
# The input data file uses the same syntax as the
# output from dump_data. This does not change the
# metadata stored in the PDF's XMP stream, if it
# has one. For example:
#
# pdftk in.pdf update_info in.info output out.pdf
# Also, the author of pdftk (Sid Steward) has this to say about the
# XMP stream:
#
# PDFs store this metadata is two places: the Info dictionary and
# the XMP (RDF/XML) stream. Pdftk updates only the Info dictionary,
# but newer versions of Acrobat/Reader defer to the XMP stream.
#
# I am currently working on new features for updating both the Info
# dictionary and the XMP stream.
#
# One workaround might be to remove the PDF's XMP stream. You can do
# this using pdftk, but it also removes bookmarks and other PDF
# features. Run:
#
# pdftk mydoc.xmp.pdf cat output mydoc.no_xmp.pdf
#
# to burn of the XMP stream. Then maybe the viewer will fall back to
# the Info dictionary with your updated data.
#
# ( From: http://www.accesspdf.com/comment.php?mode=view&cid=153 )
# ====================================================================
# LICENSE: GNU GPL v2 or greater: http://www.gnu.org/licenses/gpl.txt
# ====================================================================
# 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 2 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.
use strict;
use warnings;
use File::Basename;
use File::Spec::Functions;
use File::Copy;
use POSIX;
use Tk;
use Tk::DropSite;
use constant SUCCESS => 1;
use constant FAILURE => 0;
use constant TRUE => 1;
use constant FALSE => 0;
use constant PROG_NAME => "PDF Metadata Editor";
use constant PROG_VERS => "1.3";
use constant FILE_SUFF => "-meta";
my (%fields, $err_msg, $main);
my ($input_fn, $output_fn, $meta_fn);
#----------------------------------------------------------------------
# Configuration
#----------------------------------------------------------------------
# PDFTK command to use. Include explicit path if necessary.
my $pdftk = "pdftk";
# You may modify the @fieldnames array to use a different set of document
# properties (metadata fields). Use only standard PDF field names:
# Title, Author, Subject, Keywords, Creator, Producer, CreationDate,
# ModDate, and Trapped. The order of field names in this array is the
# same as the order of the fields as listed on the user interface.
my @fieldnames = qw( Title Subject Author Keywords );
#----------------------------------------------------------------------
# Main Routine
#----------------------------------------------------------------------
&create_main_window();
&set_fonts();
&create_field_hash();
&get_input_file();
&MainLoop();
#----------------------------------------------------------------------
# Subroutines
#----------------------------------------------------------------------
sub create_main_window {
$main = MainWindow->new();
$main->title( PROG_NAME . " " . PROG_VERS );
}
sub set_fonts {
my $font_family = 'Helvetica';
my $large_size = 12;
my $small_size = 10;
$main->fontCreate( 'title',
-size => $large_size,
-weight => 'bold',
-family => $font_family,
);
$main->fontCreate( 'header',
-size => $large_size,
-family => $font_family,
);
$main->fontCreate( 'label',
-size => $small_size,
-weight => 'bold',
-family => $font_family,
);
$main->fontCreate( 'button',
-size => $small_size,
-family => $font_family,
);
$main->fontCreate( 'input',
-size => $small_size,
-family => $font_family,
);
}
sub create_field_hash {
# Create hash to store metadata fields and values
%fields = ();
foreach my $field ( @fieldnames ) {
$fields{$field} = '';
}
}
sub get_input_file {
# If a filename was given as an argument, use it
if ( $ARGV[0] ) {
$input_fn = $ARGV[0];
&get_metadata() && &complete_gui();
}
else {
# Otherwise offer drag and drop interface
&create_drop_widgets();
}
}
sub create_drop_widgets {
my $drop_label = $main->Label (
-text => "Drag your PDF file into the box below:",
-font => 'title',
)
->pack (
-ipadx => 12,
-ipady => 4,
-padx => 8,
-pady => 8,
);
# Define a DropSite (source side) for Drag and Drop functionality
my $drop = $main->Scrolled ( 'Listbox',
-scrollbars => "osoe",
-height => 1,
)
->pack (
-pady => 8,
);
# Tell Tk that $drop should accept drops.
# When dropping occurs, execute the accept_drop callback.
$drop->DropSite (
-dropcommand => [\&accept_drop, $drop],
-droptypes => ( $^O eq 'MSWin32' ? 'Win32' : 'XDND' )
);
}
sub accept_drop {
my( $widget, $selection ) = @_;
eval {
$input_fn = $widget->SelectionGet (
-selection => $selection, 'STRING' );
$input_fn =~ s/^file:(.*)/$1/;
};
if ( defined $input_fn ) {
$widget->insert( 0, $input_fn );
}
# After the file is dropped, hide the widgets, and present new widgets
&clean_gui();
&get_metadata() && &complete_gui();
}
sub clean_gui {
# Remove (hide) widgets on the form, if any
my @w = $main->packSlaves;
foreach (@w) { $_->packForget; }
}
sub complete_gui {
&clean_gui();
# Finish defining MainWindow attributes and add widgets
$main->Label (
-justify => 'left',
-text => "Filename: \n$input_fn",
-font => 'label',
)
->pack (
-anchor => 'w',
-padx => 8,
-pady => 8,
);
foreach my $field ( @fieldnames ) {
$main->Label (
-justify => 'left',
-text => "$field: ",
-font => 'label',
)
->pack (
-anchor => 'w',
-padx => 8,
);
$main->Entry (
-textvariable => \$fields{$field},
-font => 'input',
)
->pack (
-fill => 'x',
-padx => 8,
);
}
$main->Button (
-text => "Save Changes and Exit",
-font => 'button',
-command => sub { &save_and_exit(); },
)
->pack (
-side => 'left',
-ipadx => 12,
-ipady => 4,
-pady => 8,
-expand => TRUE,
);
$main->Button (
-text => "Close",
-font => 'button',
-command => sub { exit },
)
->pack (
-side => 'right',
-ipadx => 12,
-ipady => 4,
-pady => 8,
-expand => TRUE,
);
}
sub get_metadata {
my ( $input_fn_base, $input_fn_path, $input_fn_type );
$err_msg = "Input file must be a (single) PDF. Please try again.";
# If more than one file is selected, then show abort error
if ( defined( $output_fn ) ) {
undef $output_fn;
&show_msg() && &create_drop_widgets() && return FAILURE;
}
# Parse the file path, abort if not a PDF, create new file names
($input_fn_base, $input_fn_path, $input_fn_type) =
fileparse($input_fn, qr{\.pdf}i);
$input_fn_type =~ /\.pdf/i || &abort_me() && return FAILURE;
$output_fn = $input_fn_path . $input_fn_base . FILE_SUFF
. $input_fn_type;
$meta_fn = $input_fn_path . $input_fn_base . '.mta';
# Check to make sure we can read/write to files and directories
$err_msg = "Cannot read from and/or write to input file!";
(-r $input_fn && -w $input_fn) || &abort_me() && return FAILURE;
$err_msg = "Cannot write to $input_fn_path directory!\n\n" .
"You must place the original file in a writable directory\n" .
"before running this program.";
-w $input_fn_path || &abort_me() && return FAILURE;
# Dump the PDF's metadata to an ASCII text file and check for errors
&dump_meta_data() || &abort_me() && return FAILURE;
&check_for_dict() || &abort_me() && return FAILURE;
# Read metadata text file into %fields hash
$err_msg = "Error opening temporary metadata file for reading!";
open ( METADATA, "<", $meta_fn )
|| &abort_me() && return FAILURE;
while ( <METADATA> ) {
foreach my $field ( @fieldnames ) {
if ( /^InfoKey: $field$/ ) {
$_ = <METADATA>;
chomp;
s/^InfoValue: (.*)$/$1/;
$fields{$field} = $_;
}
}
}
&close_and_delete_metadata_file();
}
sub check_for_dict {
my $no_dict = FALSE;
# Read metadata text file to check for "no dictionary" error
$err_msg = "Error opening temporary metadata file for reading!";
open ( METADATA, "<", $meta_fn ) || return FAILURE;
while ( <METADATA> ) {
if ( /no info dictionary found/ ) {
$no_dict = TRUE;
last;
}
}
close METADATA;
# If there was no info dictionary, then create one and save metadata
if ( $no_dict ) {
# Delete metadata file
unlink $meta_fn;
# Use PDFTK to add a new info dictionary using the 'cat' feature
&cat_pdf() || return FAILURE;
# Move repaired file to orig. file, get metadata, then store in file
my $cmd = "$pdftk \"$input_fn\" dump_data > \"$meta_fn\" 2>&1";
$err_msg = "Error running pdftk dump_data command!";
move ( $output_fn, $input_fn ) && &dump_meta_data() || return FAILURE;
}
return SUCCESS;
}
sub dump_meta_data {
my $cmd = "$pdftk \"$input_fn\" dump_data > \"$meta_fn\" 2>&1";
$err_msg = "Error running dump_data command!\n\n";
system ( $cmd ) == 0 || ( &report_metadata_errors() && return FAILURE );
return SUCCESS
}
sub report_metadata_errors {
open ( METADATA, "<", $meta_fn ) || &abort_me() && return FAILURE;
local $/ = undef;
$err_msg .= <METADATA>;
&close_and_delete_metadata_file();
}
sub close_and_delete_metadata_file {
close METADATA;
unlink $meta_fn;
}
sub cat_pdf {
# Get current metadata info from input file and store in text file
$err_msg = "Error running pdftk cat command!";
system ( "$pdftk \"$input_fn\" cat output \"$output_fn\" "
. "dont_ask 2>&1" ) == 0 || return FAILURE;
return SUCCESS;
}
sub abort_me {
&clean_gui();
# Show an error message and an exit button
$main->Label (
-text => $err_msg,
-font => 'header',
)
->pack (
-ipadx => 12,
-ipady => 4,
-padx => 8,
-pady => 8,
);
$main->Button (
-text => "Exit",
-command => sub { exit },
-font => 'button',
)
->pack (
-ipadx => 12,
-ipady => 4,
-padx => 8,
-pady => 8,
);
}
sub show_msg {
&clean_gui();
# Show an error message and an exit button
$main->Label (
-text => $err_msg,
-font => 'header',
)
->pack (
-ipadx => 12,
-ipady => 4,
-padx => 8,
-pady => 8,
);
}
sub save_and_exit {
# Save new metadata to metadata file
$err_msg = "Error opening temporary metadata file for writing!";
open ( METADATA, ">", $meta_fn ) || &abort_me() && return FAILURE;
foreach my $field ( @fieldnames ) {
print METADATA "InfoKey: $field\n";
print METADATA "InfoValue: $fields{$field}\n";
}
# Write new metadata into new PDF file
system ( "$pdftk \"$input_fn\" " .
"update_info \"$meta_fn\" " .
"output \"$output_fn\" dont_ask" );
# Replace orig. PDF with new one, so that the old one has new metadata
$err_msg = "Error updating PDF! Changes are in:\n" . $output_fn;
move ( $output_fn, $input_fn ) || &abort_me() && return FAILURE;
# Delete metadata file. (The delete does not work without opening first.)
$err_msg = "Error opening temporary metadata file for reading!";
open ( METADATA, "<", $meta_fn ) || &abort_me() && return FAILURE;
&close_and_delete_metadata_file();
exit;
}
__END__
|
FORUM HardWare.fr
.
)
![[:spamafote]](https://forum-images.hardware.fr/images/perso/spamafote.gif "[:spamafote]")
![[:tinostar]](https://forum-images.hardware.fr/images/perso/tinostar.gif "[:tinostar]")
![[:chapi-chapo]](https://forum-images.hardware.fr/images/perso/chapi-chapo.gif "[:chapi-chapo]")
![[:pioupiou]](https://forum-images.hardware.fr/images/perso/pioupiou.gif "[:pioupiou]")
