pod2pdf-0.42/0000755000076500007650000000000010710320301012022 5ustar jjjj00000000000000pod2pdf-0.42/artistic-2_0.txt0000644000076500007650000002130610672267542015015 0ustar jjjj00000000000000 The Artistic License 2.0 Copyright (c) 2000-2006, The Perl Foundation. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble This license establishes the terms under which a given free software Package may be copied, modified, distributed, and/or redistributed. The intent is that the Copyright Holder maintains some artistic control over the development of that Package while still keeping the Package available as open source and free software. You are always permitted to make arrangements wholly outside of this license directly with the Copyright Holder of a given Package. If the terms of this license do not permit the full use that you propose to make of the Package, you should contact the Copyright Holder and seek a different licensing arrangement. Definitions "Copyright Holder" means the individual(s) or organization(s) named in the copyright notice for the entire Package. "Contributor" means any party that has contributed code or other material to the Package, in accordance with the Copyright Holder's procedures. "You" and "your" means any person who would like to copy, distribute, or modify the Package. "Package" means the collection of files distributed by the Copyright Holder, and derivatives of that collection and/or of those files. A given Package may consist of either the Standard Version, or a Modified Version. "Distribute" means providing a copy of the Package or making it accessible to anyone else, or in the case of a company or organization, to others outside of your company or organization. "Distributor Fee" means any fee that you charge for Distributing this Package or providing support for this Package to another party. It does not mean licensing fees. "Standard Version" refers to the Package if it has not been modified, or has been modified only in ways explicitly requested by the Copyright Holder. "Modified Version" means the Package, if it has been changed, and such changes were not explicitly requested by the Copyright Holder. "Original License" means this Artistic License as Distributed with the Standard Version of the Package, in its current version or as it may be modified by The Perl Foundation in the future. "Source" form means the source code, documentation source, and configuration files for the Package. "Compiled" form means the compiled bytecode, object code, binary, or any other form resulting from mechanical transformation or translation of the Source form. Permission for Use and Modification Without Distribution (1) You are permitted to use the Standard Version and create and use Modified Versions for any purpose without restriction, provided that you do not Distribute the Modified Version. Permissions for Redistribution of the Standard Version (2) You may Distribute verbatim copies of the Source form of the Standard Version of this Package in any medium without restriction, either gratis or for a Distributor Fee, provided that you duplicate all of the original copyright notices and associated disclaimers. At your discretion, such verbatim copies may or may not include a Compiled form of the Package. (3) You may apply any bug fixes, portability changes, and other modifications made available from the Copyright Holder. The resulting Package will still be considered the Standard Version, and as such will be subject to the Original License. Distribution of Modified Versions of the Package as Source (4) You may Distribute your Modified Version as Source (either gratis or for a Distributor Fee, and with or without a Compiled form of the Modified Version) provided that you clearly document how it differs from the Standard Version, including, but not limited to, documenting any non-standard features, executables, or modules, and provided that you do at least ONE of the following: (a) make the Modified Version available to the Copyright Holder of the Standard Version, under the Original License, so that the Copyright Holder may include your modifications in the Standard Version. (b) ensure that installation of your Modified Version does not prevent the user installing or running the Standard Version. In addition, the Modified Version must bear a name that is different from the name of the Standard Version. (c) allow anyone who receives a copy of the Modified Version to make the Source form of the Modified Version available to others under (i) the Original License or (ii) a license that permits the licensee to freely copy, modify and redistribute the Modified Version using the same licensing terms that apply to the copy that the licensee received, and requires that the Source form of the Modified Version, and of any works derived from it, be made freely available in that license fees are prohibited but Distributor Fees are allowed. Distribution of Compiled Forms of the Standard Version or Modified Versions without the Source (5) You may Distribute Compiled forms of the Standard Version without the Source, provided that you include complete instructions on how to get the Source of the Standard Version. Such instructions must be valid at the time of your distribution. If these instructions, at any time while you are carrying out such distribution, become invalid, you must provide new instructions on demand or cease further distribution. If you provide valid instructions or cease distribution within thirty days after you become aware that the instructions are invalid, then you do not forfeit any of your rights under this license. (6) You may Distribute a Modified Version in Compiled form without the Source, provided that you comply with Section 4 with respect to the Source of the Modified Version. Aggregating or Linking the Package (7) You may aggregate the Package (either the Standard Version or Modified Version) with other packages and Distribute the resulting aggregation provided that you do not charge a licensing fee for the Package. Distributor Fees are permitted, and licensing fees for other components in the aggregation are permitted. The terms of this license apply to the use and Distribution of the Standard or Modified Versions as included in the aggregation. (8) You are permitted to link Modified and Standard Versions with other works, to embed the Package in a larger work of your own, or to build stand-alone binary or bytecode versions of applications that include the Package, and Distribute the result without restriction, provided the result does not expose a direct interface to the Package. Items That are Not Considered Part of a Modified Version (9) Works (including, but not limited to, modules and scripts) that merely extend or make use of the Package, do not, by themselves, cause the Package to be a Modified Version. In addition, such works are not considered parts of the Package itself, and are not subject to the terms of this license. General Provisions (10) Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license. (11) If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license. (12) This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder. (13) This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement, then this Artistic License to you shall terminate on the date that such litigation is filed. (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. pod2pdf-0.42/bin/0000755000076500007650000000000010710320301012572 5ustar jjjj00000000000000pod2pdf-0.42/bin/pod2pdf0000755000076500007650000002003610672267542014107 0ustar jjjj00000000000000#! /Users/jj/bin/perl # pod2pdf.pl - converts Pod to PDF format # # Copyright (C) 2007 Jon Allen # # This software is licensed under the terms of the Artistic # License version 2.0. # # For full license details, please read the file 'artistic-2_0.txt' # included with this distribution, or see # http://www.perlfoundation.org/legal/licenses/artistic-2_0.html #--Load required modules and activate Perl's safety features--------------- use strict; use warnings; use App::pod2pdf; use File::Basename qw/basename/; use File::Spec::Functions; use FindBin qw/$Bin/; use Getopt::ArgvFile qw/argvFile/; use Getopt::Long; use POSIX qw(locale_h); #--Load config files------------------------------------------------------- # Define config filename as .conf (my $configfile = basename($0)) =~ s/^(.*?)(?:\..*)?$/$1.conf/; # Include config file from the same directory as the pod2pdf script if (-e "$Bin/$configfile") { unshift @ARGV,'@'."$Bin/$configfile"; } # If we have been packaged with PAR, include the config file from the # application bundle if ($ENV{PAR_TEMP} and -e "$ENV{PAR_TEMP}/inc/$configfile") { unshift @ARGV,'@'."$ENV{PAR_TEMP}/inc/$configfile"; } argvFile(); # Process @ARGV to load specified config files. (Function # from Getopt::ArgvFile - interpolates "@filename" entries # in @ARGV with the contents of the specified file) #--Parse command-line options---------------------------------------------- my %options = ( 'page-height' => '=i', 'page-width' => '=i', 'page-size' => '=s', 'page-orientation' => '=s', 'margins' => '=i', 'left-margin' => '=i', 'right-margin' => '=i', 'top-margin' => '=i', 'bottom-margin' => '=i', 'header' => '!', 'footer' => '!', 'title' => '=s', 'footer-text' => '=s', 'icon' => '=s', 'icon-scale' => '=s', 'timestamp' => '!', 'output-file' => '=s', ); my %config; GetOptions(\%config, optionspec(%options), version => sub{ print "This is pod2pdf, version $App::pod2pdf::VERSION\n"; exit } ) or die("[Error] Could not parse options"); $config{title} = (@ARGV) ? $ARGV[0] : 'STDIN' unless (exists $config{title}); $config{title} .= (' - ' . ((@ARGV) ? scalar localtime($^T - (-M $ARGV[0])*24*60*60) : scalar localtime)) if (exists $config{timestamp}); #--Set output location----------------------------------------------------- if (my $outfile = $config{output_file}) { open STDOUT,'>',$outfile or die("Cannot open output file $outfile: $!\n") } #--Tell the OS we are going to create binary data-------------------------- setlocale(LC_ALL,'C'); binmode *STDOUT; #--Parse our Pod----------------------------------------------------------- my $parser = App::pod2pdf->new(%config); (@ARGV) ? $parser->parse_from_file($ARGV[0]) : $parser->parse_from_filehandle(\*STDIN); $parser->output; exit; #-------------------------------------------------------------------------- sub optionspec { my %option_specs = @_; my @getopt_list; while (my ($option_name,$spec) = each %option_specs) { (my $variable_name = $option_name) =~ tr/-/_/; (my $nospace_name = $option_name) =~ s/-//g; my $getopt_name = ($variable_name ne $option_name) ? "$variable_name|$option_name|$nospace_name" : $option_name; push @getopt_list,"$getopt_name$spec"; } return @getopt_list; } #-------------------------------------------------------------------------- #-------------------------------------------------------------------------- =head1 NAME pod2pdf - converts Pod to PDF format =head1 DESCRIPTION pod2pdf converts documents written in Perl's POD (Plain Old Documentation) format to PDF files. =head2 Usage pod2pdf [options] input.pod >output.pdf If no input filename is specified, pod2pdf will read from STDIN, e.g. perldoc -u File::Find | pod2pdf [options] >File-Find.pdf =head2 Options pod2pdf accepts the following command-line options: =over =item C<--output-file> Sets the output filename for the generated PDF file. By default pod2pdf will output to STDOUT. =item C<--page-size> Sets the page size to be used in the PDF file, can be set to any of the standard paper sizes (A4, A5, Letter, etc). Defaults to A4. =item C<--page-orientation> Controls if pages are produces in landscape or portrait format. Defaults to 'portrait'. =item C<--page-width>, C<--page-height> Sets the width and height of the generated pages in points (for using non-standard paper sizes). =item C<--left-margin>, C<--right-margin>, C<--top-margin>, C<--bottom-margin> Allows each of the page margins (top, bottom, left, and right) to be individually set in points. =item C<--margins> Sets all page margins to the same size (specified in points). =item C<--header>, C<--noheader> Controls if a header (containing the page title, and optional timestamp and icon) will be included on each page. Defaults to on, so use C<--noheader> to disable. =item C<--title> Sets the page title (defaults to the input filename). =item C<--timestamp> Boolean option - if set, includes the 'last modified' timestamp of the input file in the page header. =item C<--icon> Filename of an icon to be displayed in the top left corner of each page. =item C<--icon-scale> Scaling value for the header icon (defaults to 0.25). =item C<--footer>, C<--nofooter> Controls if a footer (containg the current page number and optional text string) will be included on each page. By default the footer will be included, so use C<--nofooter> to disable. =item C<--footer-text> Sets an optional footer text string that will be included in the bottom left corner of each page. =item C<--version> Prints version number and exits. =back =head2 Configuration files Sets of command-line options may be saved into configuration files. A configuration file contains options in the same format as used by pod2pdf on the command-line, with one option given on each line of the file, e.g. --page-size A5 --page-orientation landscape To use a config file, invoke pod2pdf with the option C<@/path/to/configfile.conf>. For example, if you wanted to always include a company logo, timestamp, and copyright notice in your PDF files, create a file F containing the following: --icon "/path/to/your/logo.png" --footer-text "Copyright 2007 MyCompany Limited" --timestamp Then invoke pod2pdf as: pod2pdf @/path/to/mycompany.conf input.pod >output.pdf If you create a config file called F and place this in the same directory as the pod2pdf script, it will be loaded as the default configuration. =head1 POD ENTENSIONS As well as the standard POD commands (see L), pod2pdf supports the following extensions to the POD format: =over =item C<=ff> The C<=ff> command inserts a page bread (form feed) into the document. =item C<< OE...E >> The C<< OE...E >> formatting code inserts an external object (file) into the document. This is primarily intended for embedding images, e.g. O to insert diagrams, etc into documentation. pod2pdf supports the file types JPG, GIF, TIFF, PNG, and PNM for embedded objects. =back =head1 DEPENDENCIES pod2pdf requires the following modules to be installed: =over =item L =item L =item L =back Additionally to use images, the modules L and L must be installed, and to specify alternative page sizes the L module is required. =head1 SEE ALSO The pod2pdf homepage: L For more information about POD, read the L manpage or see the POD page on the Perl 5 Wiki (L). =head1 COPYRIGHT and LICENSE Copyright (C) 2007 Jon Allen (JJ) This software is licensed under the terms of the Artistic License version 2.0. For full license details, please read the file F included with this distribution, or see L. pod2pdf-0.42/Changes0000644000076500007650000000036110710320115013320 0ustar jjjj00000000000000Changelog for pod2pdf (see http://perl.jonallen.info/projects/pod2pdf) 0.42 - 26 October 2007 Fixed failing "compile.t" test 0.41 - 11 September 2007 First public release to CPAN Now compatible with the latest PDF::API2 distribution pod2pdf-0.42/lib/0000755000076500007650000000000010710320301012570 5ustar jjjj00000000000000pod2pdf-0.42/lib/App/0000755000076500007650000000000010710320301013310 5ustar jjjj00000000000000pod2pdf-0.42/lib/App/pod2pdf.pm0000644000076500007650000010235110710320226015214 0ustar jjjj00000000000000# App::pod2pdf # # Copyright (C) 2007 Jon Allen # # This software is licensed under the terms of the Artistic # License version 2.0. # # For full license details, please read the file 'artistic-2_0.txt' # included with this distribution, or see # http://www.perlfoundation.org/legal/licenses/artistic-2_0.html package App::pod2pdf; use strict; use warnings; use Carp; use List::Util qw/max min/; use PDF::API2; use Pod::Escapes qw/e2char/; use Pod::Parser; use Pod::ParseLink; use constant TRUE => 1; use constant FALSE => 0; BEGIN { our @ISA = qw/Pod::Parser/; our $VERSION = '0.42'; } #----------------------------------------------------------------------- #----------------------------------------------------------------------- sub new { my $invocant = shift; my $class = ref($invocant) || $invocant; my %user_options = @_; my %default_options = ( header => TRUE, # Include header on all pages footer => TRUE, # Include footer on all pages page_width => 595, # A4 page_height => 842, # A4 left_margin => $user_options{margins} || 48, # 0.75" right_margin => $user_options{margins} || 48, # 0.75" top_margin => $user_options{margins} || 60, # bottom_margin => $user_options{margins} || 60, # font_face => 'Helvetica', # Sans-Serif text font_size => 10, # Text size = 10 points icon_scale => 0.25, # Icon scaling (%age) ); my $self = $class->SUPER::new(%default_options,%user_options); $self->create_pdf; return $self; } #----------------------------------------------------------------------- sub command { my ($self, $command, $paragraph, $line_num) = @_; my $expansion = $self->interpolate($paragraph, $line_num); COMMAND: { if ($command eq 'ff') { $self->formfeed if ($self->print_flag); } if ($command =~ /^head[1234]$/) { $self->indent(0); $self->set_style('default'); $self->newline; my $default_space = $self->{line_spacing}; $self->set_style($command); my $heading_space = $self->{line_spacing}; # Checks to see if there is space for a content line after # the heading - if not then starts a new page if ( ($self->{y_position} - $heading_space - $default_space - $self->{spacer}) < ($self->{bottom_margin} + $self->{footer_height}) ) { $self->formfeed; } else { $self->{y_position} -= ($heading_space - $default_space); } $self->print_text_with_style($expansion,$command); $self->spacer; $self->indent(48); } if ($command eq 'over') { my $indentlevel = $expansion || 4; $self->set_style; $self->push_indent($indentlevel * $self->em); $self->reset_item_textblock_flag; } if ($command eq 'back') { $self->pop_indent; $self->spacer; } if ($command eq 'item') { $self->spacer if ($self->item_textblock_flag); $self->reset_item_textblock_flag; if ($expansion =~ '^\s*\*?\s*$') { # First check to see if there is space for any text if ($self->{y_position} - $self->{line_spacing} < ($self->{bottom_margin} + $self->{footer_height})) { $self->formfeed; } my $indent = $self->pop_indent; $self->bullet($indent); $self->push_indent($indent); } elsif ($expansion =~ '^\s*(\d+\.?)\s*$') { # First check to see if there is space for any text if ($self->{y_position} - $self->{line_spacing} < ($self->{bottom_margin} + $self->{footer_height})) { $self->formfeed; } my $indent = $self->pop_indent; $self->{y_position} -= $self->{line_spacing}; $self->print_text_with_style($1,'default'); $self->push_indent($indent); $self->{y_position} += $self->{line_spacing}; } else { my $indent = $self->pop_indent; $self->set_style; $self->newline; $self->parse_text({-expand_ptree => 'print_tree'},$paragraph,$line_num); $self->spacer; $self->push_indent($indent); } } } } #----------------------------------------------------------------------- sub verbatim { my ($self, $paragraph, $line_num) = @_; if ($paragraph =~ /^[ \t]/) { $self->set_style('verbatim'); $self->reset_space_flag; $self->set_item_textblock_flag; foreach my $line (split /\n/,$paragraph) { # todo: expand tabs if ($line =~ /\S/) { $self->newline; $self->print_text_with_style($line,'verbatim'); $self->reset_space_flag; } } $self->newline; $self->spacer unless ($self->over); } } #----------------------------------------------------------------------- sub textblock { my ($self, $text, $line_num) = @_; if ($text =~ /\S/) { # ignore blank paragraphs $self->set_item_textblock_flag; $self->reset_space_flag; $self->set_style; $self->newline; $self->parse_text({-expand_ptree => 'print_tree'},$text,$line_num); $self->spacer; $self->spacer unless ($self->over); } } #----------------------------------------------------------------------- sub interior_sequence { my ($self,$command,$text) = @_; # # need to check content of $text, i.e. # is there a nested formatting command? # # also this doesn't handle the L<> formatting # command, check with perlpodspec if this is # allowed in =head blocks # COMMAND: { if ($command eq 'X') { # no-op last COMMAND; } if ($command eq 'Z') { # no-op last COMMAND; } if ($command eq 'E') { return e2char($text); } DEFAULT: { return $text; } } } #----------------------------------------------------------------------- sub print_tree { my $self = shift; my $tree = shift; NODE: foreach my $node ($tree->children) { if (ref $node) { COMMAND: { my $command = $node->cmd_name; if ($command eq 'L') { #warn("Found link: ".$node->raw_text."\n"); my $left_delimiter = $node->left_delimiter; my $right_delimiter = $node->right_delimiter; (my $link_text = $node->raw_text) =~ s/L$left_delimiter\s*(.*?)\s*$right_delimiter$/$1/s; my ($text, $inferred, $name, $section, $type) = parselink($link_text); $text =~ s/^"(.*?)"$/$1/ if ($text); $inferred =~ s/^"(.*?)"$/$1/ if ($inferred); $name =~ s/^"(.*?)"$/$1/ if ($name); $self->push_format('I'); $self->parse_text({-expand_ptree => 'print_tree'},($text || $inferred || $name)); $self->pop_format; last COMMAND; } if ($command eq 'O') { my $left_delimiter = $node->left_delimiter; my $right_delimiter = $node->right_delimiter; (my $object_text = $node->raw_text) =~ s/O$left_delimiter\s*(.*?)\s*$right_delimiter$/$1/; my ($object_title,$object_location) = parseobject($object_text); if ($object_location =~ /\A\W+:[^:\s]\S*\z/) { # URL - cannot load (yet!) $self->warnonce('HTTP object loading not supported'); $self->print_text_with_style($object_location,'I'); } elsif (-e $object_location) { # Found file if ($self->images) { my $mime_type = File::Type->new->mime_type($object_location); if ($mime_type =~ /^image/) { unless ($self->insert_image($object_location)) { $self->print_text_with_style($object_location,'I'); } } else { $self->print_text_with_style($object_location,'I'); } } else { $self->print_text_with_style($object_location,'I'); } } else { # Non-existant file $self->warnonce("Object not found: $object_location"); $self->print_text_with_style("Object not found: $object_location",'I'); } last COMMAND; } if ($command eq 'X') { # no-op } DEFAULT: { $self->push_format($node->cmd_name); $self->print_tree($node->parse_tree); $self->pop_format; } } } else { FORMAT: { $_ = $self->format; if (/X/) { # no-op last FORMAT; } if (/Z/) { # no-op last FORMAT; } if (/E/) { $node = e2char($node); } if (/BC.*I/) { $self->print_text_with_style($node,'BCI'); last FORMAT; } if (/C.*I/) { $self->print_text_with_style($node,'CI'); last FORMAT; } if (/B.*I/) { $self->print_text_with_style($node,'BI'); last FORMAT; } if (/BC/) { $self->print_text_with_style($node,'BC'); last FORMAT; } if (/B/) { $self->print_text_with_style($node,'B'); last FORMAT; } if (/C/) { $self->print_text_with_style($node,'C'); last FORMAT; } if (/I/) { $self->print_text_with_style($node,'I'); last FORMAT; } DEFAULT: { #warn "Line 414: $_\n"; $self->print_text_with_style($node,'default'); last FORMAT; } } } } } #----------------------------------------------------------------------- sub insert_image { my $self = shift; my $filename = shift; if ($self->images) { if (-e $filename) { my $image; my $type = File::Type->new->checktype_filename($filename); SWITCH: { if ($type eq 'image/jpeg') {$image = $self->{pdf}->image_jpeg($filename); last} if ($type eq 'image/tiff') {$image = $self->{pdf}->image_tiff($filename); last} if ($type eq 'image/gif') {$image = $self->{pdf}->image_gif($filename); last} if ($type eq 'image/x-png') {$image = $self->{pdf}->image_png($filename); last} if ($type eq 'image/x-pnm') {$image = $self->{pdf}->image_pnm($filename); last} $self->warnonce("[Warning] Unknown image format '$type' for image '$filename'"); return FALSE; } unless ($image) { $self->warnonce("[Warning] Cannot load image file '$filename'"); return FALSE; } my ($width,$height) = imgsize($filename); my $available_width = $self->{page_width} - $self->{right_margin} - $self->{x_position}; my $scale_default = 0.5; my $scale_min = 0.4; my $scale = min($available_width / $width, $scale_default); my $height_in_points = $height * $scale; if ($self->{y_position} < ($self->{bottom_margin} + $self->{footer_height} + $height_in_points + ($self->{line_spacing} / 2))) { my $available_height = $self->{y_position} - $self->{bottom_margin} - $self->{footer_height} - $self->{line_spacing}; if ($available_height / $height > $scale_min) { $scale = $available_height / $height; $height_in_points = $height * $scale; } else { $self->formfeed; $self->set_print_flag; } } $self->{y_position} -= $height_in_points; $self->{y_position} += ($self->{line_spacing} / 2); $self->{gfx} = $self->{page}->gfx unless (exists $self->{gfx}); $self->{gfx}->image($image,$self->{x_position},$self->{y_position},$scale); return TRUE; } else { $self->warnonce("Image '$filename' does not exist"); return FALSE; } } } #----------------------------------------------------------------------- sub images { my $self = shift; unless ($self->{image_modules_check}) { # Check if image modules are installed eval "use File::Type;use Image::Size;"; if ($@) { $self->warnonce('Cannot use images, modules Image::Size and/or File::Type not installed'); } else { $self->{image_modules_loaded} = TRUE; } $self->{image_modules_check} = TRUE; } return $self->{image_modules_loaded}; } #----------------------------------------------------------------------- sub warnonce { my $self = shift; my $warning = shift; unless ($self->{issued_warnings}->{$warning}) { warn("[Warning] $warning\n"); $self->{issued_warnings}->{$warning} = TRUE; } } #----------------------------------------------------------------------- sub parseobject { # Parses the O<...> formatting code as specified in perlpodextensions my $object_text = shift; if ($object_text =~ /(.*?)\|(.*)/) { return ($1,$2); } else { return (undef,$object_text); } } #----------------------------------------------------------------------- sub create_pdf { my $self = shift; my $class = ref $self; my $version = $::{$class.'::'}{VERSION} ? ${ $::{$class.'::'}{VERSION} } : 'unknown'; # Define styles # # Future enhancement: move the style definitions into a separate # module (e.g. Pod::Pdf::Styles) which can be subclassed to allow # non-core fonts to be used. # $self->{stylist} = { 'header' => {font=>'Helvetica-Bold', size=>10 }, 'footer' => {font=>'Helvetica-Bold', size=>10 }, 'head1' => {font=>'Helvetica-Bold', size=>12 }, 'head2' => {font=>'Helvetica-Bold', size=>11 }, 'head3' => {font=>'Helvetica-Bold', size=>10 }, 'head4' => {font=>'Helvetica', size=>10 }, 'verbatim' => {font=>'Courier', verbatim=>TRUE }, 'B' => {font=>'Helvetica-Bold' }, 'BC' => {font=>'Courier-Bold', verbatim=>TRUE }, 'BI' => {font=>'Helvetica-BoldOblique' }, 'BCI' => {font=>'Courier-BoldOblique', verbatim=>TRUE }, 'C' => {font=>'Courier', verbatim=>TRUE }, 'CI' => {font=>'Courier-Oblique', verbatim=>TRUE }, 'I' => {font=>'Helvetica-Oblique' }, }; # Set up first page PAGE_SIZE: { if ($self->{page_size}) { eval "use Paper::Specs 0.10 units=>'pt';"; if ($@) { $self->warnonce("Cannot use '--page-size' option, module Paper::Specs (v0.10) not installed"); } else { if (my $form = Paper::Specs->find(code=>$self->{page_size}, brand=>'standard')) { $self->{page_width} = int($form->sheet_width + 0.5); $self->{page_height} = int($form->sheet_height + 0.5); } else { $self->warnonce("Unknown page size '".$self->{page_size}."'"); } } } } PAGE_ORIENTATION: { if ($self->{page_orientation}) { if (lc $self->{page_orientation} eq 'landscape') { ($self->{page_width},$self->{page_height}) = ( max($self->{page_width},$self->{page_height}), min($self->{page_width},$self->{page_height}) ); last PAGE_ORIENTATION; } if (lc $self->{page_orientation} eq 'portrait') { ($self->{page_width},$self->{page_height}) = ( min($self->{page_width},$self->{page_height}), max($self->{page_width},$self->{page_height}) ); last PAGE_ORIENTATION; } $self->warnonce("Unknown page orientation '".$self->{page_orientation}."', must be 'portrait' or 'landscape'"); } } $self->{page_number} = 0; $self->{line_spacing} = $self->{font_size}+2 unless ($self->{line_spacing}); $self->{x_position} = $self->{left_margin}; $self->{y_position} = $self->{page_height} - $self->{top_margin}; $self->{indent} = 0; $self->{pdf} = PDF::API2->new; $self->{pdf}->info('Producer'=>"$class version $version"); $self->{pdf}->mediabox($self->{page_width},$self->{page_height}); if ($self->{icon} && $self->images) { if (-e $self->{icon}) { my $type = File::Type->new->checktype_filename($self->{icon}); SWITCH: { if ($type eq 'image/jpeg') {$self->{icon_img} = $self->{pdf}->image_jpeg($self->{icon}); last} if ($type eq 'image/tiff') {$self->{icon_img} = $self->{pdf}->image_tiff($self->{icon}); last} if ($type eq 'image/gif') {$self->{icon_img} = $self->{pdf}->image_gif($self->{icon}); last} if ($type eq 'image/x-png') {$self->{icon_img} = $self->{pdf}->image_png($self->{icon}); last} if ($type eq 'image/x-pnm') {$self->{icon_img} = $self->{pdf}->image_pnm($self->{icon}); last} warn "[Warning] Unknown image format '$type' for icon ".$self->{icon}."\n"; } if ($self->{icon_img}) { ($self->{icon_width},$self->{icon_height}) = imgsize($self->{icon}); } } else { warn("[Warning] Cannot open icon file: ".$self->{icon}."\n"); } } $self->formfeed; $self->set_style; $self->{indent} = 0; $self->{over} = 0; $self->{spacer} = 4; # default spacing between paragraphs } #----------------------------------------------------------------------- #----------------------------------------------------------------------- # Item_textblock_flag methods # # This flag is used to control line spacing within =over sections. The # flag is cleared after each =item command and set whenever a textblock # is printed. # # At the start of processing an =item command, an extra half line space # (4 points) is inserted if the textblock flag is set. Because half # spacing is the default in =over sections, this extra space between # individual =items acts to visually group the =item paragraphs as a # single element. #----------------------------------------------------------------------- sub item_textblock_flag { my $self = shift; return $self->{item_textblock_flag}->{$self->over} || 0; } #----------------------------------------------------------------------- sub set_item_textblock_flag { my $self = shift; $self->{item_textblock_flag}->{$self->over} = TRUE; } #----------------------------------------------------------------------- sub reset_item_textblock_flag { my $self = shift; $self->{item_textblock_flag}->{$self->over} = FALSE; } #----------------------------------------------------------------------- #----------------------------------------------------------------------- # Print_flag methods # # The Print flag is used to prevent blank lines from appearing at the # start of a page, which can happen if a verbatim block or =over list # crosses a page break. # # When a new page is started, the print flag is reset. In this state # any calls to newline() or spacer() will have no effect. Whenever any # text is printed, the print flag will be set, then newlines will # operate nomally. #----------------------------------------------------------------------- sub print_flag { my $self = shift; return $self->{print_flag} || 0; } #----------------------------------------------------------------------- sub set_print_flag { my $self = shift; $self->{print_flag} = TRUE; } #----------------------------------------------------------------------- sub reset_print_flag { my $self = shift; $self->{print_flag} = FALSE; } #----------------------------------------------------------------------- #----------------------------------------------------------------------- # Space_flag methods # # The space flag is used to prevent the display of whitespace characters # at the end of a paragraph. If these characters are not suppressed, # then occasionally they will wrap onto the next line, causing unsightly # spaces in the finished document. # # Each string presented to the print_text_with_style() method is checked # for trailling whitespace. If so, the space_flag is set. At the next # call to print_text_with_style(), an extra space character is printed # if the space_flag is set. The space_flag is cleared either when the # spacer() method is called (to mark the 'real' end of a text block), or # after the flag has caused a new space to be inserted. #----------------------------------------------------------------------- sub space_flag { my $self = shift; return $self->{space_flag} || 0; } #----------------------------------------------------------------------- sub set_space_flag { my $self = shift; $self->{space_flag} = TRUE; } #----------------------------------------------------------------------- sub reset_space_flag { my $self = shift; $self->{space_flag} = FALSE; } #----------------------------------------------------------------------- sub flag { my $self = shift; my $flag = shift or return FALSE; return $self->{flags}->{$flag} || FALSE; } #----------------------------------------------------------------------- sub set_flag { my $self = shift; my $flag = shift or return FALSE; $self->{flags}->{$flag} = TRUE; } #----------------------------------------------------------------------- sub clear_flag { my $self = shift; my $flag = shift or return FALSE; $self->{flags}->{$flag} = FALSE; } #----------------------------------------------------------------------- #----------------------------------------------------------------------- # Text indent methods #----------------------------------------------------------------------- sub indent { # Sets the current indent (measured in points) my $self = shift; $self->{indent} = shift; $self->{x_position} = $self->{left_margin} + $self->{indent}; } #----------------------------------------------------------------------- sub over { # Returns the current number of nested =over blocks my $self = shift; return $self->{over}; } #----------------------------------------------------------------------- sub em { # Returns the width (in points) of an 'm' character, used by =over X # to decide how much to indent by my $self = shift; return $self->{mspace}; } #----------------------------------------------------------------------- sub push_indent { my $self = shift; my $indent = shift; push @{$self->{indent_list}},$indent; $self->indent($self->{indent} + $indent); $self->{over}++; } #----------------------------------------------------------------------- sub pop_indent { my $self = shift; $self->{over}--; if (@{$self->{indent_list}}) { my $indent = pop @{$self->{indent_list}}; $self->indent($self->{indent} - $indent); return $indent; } else { return 0; } } #----------------------------------------------------------------------- #----------------------------------------------------------------------- # Text format methods # # During parsing, as each Pod::InteriorSequence object is encountered # the formatting code (B, I, etc) is pushed onto a stack. When the # parser gets to the individual text elements, the format() method will # return the complete set of codes which need to be applied to the text. #----------------------------------------------------------------------- sub push_format { my $self = shift; my $format = shift; push @{$self->{format}},$format; } #----------------------------------------------------------------------- sub pop_format { my $self = shift; return pop @{$self->{format}} if (@{$self->{format}}); } #----------------------------------------------------------------------- sub format { # Returns the current text format as a scalar, e.g. 'BEI' for Bold # Italic with Escapes to be processed. Formatting codes are listed in # alphabetical order with duplicates removed. my $self = shift; my %format; foreach (@{$self->{format}}) { # Treat F<> as a synonym for I<> (renders filenames in italic) tr/F/I/; $format{$_}++; } return join '',sort keys %format; } #----------------------------------------------------------------------- #----------------------------------------------------------------------- sub bullet { # Draws a bullet point (filled circle) at the current text position # # Todo: need to remove the integer values here and replace with # percentages of the current line spacing to handle different fonts my $self = shift; my $indent = shift; my $bullet = $self->{page}->gfx; my $x_coord = $self->{left_margin} + $self->{indent} + 4 + $indent - 20; my $y_coord = $self->{y_position} - 9 + ($self->print_flag ? 0 : $self->{line_spacing}); my $radius = 2; $bullet->circle($x_coord,$y_coord,$radius); $bullet->fillstroke; } #----------------------------------------------------------------------- sub newline { my $self = shift; if ($self->print_flag) { $self->linefeed; $self->set_flag('newline'); } } #----------------------------------------------------------------------- sub linefeed { my $self = shift; $self->{y_position} -= $self->{line_spacing}; $self->{x_position} = $self->{left_margin} + $self->{indent}; if ($self->{y_position} < ($self->{bottom_margin} + $self->{footer_height})) { my $style = $self->{style}; $self->formfeed; $self->set_style($style); } } #----------------------------------------------------------------------- sub spacer { my $self = shift; $self->reset_space_flag; if ($self->print_flag) { $self->{y_position} -= $self->{spacer}; $self->{x_position} = $self->{left_margin} + $self->{indent}; if ($self->{y_position} < ($self->{bottom_margin} + $self->{footer_height})) { $self->formfeed; } } } #----------------------------------------------------------------------- sub formfeed { my $self = shift; $self->{page} = $self->{pdf}->page; $self->{x_position} = $self->{left_margin} + $self->{indent}; $self->{page_number}++; delete $self->{text}; delete $self->{gfx}; $self->{gfx} = $self->{page}->gfx; $self->{text} = $self->{page}->text; $self->{y_position} = $self->{page_height} - $self->{top_margin} - $self->{line_spacing}; $self->{header_height} = ($self->{header}) ? $self->generate_header : 0; $self->{footer_height} = ($self->{footer}) ? $self->generate_footer : 0; $self->{y_position} -= $self->{header_height}; $self->reset_print_flag; } #----------------------------------------------------------------------- #----------------------------------------------------------------------- # Page header and footer methods # # Future enhancement: pass the page number, filename, etc details as # parameters to generate_header() and generate_footer(), allow these # methods to be overridden by the user for custom page formatting. #----------------------------------------------------------------------- sub generate_header { my $self = shift; $self->set_style('header'); my $header_padding = 2; my $header_spacing = 3; my $header_height = $self->{text_size} + $header_spacing + $header_padding; # Draw header icon if ($self->{icon_img}) { my $icon_height_in_points = $self->{icon_height} * $self->{icon_scale}; if ($icon_height_in_points > $self->{text_size}) { $header_height += ($icon_height_in_points - $self->{text_size}); } my $ypos = $self->{page_height} - $self->{top_margin} - $icon_height_in_points; $self->{gfx}->image($self->{icon_img},$self->{left_margin},$ypos,$self->{icon_scale}); } # Add page title my $x = $self->{page_width} - $self->{right_margin} - $self->{text}->advancewidth($self->{title}); my $y = $self->{page_height} - $self->{top_margin} - $header_height + $header_spacing + $header_padding; $self->{text}->textlabel($x,$y,$self->{fontcache}->{$self->{font}},$self->{text_size},$self->{title}); # Draw horizontal line $self->{gfx}->move($self->{left_margin},$self->{page_height}-$self->{top_margin}-$header_height + $header_padding); $self->{gfx}->line($self->{page_width}-$self->{right_margin},$self->{page_height}-$self->{top_margin}-$header_height + $header_padding); $self->{gfx}->stroke; return $header_height; } #----------------------------------------------------------------------- sub generate_footer { my $self = shift; $self->set_style('footer'); # Add page footer my $t = 'Page '.$self->{page_number}; my $x = $self->{page_width} - $self->{right_margin} - $self->{text}->advancewidth($t); my $y = $self->{bottom_margin}; $self->{text}->textlabel($x,$y,$self->{fontcache}->{$self->{font}},$self->{text_size},$t); if ($self->{footer_text}) { $x = $self->{left_margin}; $self->{text}->textlabel($x,$y,$self->{fontcache}->{$self->{font}},$self->{text_size},$self->{footer_text}); } $self->{gfx} = $self->{page}->gfx unless (exists $self->{gfx}); $self->{gfx}->move($self->{left_margin},$self->{bottom_margin}+10); $self->{gfx}->line($self->{page_width}-$self->{right_margin},$self->{bottom_margin}+10); $self->{gfx}->stroke; return 18; # Footer height in points } #----------------------------------------------------------------------- #----------------------------------------------------------------------- # PDF file output # # When the PDF object goes out of scope, the generated PDF file will be # printed to STDOUT. # # Update - this doesn't work with PAR, need explicit $pdf->output() method #----------------------------------------------------------------------- sub output { my $self = shift; print $self->{pdf}->stringify; #$self->{pdf}->end; } #----------------------------------------------------------------------- #----------------------------------------------------------------------- # Text printing methods #----------------------------------------------------------------------- sub print { my $self = shift; my $text = shift; $self->newline; $self->print_text_with_style($text); } #----------------------------------------------------------------------- sub print_text_with_style { my $self = shift; my $text = shift; my $style = shift; #warn "print_text_with_style called with style '$style', text '$text'\n"; $self->set_style($style); # Remove double spaces unless we are printing verbatim text unless ($self->{stylist}->{$self->{style}}->{verbatim}) { $text =~ s/(\s)\s+/$1/g; } if ($self->space_flag) { # # Note that this space appears in the default style, # but it should be printed in the previous style. # $self->reset_space_flag; $self->set_style('default'); $self->print_word(' '); $self->set_style($style); } if ($text =~ s/\s+$//) { $self->set_space_flag; } while ($text =~ /(\s+|\S+)/g) { my $word = $1; $self->print_word($word); } } #----------------------------------------------------------------------- sub print_word { my $self = shift; my $word = shift; # If we are at the start of a line (newline flag is set) and we are # NOT printing verbatim text, then suppress any whitespace. if ($self->flag('newline')) { #warn "newline flag set\n"; #warn "x position = $self->{x_position}\n"; } $self->set_print_flag; $self->clear_flag('newline'); my $width = $self->{text}->advancewidth($word); if ($self->{x_position} + $width > $self->{page_width} - $self->{right_margin}) { # If the word will not fit on one line, split it up and recurse the 'print_word' sub if ($width > ($self->{page_width} - $self->{left_margin} - $self->{right_margin} - $self->{indent})) { my $fit = int(($self->{page_width} - $self->{left_margin} - $self->{right_margin} - $self->{indent}) / $self->{nspace}); my @words = (substr($word,0,$fit),substr($word,$fit)); #warn "Recursing... Word=$word Fit=$fit Xpos=$$self{x_position}\n"; $self->print_word($_) foreach @words; return; } $self->newline; if ($word =~ /^\s+$/) { unless ($self->{stylist}->{$self->{style}}->{verbatim}) { return; } } } $self->{x_position} += $self->{text}->textlabel($self->{x_position}, $self->{y_position}, $self->{fontcache}->{$self->{font}}, $self->{text_size}, $word, -color => $self->{text_color}); if ($self->{x_position} > $self->{page_width} - $self->{right_margin}) { $self->newline; } } #----------------------------------------------------------------------- #----------------------------------------------------------------------- # Text style methods #----------------------------------------------------------------------- sub set_style { my $self = shift; my $style = shift || 'default'; $style = (exists $self->{stylist}->{$style}) ? $style : 'default'; #carp "Setting style to $style"; # Create font object if necessary my $font = ($self->{stylist}->{$style}->{font} || $self->{font_face}) . ((exists $self->{stylist}->{$style}->{type}) ? '-'.$self->{stylist}->{$style}->{type} : ''); unless (exists $self->{fontcache}->{$font}) { $self->{fontcache}->{$font} = $self->{pdf}->corefont($font); } $self->{style} = $style; $self->{font} = $font; $self->{text_color} = $self->{stylist}->{$style}->{color} || '#000000'; $self->{text_size} = $self->{stylist}->{$style}->{size} || $self->{font_size}; $self->{text}->font($self->{fontcache}->{$font},$self->{text_size}); $self->{nspace} = $self->{text}->advancewidth('n'); $self->{mspace} = $self->{text}->advancewidth('m'); } #----------------------------------------------------------------------- #----------------------------------------------------------------------- 1; pod2pdf-0.42/Makefile.PL0000644000076500007650000000202210672267542014020 0ustar jjjj00000000000000# $Id$ use ExtUtils::MakeMaker; eval "use Test::Manifest"; unless( $@ ) { no warnings; *ExtUtils::MM_Any::test_via_harness = sub { my($self, $perl, $tests) = @_; return qq| $perl "-MTest::Manifest" | . qq|"-e" "run_t_manifest(\$(TEST_VERBOSE), '\$(INST_LIB)', | . qq|'\$(INST_ARCHLIB)')"\n|; }; } WriteMakefile( 'NAME' => 'pod2pdf', 'AUTHOR' => 'Jon Allen ', 'ABSTRACT' => 'Converts Pod to PDF format', 'VERSION_FROM' => 'lib/App/pod2pdf.pm', 'EXE_FILES' => [ 'bin/pod2pdf' ], 'PREREQ_PM' => { 'PDF::API2' => 0.60, 'Pod::Parser' => 0, 'Pod::ParseLink' => 0, 'Pod::Escapes' => 0, 'Getopt::ArgvFile' => 0 }, 'MAN1PODS' => { 'bin/pod2pdf' => "\$(INST_MAN1DIR)/pod2pdf.1", }, clean => { FILES => "*.bak pod2pdf-*" }, ); 1; pod2pdf-0.42/MANIFEST0000644000076500007650000000033410710320301013153 0ustar jjjj00000000000000Changes MANIFEST This list of files README Makefile.PL artistic-2_0.txt bin/pod2pdf lib/App/pod2pdf.pm t/compile.t t/pod.t t/test_manifest META.yml Module meta-data (added by MakeMaker) pod2pdf-0.42/META.yml0000644000076500007650000000075110710320301013276 0ustar jjjj00000000000000# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: pod2pdf version: 0.42 version_from: lib/App/pod2pdf.pm installdirs: site requires: Getopt::ArgvFile: 0 PDF::API2: 0.6 Pod::Escapes: 0 Pod::ParseLink: 0 Pod::Parser: 0 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.30 pod2pdf-0.42/README0000644000076500007650000000131210672267542012727 0ustar jjjj00000000000000NAME pod2pdf - converts Pod to PDF format. INSTALLATION Unzip and untar the archive, cd to the distribution directory and enter the following commands: perl Makefile.PL make make test make install USAGE pod2pdf [options] input.pod >output.pdf Options are described in the main pod2pdf documentation, type 'perldoc pod2pdf' after installation. DEPENDENCIES Requires the following modules: Getopt::ArgvFile Pod::Escapes PDF::API2 Some functionality of pod2pdf will require the following optional modules: File::Type Image::Size Paper::Specs AUTHOR Written by Jon Allen (JJ) http://perl.jonallen.info/projects/pod2pdf pod2pdf-0.42/t/0000755000076500007650000000000010710320301012265 5ustar jjjj00000000000000pod2pdf-0.42/t/compile.t0000644000076500007650000000041410710320200014077 0ustar jjjj00000000000000# $Id$ use Test::More tests => 1; my $file = "blib/script/pod2pdf"; print "bail out! Script file is missing!" unless -e $file; my $output = `$^X -c $file 2>&1`; print "bail out! Script file is missing!" unless like( $output, qr/syntax OK$/, 'script compiles' ); pod2pdf-0.42/t/pod.t0000644000076500007650000000021010672267542013255 0ustar jjjj00000000000000# $Id$ use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); pod2pdf-0.42/t/test_manifest0000644000076500007650000000002010672267542015075 0ustar jjjj00000000000000compile.t pod.t