PDF-FromHTML-0.33/ 000755 000765 000024 00000000000 13554103476 014266 5 ustar 00audreyt staff 000000 000000 PDF-FromHTML-0.33/inc/ 000755 000765 000024 00000000000 13554103473 015034 5 ustar 00audreyt staff 000000 000000 PDF-FromHTML-0.33/SIGNATURE 000644 000765 000024 00000014737 13554103476 015566 0 ustar 00audreyt staff 000000 000000 This file contains message digests of all files listed in MANIFEST,
signed via the Module::Signature module, version 0.83.
To verify the content in this distribution, first make sure you have
Module::Signature installed, then type:
% cpansign -v
It will check each file's integrity, as well as the signature's
validity. If "==> Signature verified OK! <==" is not displayed,
the distribution may already have been compromised, and you should
not run its Makefile.PL or Build.PL.
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA256
SHA256 da03ce7583499aac306665321ec6cb5b9f46b82fd94f4677c6b04f92b549dead Changes
SHA256 7ed753d78c572d9bd67f289e056c8aeb817b4a3dd7220317c0a88f10fab5dc94 MANIFEST
SHA256 0641d458c217049205d3b0ff8fda3e1594297e2ca6b4e266d55419ac9ffcac6b META.yml
SHA256 07bb7f4541d6fe645a3be776359f3d701e825e7e4ab38cd8939190c082be27e8 Makefile.PL
SHA256 863890c26b848b0fb1d8ad0a26bd039599bb9a921d5af521e2dee757df542f83 README
SHA256 7fe8013fad8ecb0b9ef8bad3fd7287486c1c61c776f76beb7d9d24e06ee3ab44 inc/Module/AutoInstall.pm
SHA256 67d139199c03b8bf8447a5a62f0d0b6dc1bd5bf6dbe04de6d21998c577823ed6 inc/Module/Install.pm
SHA256 1e48ae2cb24e1d16193d476e735579dfcd0eefb3685921ad4736390df75d939b inc/Module/Install/AutoInstall.pm
SHA256 6ebcc53a161dd5dc0aae69e4704575f2b00181901d768a82e26722a309cfdbe4 inc/Module/Install/Base.pm
SHA256 d3f8c839d03fd21c197d05362dbb277cd7cadb15da6390d124b61e851f15146e inc/Module/Install/Can.pm
SHA256 e9e72e18921c10c87bc4ea4c20af83e52015b9f5775d00ac64073042403717ca inc/Module/Install/Fetch.pm
SHA256 a97bf661b739643c3adee064addf7a85f22e25e1bbffc137974cd8754ffa5c66 inc/Module/Install/Include.pm
SHA256 a7a681bf2c9eee58a372cb642ffe42b0301d1200432ba8de9f7791cd1ecc9827 inc/Module/Install/Makefile.pm
SHA256 aa887fa65a5eb6bbd1805706ce298b3f3cd55b353ecfd37aa7d35ae419331a49 inc/Module/Install/Metadata.pm
SHA256 751bc4e2f98074c05c9e23d484f2406cef042099664b6c87a73d6530bbeda427 inc/Module/Install/Scripts.pm
SHA256 26b166ff62aacdb55317d1659f160aa4935097eea9810ea980e6d747206b5dc0 inc/Module/Install/Win32.pm
SHA256 5f73a6851a91ea44e65b924f918743ad6e860620ad7a38a39d0295e0c5652a9f inc/Module/Install/WriteAll.pm
SHA256 6c060e68e70f4888b77d104b77dd932b3df0ce37acfc821fdab1740f09ed6ca8 lib/PDF/FromHTML.pm
SHA256 b2872ea10d6151ca230aaa4f529869ebe08a2cc231e3a3ccba5673110b81e39e lib/PDF/FromHTML/Template.pm
SHA256 2ea963d7f5544dfab9cb2059660a25e5ae81fbf976d13fc46ae37cb9b3ff9abe lib/PDF/FromHTML/Template/Base.pm
SHA256 bd574889f7258359c6b248fd94ef67f829ade0cd3b2d937debf4494797bb37ea lib/PDF/FromHTML/Template/Constants.pm
SHA256 bb7aadc849d0d364dc96c3533b48a916e99940a8f24746837e7b703a7784dc12 lib/PDF/FromHTML/Template/Container.pm
SHA256 2885b7cbfc4e9e20324568d1051bce19809e58f6bc6a69c771f1b59ccc8281b4 lib/PDF/FromHTML/Template/Container/Always.pm
SHA256 379e61f91d5e7f01a49321feb416c78037c44bcaa8ffd7f370ffe02c005204a5 lib/PDF/FromHTML/Template/Container/Conditional.pm
SHA256 f81b37f23f6f968837c123095e4854c2c1a2eaab6aec4518274428297835bdb7 lib/PDF/FromHTML/Template/Container/Font.pm
SHA256 4d7a6d8b39ccbd6f3ec456120d14c2518a61c47fb09b64afea66b90794f19a3b lib/PDF/FromHTML/Template/Container/Footer.pm
SHA256 851a6fb2579eba6c33589038e8ca836054469944180f3681e9d70594a427e6c6 lib/PDF/FromHTML/Template/Container/Header.pm
SHA256 c1f5dffb5ee954b4f5b9542d06706b7b9be0d07db77660c0035e02ab5e8f619e lib/PDF/FromHTML/Template/Container/Loop.pm
SHA256 01c231a09903b72950b530a14f6037ee946dfc5945ea8194fe2b762fc593dcfd lib/PDF/FromHTML/Template/Container/Margin.pm
SHA256 e610ccb39307c1430aed7d28c611474d15099ace99d13eb17c6dcdfea276033c lib/PDF/FromHTML/Template/Container/PageDef.pm
SHA256 5b91342df9a428c172d67169bb51ebbc76a4743f585468bc88de2c065ce1e6cc lib/PDF/FromHTML/Template/Container/PdfTemplate.pm
SHA256 ff51ed6f020c6e6d3b10e9b858da3734c6ab702e087a90b49f666f3d460c37da lib/PDF/FromHTML/Template/Container/Row.pm
SHA256 607d69d923f8a161796703bc48af1ece854da59d723968985b982d583efcfcb6 lib/PDF/FromHTML/Template/Container/Scope.pm
SHA256 5c37328bc75290e38900a24a338f27b54bce67bcd5740525ba642b15b22ad582 lib/PDF/FromHTML/Template/Container/Section.pm
SHA256 cfe13cdba7c9cb23acecef215f17b88ca6f5ea02dfa2b823a9384a79e2c4f208 lib/PDF/FromHTML/Template/Context.pm
SHA256 c2d677d5ba21f483cf46ea9a6189c864922a5f9cedcaa8a02abd87dfc71f2ac2 lib/PDF/FromHTML/Template/Element.pm
SHA256 5d5e94e777d79f9b5ce40ddcd2a0acc4ed01a29ff43adc166e38d388e7029d7b lib/PDF/FromHTML/Template/Element/Bookmark.pm
SHA256 0c3a3728066fa0c86c1deb8b8b5f55f1a029b784344a4af505609ec19a0425ab lib/PDF/FromHTML/Template/Element/Circle.pm
SHA256 8cd2a7084163edf01ca208a186a54e6d6b4ea8f6137a39b3c452d228abe6fd62 lib/PDF/FromHTML/Template/Element/HorizontalRule.pm
SHA256 4901dfa7f4f0a0110747b711d868bd81ea4e76390aec7c37f0d7fb5172059f82 lib/PDF/FromHTML/Template/Element/Image.pm
SHA256 ddeb64b8091ac8939e4ca9b83e34d01cb34e5059ed8ef3c980ad4b5e66837c8f lib/PDF/FromHTML/Template/Element/Line.pm
SHA256 40b8b0ecd59a764b01a42c2aae5251b04803a1e0e708956c90ada89d102faa6f lib/PDF/FromHTML/Template/Element/PageBreak.pm
SHA256 e603aa69243746f5c588cfe2cadf950750090c472e76435420f7b515b3b11c4d lib/PDF/FromHTML/Template/Element/TextBox.pm
SHA256 90c89488f88746798d8845598a9ce46eca47e645a96e3b5c9a2db7e5eeb253db lib/PDF/FromHTML/Template/Element/Var.pm
SHA256 ab7567c4f417488a753258e15aa51fa1a753bb8ed632473ec7ba801d7b80f1ff lib/PDF/FromHTML/Template/Element/Weblink.pm
SHA256 8670b209e9ad584ce05dd856b0b80ac688370d96a4be8c264a07bcc645893ce9 lib/PDF/FromHTML/Template/Factory.pm
SHA256 6defcb6e75ebd231a2fccf8beb1968ab8434880e33c04a45339c0fff61141305 lib/PDF/FromHTML/Template/Iterator.pm
SHA256 162fdfe77337671e4a4a01701c5f085a61758bfc99eaadfced8c26e0568ed9bf lib/PDF/FromHTML/Template/TextObject.pm
SHA256 3d711f9bdc01058228f6403724faa036cde704d43364019208708efad72576e7 lib/PDF/FromHTML/Twig.pm
SHA256 42217fa5145974b0487a44325ebb4b892cdc695c6294b5d4bb40b82c43503a7f script/html2pdf.pl
SHA256 79377cdae6e45062eddabd317e52a7f00c1ac81240f8b566d2df58cb1b2a4ccb t/1-basic.t
-----BEGIN PGP SIGNATURE-----
iQGzBAEBCAAdFiEE8/4umVyeYRTFU5r09ePPSwnTf6gFAl2whzwACgkQ9ePPSwnT
f6jHqQv/Y3a4DitRDf2rjbDy6Sry5kSfA4P9PdVkaNI+JD+mk7L+yu+cvXSdIW6U
8r3oD73b9Gmxb2E0h/Iows3uI+g3upg6PJ0s350LKy3IeK9pcDNPELJipe78SZ5p
oCBbQIKjtxR1CAzJ2pv+3bkg3Ha5BiWheV5SgF/MmYIK878A5FeTmIA5+8h3BL+D
WS7pAA1j7J/Il6Lcb2WFcTOAg9h1rHf6ZTw4MZsBhMHQz1ywldy6w2xrhBrci6QP
z1NI0ItHk0KRzWBLksW5rER7oY5mgjekuKPCvxoSwUIun22t2MXcy88HQut030YU
cd6z52OoIFayIphjmY9pK2aB6SG4GtuOgsfUu2XvNZi/XI6+ltcEw6X5ZLEqkKhC
PFveAGr9MfaIwXqabDmSU2FnI8C0L5+0ToC+V4SKCIqjn2fxboRwb7pAb8OH4MED
giUccdYN5KWq8hqB6+Bqg7BGNqEQ6/gjgw2+ghMCMeKoIDAcfwhEVpbBgQCIwj8o
Zh4arEl7
=TUwr
-----END PGP SIGNATURE-----
PDF-FromHTML-0.33/PaxHeader/Changes 000644 000765 000024 00000000036 13554103466 017530 x ustar 00audreyt staff 000000 000000 30 mtime=1571850038.610429738
PDF-FromHTML-0.33/Changes 000644 000765 000024 00000007327 13554103466 015571 0 ustar 00audreyt staff 000000 000000 [Changes for 0.33 - Wed Oct 23 20:00:23 EAT 2019]
* Fix META.yml and README; no functional changes.
[Changes for 0.32 - Wed Oct 23 19:36:25 EAT 2019]
* Fix an arbitrary 10-page limitation.
[Changes for 0.31 - 2010年 1月 8日 周五 18時58分48秒 CST]
* Fix an incorrect MANIFEST leading to installation failure.
Reported by: Montaseri.
[Changes for 0.30 - 2009年11月17日 周二 16時46分49秒 CST]
* LICENSING CHANGE: This compilation and all individual files in it
are now under the nullary CC0 1.0 Universal terms:
To the extent possible under law, 唐鳳 has waived all copyright and
related or neighboring rights to PDF-FromHTML.
* Updated Module::Install to 0.91, prompted by Florian Ragwitz.
[Changes for 0.25 - 2009-01-01]
* Added -l, -e, -f and -s flags to html2pdf.pl; see its POD for details.
* Running "html2pdf.pl foo.html" now writes to "foo.html.pdf" instead of
STDOUT. However, "html2pdf.pl foo.html > foo.pdf" is still supported.
[Changes for 0.24 - 2007-02-14]
* The "landscape" option to ->convert() now work as documented.
[Changes for 0.23 - 2007-02-05]
* Updated CAVEATS section to note that there is currently no plan
to support CSS for this module.
Contributed by: Craig Chant
* Updated license info in scripts/html2pdf to MIT.
* Various code warning/stricture/tidying up; no function changes.
[Changes for 0.22 - 2007-01-25]
* LICENSING CHANGE: This compilation and all individual files in it
are now under the permissive "MIT" license. See the COPYRIGHT
section in README for the new terms.
* PDF::FromHTML no longer fails when
contains width percentages
that are narrower than the widths of its elements, or when
contains no elements at all.
Reported by: Craig Chant
[Changes for 0.21 - 2006-12-07]
Slight tweaks to PDF::FromHTML::Template to allow border lines with
user-specified width.
[Changes for 0.20 - 2006-09-11]
Bundle our private fork of PDF::Template as PDF::FromHTML::Template
to work around the bug that PDF::Template 0.30 is no longer available
no CPAN.
Redesigned the table layout engine, so that tables with borders,
colspan settings, and per-td widths are all respected.
[Changes for 0.12 - 2005-12-01]
For Perl 5.8.1, "use constant" alone seems not enough to pass
use strict subs. Reported by Christian Pipi.
Updateded to Module::Install 0.40 for better installation support.
[Changes for 0.11 - 2005-12-01]
For Perl 5.6.x, we have to use PDFLib as PDF::API2 only supports
Perl 5.8+. Reported by Jessie Chen.
[Changes for 0.10 - 2005-11-29]
Chase new versions of PDF::Template and PDF::Writer.
Add support for PDFLib based rendering engine, in addition to PDF::API2.
[Changes for 0.08 - 2005-05-06]
Fix image handler bug in Twig.pm for zero-width and missing image
files, contributed by Charleston Software Associates.
[Changes for 0.07 - 2004-12-08]
Heading fonts are made much bigger.
Prelminary support for via LWP.
Use Image::Size to determine image size correctly.
Correct layout for mixed colspan and rowspan.
Variable support via a plain $__PAGE__ in text
(this interface may change into the future).
[Changes for 0.06 - 2004-11-23]
Correctly fallback to XML::Clean if HTML::Tidy is unavailable.
Rowspan was only renfered properly on leading columns; now it should
work on all columns.
[Changes for 0.05 - 2004-11-18]
HTML::Tidy is now preferred over XML::Clean.
Graphics::ColorNames now replaces Color::Rgb.
Dropped dependency on Spiffy and Hook::LexWrap.
TD and TH's "rowspan" and "colspan" is now handled, albeit imperfectly.
Widths in TD and TH in the same TR now always adds back to 100%.
[Changes for 0.04 - 2004-09-23]
Adds parameters to ->convert() so page size, font height etc can be tweaked.
PDF-FromHTML-0.33/MANIFEST 000644 000765 000024 00000003373 13554101354 015416 0 ustar 00audreyt staff 000000 000000 Changes
inc/Module/AutoInstall.pm
inc/Module/Install.pm
inc/Module/Install/AutoInstall.pm
inc/Module/Install/Base.pm
inc/Module/Install/Can.pm
inc/Module/Install/Fetch.pm
inc/Module/Install/Include.pm
inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
inc/Module/Install/Scripts.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/PDF/FromHTML.pm
lib/PDF/FromHTML/Template.pm
lib/PDF/FromHTML/Template/Base.pm
lib/PDF/FromHTML/Template/Constants.pm
lib/PDF/FromHTML/Template/Container.pm
lib/PDF/FromHTML/Template/Container/Always.pm
lib/PDF/FromHTML/Template/Container/Conditional.pm
lib/PDF/FromHTML/Template/Container/Font.pm
lib/PDF/FromHTML/Template/Container/Footer.pm
lib/PDF/FromHTML/Template/Container/Header.pm
lib/PDF/FromHTML/Template/Container/Loop.pm
lib/PDF/FromHTML/Template/Container/Margin.pm
lib/PDF/FromHTML/Template/Container/PageDef.pm
lib/PDF/FromHTML/Template/Container/PdfTemplate.pm
lib/PDF/FromHTML/Template/Container/Row.pm
lib/PDF/FromHTML/Template/Container/Scope.pm
lib/PDF/FromHTML/Template/Container/Section.pm
lib/PDF/FromHTML/Template/Context.pm
lib/PDF/FromHTML/Template/Element.pm
lib/PDF/FromHTML/Template/Element/Bookmark.pm
lib/PDF/FromHTML/Template/Element/Circle.pm
lib/PDF/FromHTML/Template/Element/HorizontalRule.pm
lib/PDF/FromHTML/Template/Element/Image.pm
lib/PDF/FromHTML/Template/Element/Line.pm
lib/PDF/FromHTML/Template/Element/PageBreak.pm
lib/PDF/FromHTML/Template/Element/TextBox.pm
lib/PDF/FromHTML/Template/Element/Var.pm
lib/PDF/FromHTML/Template/Element/Weblink.pm
lib/PDF/FromHTML/Template/Factory.pm
lib/PDF/FromHTML/Template/Iterator.pm
lib/PDF/FromHTML/Template/TextObject.pm
lib/PDF/FromHTML/Twig.pm
Makefile.PL
MANIFEST This list of files
META.yml
README
script/html2pdf.pl
SIGNATURE
t/1-basic.t
PDF-FromHTML-0.33/t/ 000755 000765 000024 00000000000 13554103473 014526 5 ustar 00audreyt staff 000000 000000 PDF-FromHTML-0.33/PaxHeader/README 000644 000765 000024 00000000036 13554103411 017103 x ustar 00audreyt staff 000000 000000 30 mtime=1571849993.267114463
PDF-FromHTML-0.33/README 000644 000765 000024 00000005105 13554103411 015134 0 ustar 00audreyt staff 000000 000000 NAME
PDF::FromHTML - Convert HTML documents to PDF
SYNOPSIS
my $pdf = PDF::FromHTML->new( encoding => 'utf-8' );
# Loading from a file:
$pdf->load_file('source.html');
# Or from a scalar reference:
# $pdf->load_file(\$input);
# Perform the actual conversion:
$pdf->convert(
# With PDF::API2, font names such as 'traditional' also works
Font => 'font.ttf',
LineHeight => 10,
Landscape => 1,
);
# Write to a file:
$pdf->write_file('target.pdf');
# Or to a scalar reference:
# $pdf->write_file(\$output);
DESCRIPTION
This module transforms HTML into PDF, using an assortment of XML
transformations implemented in PDF::FromHTML::Twig.
There is also a command-line utility, html2pdf.pl, that comes with this
distribution.
PUBLIC METHODS
convert(%params)
Convert the loaded file to PDF. Valid parameters are:
PageWidth 640
PageResolution 540
FontBold 'HelveticaBold'
FontOblique 'HelveticaOblique'
FontBoldOblique 'HelveticaBoldOblique'
LineHeight 12
FontUnicode 'Helvetica'
Font (same as FontUnicode)
PageSize 'A4'
Landscape 0
HINTS & TIPS
tags
Add the height and width attributes if you are creating the source HTML,
it keeps PDF::FromHTML from having to open and read the source image
file to get the real size. Less file I/O means faster processing.
CAVEATS
Although PDF::FromHTML will work with both HTML and XHTML formats, it is
not designed to utilise CSS.
This means any HTML using external or inline CSS for design and layout,
including but not limited to: images, backgrounds, colours, fonts etc...
will not be converted into the PDF.
To get an idea of the likely resulting PDF, you may wish to use an
non-CSS capable browser for testing first.
There is currently no plan to adapt this module to utilise CSS. (Patches
welcome, though!)
SEE ALSO
html2pdf.pl is a simple command-line interface to this module.
PDF::FromHTML::Twig, PDF::Template, XML::Twig.
CONTRIBUTORS
Charleston Software Associates
AUTHORS
Audrey Tang
CC0 1.0 Universal
To the extent possible under law, 唐鳳 has waived all copyright and
related or neighboring rights to PDF-FromHTML.
This work is published from Taiwan.
PDF-FromHTML-0.33/script/ 000755 000765 000024 00000000000 13554103473 015567 5 ustar 00audreyt staff 000000 000000 PDF-FromHTML-0.33/META.yml 000644 000765 000024 00000007106 13554103473 015540 0 ustar 00audreyt staff 000000 000000 ---
abstract: 'Convert HTML documents to PDF'
author:
- 'Audrey Tang '
build_requires:
ExtUtils::MakeMaker: 6.59
configure_requires:
ExtUtils::MakeMaker: 6.59
distribution_type: module
dynamic_config: 1
generated_by: 'Module::Install version 1.19'
license: unrestricted
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: PDF-FromHTML
no_index:
directory:
- inc
- t
provides:
PDF::FromHTML:
file: lib/PDF/FromHTML.pm
version: '0.33'
PDF::FromHTML::Template:
file: lib/PDF/FromHTML/Template.pm
version: '0.33'
PDF::FromHTML::Template::Base:
file: lib/PDF/FromHTML/Template/Base.pm
PDF::FromHTML::Template::Constants:
file: lib/PDF/FromHTML/Template/Constants.pm
PDF::FromHTML::Template::Container:
file: lib/PDF/FromHTML/Template/Container.pm
PDF::FromHTML::Template::Container::Always:
file: lib/PDF/FromHTML/Template/Container/Always.pm
PDF::FromHTML::Template::Container::Conditional:
file: lib/PDF/FromHTML/Template/Container/Conditional.pm
PDF::FromHTML::Template::Container::Font:
file: lib/PDF/FromHTML/Template/Container/Font.pm
PDF::FromHTML::Template::Container::Footer:
file: lib/PDF/FromHTML/Template/Container/Footer.pm
PDF::FromHTML::Template::Container::Header:
file: lib/PDF/FromHTML/Template/Container/Header.pm
PDF::FromHTML::Template::Container::Loop:
file: lib/PDF/FromHTML/Template/Container/Loop.pm
PDF::FromHTML::Template::Container::Margin:
file: lib/PDF/FromHTML/Template/Container/Margin.pm
PDF::FromHTML::Template::Container::PageDef:
file: lib/PDF/FromHTML/Template/Container/PageDef.pm
PDF::FromHTML::Template::Container::PdfTemplate:
file: lib/PDF/FromHTML/Template/Container/PdfTemplate.pm
PDF::FromHTML::Template::Container::Row:
file: lib/PDF/FromHTML/Template/Container/Row.pm
PDF::FromHTML::Template::Container::Scope:
file: lib/PDF/FromHTML/Template/Container/Scope.pm
PDF::FromHTML::Template::Container::Section:
file: lib/PDF/FromHTML/Template/Container/Section.pm
PDF::FromHTML::Template::Context:
file: lib/PDF/FromHTML/Template/Context.pm
PDF::FromHTML::Template::Element:
file: lib/PDF/FromHTML/Template/Element.pm
PDF::FromHTML::Template::Element::Bookmark:
file: lib/PDF/FromHTML/Template/Element/Bookmark.pm
PDF::FromHTML::Template::Element::Circle:
file: lib/PDF/FromHTML/Template/Element/Circle.pm
PDF::FromHTML::Template::Element::HorizontalRule:
file: lib/PDF/FromHTML/Template/Element/HorizontalRule.pm
PDF::FromHTML::Template::Element::Image:
file: lib/PDF/FromHTML/Template/Element/Image.pm
PDF::FromHTML::Template::Element::Line:
file: lib/PDF/FromHTML/Template/Element/Line.pm
PDF::FromHTML::Template::Element::PageBreak:
file: lib/PDF/FromHTML/Template/Element/PageBreak.pm
PDF::FromHTML::Template::Element::TextBox:
file: lib/PDF/FromHTML/Template/Element/TextBox.pm
PDF::FromHTML::Template::Element::Var:
file: lib/PDF/FromHTML/Template/Element/Var.pm
PDF::FromHTML::Template::Element::Weblink:
file: lib/PDF/FromHTML/Template/Element/Weblink.pm
PDF::FromHTML::Template::Factory:
file: lib/PDF/FromHTML/Template/Factory.pm
PDF::FromHTML::Template::Iterator:
file: lib/PDF/FromHTML/Template/Iterator.pm
PDF::FromHTML::Template::TextObject:
file: lib/PDF/FromHTML/Template/TextObject.pm
PDF::FromHTML::Twig:
file: lib/PDF/FromHTML/Twig.pm
requires:
Graphics::ColorNames: 0
HTML::Tidy: 0
Image::Size: 0
LWP::Simple: 0
List::Util: 0
PDF::API2: 0
PDF::Writer: '0.05'
XML::Twig: 0
perl: 5.6.0
version: '0.33'
PDF-FromHTML-0.33/lib/ 000755 000765 000024 00000000000 13554103473 015031 5 ustar 00audreyt staff 000000 000000 PDF-FromHTML-0.33/Makefile.PL 000644 000765 000024 00000002320 13554103377 016235 0 ustar 00audreyt staff 000000 000000 #!/usr/local/bin/perl
use inc::Module::Install;
name 'PDF-FromHTML';
license 'unrestricted';
all_from 'lib/PDF/FromHTML.pm';
install_script 'script/html2pdf.pl';
requires qw(
List::Util 0
XML::Twig 0
Graphics::ColorNames 0
LWP::Simple 0
Image::Size 0
PDF::Writer 0.05
);
unless (can_use('PDF::API2') or can_use('pdflib_pl')) {
if ($] >= 5.008) {
requires 'PDF::API2';
print << '.';
*** If you cannot install PDF::API2, you may use the pdflib_pl
module instead, available as a separate download on PDFLib homepage.
.
}
else {
requires 'pdflib_pl';
print << '.';
*** Perl 5.6.x users needs the pdflib_pl module, available as a
separate download on PDFLib homepage. Alternatively, upgrade
to Perl 5.8 and use PDF::API2 from CPAN.
.
}
}
unless (can_use('HTML::Tidy') or can_use('XML::Clean')) {
requires 'HTML::Tidy';
print << '.';
*** If you cannot install HTML::Tidy, you may use the XML::Clean
module instead; however, you will run probably run into more
"XML not well-formed" errors that way.
.
}
auto_install;
auto_provides;
sign; WriteAll;
PDF-FromHTML-0.33/lib/PDF/ 000755 000765 000024 00000000000 13554103473 015442 5 ustar 00audreyt staff 000000 000000 PDF-FromHTML-0.33/lib/PDF/FromHTML/ 000755 000765 000024 00000000000 13554103473 017032 5 ustar 00audreyt staff 000000 000000 PDF-FromHTML-0.33/lib/PDF/PaxHeader/FromHTML.pm 000644 000765 000024 00000000036 13554103430 021331 x ustar 00audreyt staff 000000 000000 30 mtime=1571850008.903101983
PDF-FromHTML-0.33/lib/PDF/FromHTML.pm 000644 000765 000024 00000013722 13554103430 017366 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML;
use 5.006;
use strict;
use warnings;
our $VERSION = '0.33';
BEGIN {
foreach my $method ( qw( pdf twig tidy args ) ) {
no strict 'refs';
*$method = sub { $#_ ? ($_[0]{$method} = $_[1]) : $_[0]{$method} };
}
}
use Cwd;
use File::Temp;
use File::Basename;
use PDF::Writer;
use PDF::FromHTML::Twig;
use PDF::FromHTML::Template;
use constant HAS_UNICODE_SUPPORT => ($] >= 5.008);
use constant PDF_WRITER_BACKEND => do {
local $@;
# For Perl 5.6.x, we have to use pdflib
PDF::Writer->import('pdflib')
unless HAS_UNICODE_SUPPORT();
eval { ref(PDF::Writer->new) }
or die( "Please install PDF::API2 (preferred) or pdflib_pl first" );
};
use constant HAS_HTML_TIDY => do {
local $@;
eval { require HTML::Tidy; 1 } or do {
unless ( eval { require XML::Clean; 1 } ) {
die( "Please install HTML::Tidy (preferred) or XML::Clean first" );
}
0; # Has XML::Clean but no HTML::Tidy
};
};
=head1 NAME
PDF::FromHTML - Convert HTML documents to PDF
=head1 SYNOPSIS
my $pdf = PDF::FromHTML->new( encoding => 'utf-8' );
# Loading from a file:
$pdf->load_file('source.html');
# Or from a scalar reference:
# $pdf->load_file(\$input);
# Perform the actual conversion:
$pdf->convert(
# With PDF::API2, font names such as 'traditional' also works
Font => 'font.ttf',
LineHeight => 10,
Landscape => 1,
);
# Write to a file:
$pdf->write_file('target.pdf');
# Or to a scalar reference:
# $pdf->write_file(\$output);
=head1 DESCRIPTION
This module transforms HTML into PDF, using an assortment of XML
transformations implemented in L.
There is also a command-line utility, L, that comes
with this distribution.
=head1 PUBLIC METHODS
=cut
sub new {
my $class = shift;
bless({
twig => PDF::FromHTML::Twig->new,
args => { @_ },
}, $class);
}
sub load_file {
my ($self, $file) = @_;
$self->{file} = $file;
}
sub parse_file {
my $self = shift;
my $file = $self->{file};
my $content = '';
my $dir = Cwd::getcwd();
if (!ref $file) {
open my $fh, '<', $file or die $!;
chdir File::Basename::dirname($file);
$content = do { local $/; <$fh> };
}
else {
$content = $$file;
}
my $encoding = ($self->args->{encoding} || 'utf8');
if (HAS_UNICODE_SUPPORT() and $self->args) {
require Encode;
$content = Encode::decode($encoding, $content, Encode::FB_XMLCREF());
}
$content =~ s{ }{}g;
$content =~ s{}{}gs;
if (HAS_HTML_TIDY()) {
if (HAS_UNICODE_SUPPORT()) {
$content = Encode::encode( ascii => $content, Encode::FB_XMLCREF());
}
$content = HTML::Tidy->new->clean(
'',
'',
$content,
);
}
else {
$content =~ s{(\d+);}{chr $1}eg;
$content =~ s{([\da-fA-F]+);}{chr hex $1}eg;
$content = XML::Clean::clean($content, '1.0', { encoding => 'UTF-8' });
$content =~ s{<(/?\w+)}{<\L$1}g;
}
$self->twig->parse( $content );
chdir $dir;
}
=head2 convert(%params)
Convert the loaded file to PDF. Valid parameters are:
PageWidth 640
PageResolution 540
FontBold 'HelveticaBold'
FontOblique 'HelveticaOblique'
FontBoldOblique 'HelveticaBoldOblique'
LineHeight 12
FontUnicode 'Helvetica'
Font (same as FontUnicode)
PageSize 'A4'
Landscape 0
=cut
sub convert {
my ($self, %args) = @_;
{
# import arguments into Twig parameters
no strict 'refs';
${"PDF::FromHTML::Twig::$_"} = $args{$_} foreach keys %args;
}
$self->parse_file;
my ($fh, $filename) = File::Temp::tempfile(
SUFFIX => '.xml',
UNLINK => 1,
);
binmode($fh);
if (HAS_UNICODE_SUPPORT()) {
binmode($fh, ':utf8');
}
# use File::Copy;
# copy($filename => '/tmp/foo.xml');
# XXX HACK! XXX
my $text = $self->twig->sprint;
$text =~ s{\$(__[A-Z_]+__)}{ }g;
print $fh $text;
close $fh;
# print STDERR "==> Temp file written to $filename\n";
local $@;
local $^W;
$self->pdf(eval { PDF::FromHTML::Template->new( filename => $filename ) })
or die "$filename: $@";
$self->pdf->param(@_);
}
sub write_file {
my $self = shift;
local $^W;
if (@_ and ref($_[0]) eq 'SCALAR') {
${$_[0]} = $self->pdf->get_buffer;
}
else {
$self->pdf->write_file(@_);
}
}
1;
=head1 HINTS & TIPS
=head2 EimgE tags
Add the height and width attributes if you are creating the source HTML,
it keeps PDF::FromHTML from having to open and read the source image file
to get the real size. Less file I/O means faster processing.
=head1 CAVEATS
Although B will work with both HTML and XHTML formats,
it is not designed to utilise CSS.
This means any HTML using external or inline CSS for design and
layout, including but not limited to: images, backgrounds, colours,
fonts etc... will not be converted into the PDF.
To get an idea of the likely resulting PDF, you may wish to use an
non-CSS capable browser for testing first.
There is currently no plan to adapt this module to utilise CSS.
(Patches welcome, though!)
=head1 SEE ALSO
L is a simple command-line interface to this module.
L, L, L.
=head1 CONTRIBUTORS
Charleston Software Associates Einfo@charletonsw.comE
=head1 AUTHORS
Audrey Tang Ecpan@audreyt.orgE
=head1 CC0 1.0 Universal
To the extent possible under law, 唐鳳 has waived all copyright and related
or neighboring rights to PDF-FromHTML.
This work is published from Taiwan.
L
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/ 000755 000765 000024 00000000000 13554103473 020605 5 ustar 00audreyt staff 000000 000000 PDF-FromHTML-0.33/lib/PDF/FromHTML/PaxHeader/Twig.pm 000644 000765 000024 00000000036 13554101202 022236 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.243349246
PDF-FromHTML-0.33/lib/PDF/FromHTML/Twig.pm 000644 000765 000024 00000044160 13554101202 020273 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Twig;
use strict;
use warnings;
use XML::Twig;
use base 'XML::Twig';
use charnames ':full';
use Graphics::ColorNames qw( hex2tuple );
use File::Spec;
use File::Basename;
use List::Util qw( sum first reduce );
=head1 NAME
PDF::FromHTML::Twig - PDF::FromHTML guts
=head1 SYNOPSIS
(internal use only)
=head1 DESCRIPTION
No user-serviceable parts inside.
=cut
sub new {
my $class = shift;
XML::Twig::new($class, $class->TwigArguments, @_);
}
our $PageWidth = 640;
our $PageResolution = 540;
our $FontBold = 'HelveticaBold';
our $FontOblique = 'HelveticaOblique';
our $FontBoldOblique = 'HelveticaBoldOblique';
our $LineHeight = 12;
our $FontUnicode = 'Helvetica';
our $Font = $FontUnicode;
# $Font = '/usr/local/share/fonts/TrueType/minguni.ttf';
our $PageSize = 'A4';
our $Landscape = 0;
use constant SuperScript => [
"\N{SUPERSCRIPT ZERO}",
"\N{SUPERSCRIPT ONE}",
"\N{SUPERSCRIPT TWO}",
"\N{SUPERSCRIPT THREE}",
"\N{SUPERSCRIPT FOUR}",
"\N{SUPERSCRIPT FIVE}",
"\N{SUPERSCRIPT SIX}",
"\N{SUPERSCRIPT SEVEN}",
"\N{SUPERSCRIPT EIGHT}",
"\N{SUPERSCRIPT NINE}",
];
use constant SubScript => [
"\N{SUBSCRIPT ZERO}",
"\N{SUBSCRIPT ONE}",
"\N{SUBSCRIPT TWO}",
"\N{SUBSCRIPT THREE}",
"\N{SUBSCRIPT FOUR}",
"\N{SUBSCRIPT FIVE}",
"\N{SUBSCRIPT SIX}",
"\N{SUBSCRIPT SEVEN}",
"\N{SUBSCRIPT EIGHT}",
"\N{SUBSCRIPT NINE}",
];
use constant InlineTags => { map { $_ => 1 } '#PCDATA', 'font' };
use constant DeleteTags => {
map { $_ => 1 }
qw(
head style applet script
)
};
use constant IgnoreTags => {
map { $_ => 1 }
qw(
title a ul
del address blockquote colgroup fieldset
input form frameset object noframes noscript
small optgroup isindex area textarea col
pre frame param menu acronym abbr bdo
label basefont big caption option cite
dd dfn dt base code map iframe ins kbd legend
samp span dir strike meta link tbody q tfoot
button thead tt select s
var
)
};
use constant TwigArguments => (
twig_handlers => {
html => sub {
$_->del_atts;
$_->set_gi('pdftemplate');
},
map((
"h$_" => (
sub {
my $size = 4 + shift;
sub {
$_->insert_new_elt(before => 'textbox')
->wrap_in('row')
->wrap_in(font => { face => $FontBold });
$_->wrap_in(
font => { h => $LineHeight + 6 - $size });
$_->wrap_in(
row => { h => $LineHeight + 8 - $size });
$_->set_tag('textbox'), $_->set_att(w => '100%');
};
}
)->($_)
),
1 .. 6),
center => sub {
foreach my $child ($_->children('p')) {
# XXX - revert other blocklevel to left/original alignment
$child->set_att(align => 'center');
}
$_->erase;
},
sup => sub {
my $digits = $_->text;
my $text = '';
$text .= +SuperScript->[$1] while $digits =~ s/(\d)//;
$_->set_text($text);
$_->erase;
},
sub => sub {
my $digits = $_->text;
my $text = '';
$text .= +SubScript->[$1] while $digits =~ s/(\d)//;
$_->set_text($text);
$_->erase;
},
u => sub {
_set(underline => 1, $_);
$_->erase;
},
em => sub {
_set(font => $FontOblique, $_);
$_->erase;
},
i => sub {
_set(font => $FontOblique, $_);
$_->erase;
},
strong => sub {
_set(font => $FontBold, $_);
$_->erase;
},
b => sub {
_set(font => $FontBold, $_);
$_->erase;
},
div => sub {
if (my $tag = (_type(header => $_) || _type(footer => $_))) {
$_->set_tag($tag);
$_->set_att(
"${tag}_height" => int(
sum(
$LineHeight * 2,
grep defined,
map $_->att('h'),
$_->descendants
)
),
);
}
else {
$_->erase;
}
},
hr => sub {
$_->insert_new_elt(first_child => (_type(pagebreak => $_) || 'hr'));
$_->erase;
},
img => sub {
my $src = $_->att('src');
my $file = File::Spec->rel2abs($src);
if ($src =~ m{^(\w+):/}) {
require LWP::Simple;
require File::Basename;
require File::Spec;
$file =
File::Spec->catfile(File::Spec->tmpdir,
File::Basename::basename($src));
LWP::Simple::mirror($src => $file);
}
# CSA - check for real file first
#
if (-e $file) {
my $w = $_->att('width');
my $h = $_->att('height');
if (($w eq '') or ($h eq '')) {
require Image::Size;
my ($iw, $ih) = Image::Size::imgsize($file);
# CSA - catch this now, before we crash
#
warn "unable to read image file '$file' ($w x $h)"
unless (defined $iw && defined $ih);
$iw ||= 1;
$ih ||= 1;
if (!$w and !$h) {
($w, $h) = ($iw, $ih);
}
elsif (!$w) {
$w = $iw * ($h / $ih);
}
else {
$h = $ih * ($w / $iw);
}
}
my $image = $_->insert_new_elt(
first_child => image => {
filename => $file,
w => ($w / $PageWidth * $PageResolution),
h => ($h / $PageWidth * $PageResolution),
type => '',
}
);
$image->wrap_in('row');
# CSA - File has gone missing
#
}
else {
warn "image file '$file' does not exist";
}
$_->erase;
},
body => sub {
$_->wrap_in(
pagedef => {
pagesize => $PageSize,
landscape => $Landscape,
margins => $LineHeight - 2,
},
);
$_->wrap_in(
font => {
face => $Font,
h => $LineHeight - 2,
}
);
my $pagedef = $_->parent->parent;
my $head = ($pagedef->descendants('header'))[0]
|| $pagedef->insert_new_elt(
first_child => header => { header_height => $LineHeight * 2 });
my $row = $head->insert_new_elt(first_child => 'row');
$row->insert_new_elt(
first_child => textbox => { w => '100%', text => '' });
foreach my $child ($_->children('#PCDATA')) {
$child->set_text(
join(' ', grep length, split(/\n+/, $child->text)));
if ($child->text =~ /[^\x00-\x7f]/) {
$child->wrap_in(font => { face => $FontUnicode });
}
$child->wrap_in('row');
$child->wrap_in(textbox => { w => '100%' });
$child->insert_new_elt(after => 'textbox')->wrap_in('row');
}
$_->erase;
},
p => \&_p,
li => \&_p,
table => sub {
our @RowSpan = ();
my $cols = $_->root->att('#total_cols') or do {
$_->erase for $_->children('tr');
$_->erase;
return;
};
my $widths = $_->root->att('#widths');
if (!$widths) {
$widths = [];
$_->root->set_att('#widths', $widths);
}
my $table_width = $_->root->att('#total_width');
if (!$table_width) {
$table_width = _percentify($_->att('width'), $PageWidth);
$_->root->set_att('#total_width', $table_width);
}
my $unallocated_sum = 100;
my $unallocated_cols = 0;
foreach my $idx (0..$cols-1) {
if (my $w = $widths->[$idx]) {
$unallocated_sum -= $w;
}
else {
$unallocated_cols++;
}
}
if ($unallocated_cols and $unallocated_sum > 0) {
# warn "UNALLOC: $unallocated_cols, $unallocated_sum\n";
# Populate unallocated columns
my $w = int($unallocated_sum / $unallocated_cols);
$widths->[$_] ||= $w for (0..$cols-1);
}
elsif ($unallocated_cols) {
# Redistribute all columns.
my $w = int(100 / $cols);
$widths->[$_] = $w for (0..$cols-1);
}
elsif ($unallocated_sum < 0) {
# warn "WIDTHS: @$widths ($unallocated_sum)\n";
# Redistribute all columns, part 2. -- not sure we should do it actually.
my $overflow = (100-$unallocated_sum);
$widths->[$_] = int($widths->[$_] * 100 / $overflow) for (0..$cols-1);
}
for ($_->children('tr')) {
return $_->erase if $_->descendants('row');
my @children = $_->descendants('textbox');
my @cells = @{ shift(@RowSpan) || [] };
foreach my $i (1 .. $#cells) {
my $cell = $cells[$i] or next;
my $child;
if ($child = $children[ $i - 1 ]) {
$child->insert_new_elt(before => 'textbox', $cell);
}
elsif ($child = $children[ $i - 2 ]) {
$child->insert_new_elt(after => 'textbox', $cell);
}
else {
next;
}
@children = $_->descendants('textbox');
}
my $cols = sum(map { $_->att('colspan') || 1 } @children);
# print STDERR "==> Total cols: $cols :".@children.$/;
my $sum = 100;
my $last_child = pop(@children);
my $col_idx = 0;
foreach my $child (@children) {
my $colspan = $child->att('colspan') || 1;
my $w = 0;
foreach my $idx ($col_idx .. $col_idx+$colspan-1) {
$w += $widths->[$idx];
}
$col_idx += $colspan;
$child->set_att(w => "$w%");
$sum -= $w;
}
$last_child->set_att(w => "$sum%") if $last_child;
$_->set_tag('row');
$_->set_att(lmargin => '3');
$_->set_att(rmargin => '3');
$_->set_att(border => $_->parent('table')->att('border'));
$_->set_att(h => $LineHeight);
}
$_->root->del_att('#widths');
$_->root->set_att('#total_width' => undef);
$_->root->set_att('#total_cols' => undef);
$_->insert_new_elt(last_child => row => { h => $LineHeight });
$_->erase;
},
ol => sub {
my $count = 1;
foreach my $child ($_->descendants('counter')) {
$child->set_tag('textbox');
$child->set_text("$count. ");
$count++;
}
$_->insert_new_elt(last_child => row => { h => $LineHeight });
$_->erase;
},
br => sub {
$_->insert_new_elt(last_child => row => { h => $LineHeight });
$_->erase;
},
ul => sub {
foreach my $child ($_->descendants('counter')) {
$child->set_tag('textbox');
$child->set_text("* ");
}
$_->insert_new_elt(last_child => row => { h => $LineHeight });
$_->erase;
},
dl => sub {
foreach my $child ($_->descendants('counter')) {
$child->delete;
}
$_->insert_new_elt(last_child => row => { h => $LineHeight });
$_->erase;
},
td => \&_td,
th => \&_td,
font => sub {
$_->del_att('face');
if ($_->att_names) {
$_->set_att(face => $Font);
$_->erase; # XXX
}
else {
$_->erase;
}
},
var => sub {
# XXX - Proper variable support
},
_default_ => sub {
$_->erase if +IgnoreTags->{ $_->tag };
$_->delete if +DeleteTags->{ $_->tag };
}
},
pretty_print => 'indented',
empty_tags => 'html',
start_tag_handlers => {
_all_ => sub {
if (my $h = $_->att('size')) {
$_->set_att(h => $LineHeight + (2 * ($h - 4)));
}
if (my $bgcolor = $_->att('bgcolor')) {
$_->set_att(bgcolor => _to_color($bgcolor));
}
$_->del_att(
qw(
color bordercolor bordercolordark bordercolorlight
cellpadding cellspacing size href
)
);
},
}
);
sub _set {
my ($key, $value, $elt) = @_;
my $att = $elt->root->att("#$key") || {};
$att->{ $elt->parent } = $value;
$elt->root->set_att("#$key", $att);
}
sub _get {
my ($key, $elt) = @_;
my $att = $elt->root->att("#$key") || {};
return $att->{$elt};
}
sub _p {
my @children;
foreach my $child ($_->children) {
+InlineTags->{ $child->tag } or last;
push @children, $child->cut;
}
if (@children) {
my $textbox = $_->insert_new_elt(
before => textbox => {
w => (($_->tag eq 'p') ? '100%' : '97%'),
align => $_->att('align')
},
);
$textbox->wrap_in('row');
if ($_->tag eq 'li') {
$textbox->insert_new_elt(
before => counter => { w => '3%', align => 'right' });
}
foreach my $child (@children) {
$child->paste(last_child => $textbox);
$child->set_text(
join(' ',
grep { length and $_ ne 1 } split(/\n+/, $child->text))
);
}
my $font = _get(font => $_);
if ($textbox->text =~ /[^\x00-\x7f]/) {
$font = $FontUnicode;
}
elsif ($_->parent('i') and $_->parent('b')) {
$font ||= $FontBoldOblique;
}
elsif ($_->parent('i')) {
$font ||= $FontOblique;
}
elsif ($_->parent('b')) {
$font ||= $FontBold;
}
my %attr;
$attr{face} = $font if $font;
if (_get(underline => $_)) {
my $align = $textbox->att('align');
$align .= '_underline';
$textbox->del_att('align');
require PDF::FromHTML::Template::Constants;
$PDF::FromHTML::Template::Constants::Verify{ALIGN}{$align} = 1
if %PDF::FromHTML::Template::Constants::Verify;
$attr{align} = $align;
}
$textbox->wrap_in('font' => \%attr) if %attr;
}
$_->insert_new_elt(first_child => 'textbox')->wrap_in('row')
if $_->tag eq 'p';
$_->erase;
}
sub _td {
return $_->erase if $_->descendants('row');
$_->set_tag('textbox');
if (my $font = _get(font => $_)) {
$_->wrap_in(font => { face => $font });
}
my $cols = $_->parent->att('_cols') || 0;
no warnings 'uninitialized';
if ($_->att('colspan') <= 1 and my $width = $_->att('width')) {
my $table_width = $_->root->att('#total_width') || 100;
my $cell_width = _percentify($width, int($table_width * $PageWidth / 100));
# Register us in the width table
my $widths = $_->root->att('#widths');
if (!$widths) {
$widths = [];
$_->root->set_att('#widths', $widths);
}
# warn "[$cols] = $widths->[$cols] vs $cell_width\n";
$widths->[$cols] = $cell_width if $widths->[$cols] < $cell_width;
}
$cols += ($_->att('colspan') || 1);
$_->parent->set_att(_cols => $cols);
$_->root->set_att('#total_cols', $cols)
if $_->root->att('#total_cols') < $cols;
if (my $rowspan = $_->att('rowspan')) {
# ok, we can't really do this.
# what we can do, though, is to add 'fake' cells in the next row.
our @RowSpan;
foreach my $i (1 .. ($rowspan - 1)) {
$RowSpan[$i][$cols] = $_->atts;
}
}
}
sub _percentify {
my $num = shift or return '100';
my $total_width = shift or Carp::confess( '100') ;
return $1 if $num =~ /(\d+)%/;
return int($num / $total_width * 100);
}
sub _type {
my ($val, $elt) = @_;
return first { $_ eq $val } grep defined, map $elt->att($_), qw(type class);
}
sub _to_color {
my ($color) = @_;
if ($color !~ s/^#//) {
$color = Graphics::ColorNames->new('Netscape')->hex($color);
}
return join ',', hex2tuple($color);
}
1;
=head1 AUTHORS
唐鳳 Ecpan@audreyt.orgE
=head1 CC0 1.0 Universal
To the extent possible under law, 唐鳳 has waived all copyright and related
or neighboring rights to PDF-FromHTML.
This work is published from Taiwan.
L
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/PaxHeader/Template.pm 000644 000765 000024 00000000036 13554103427 023112 x ustar 00audreyt staff 000000 000000 30 mtime=1571850007.000528651
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template.pm 000644 000765 000024 00000031426 13554103427 021150 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template;
use strict;
use warnings;
use base 'PDF::FromHTML::Template::Base';
our $VERSION = '0.33';
use PDF::Writer;
use File::Basename qw( fileparse );
use XML::Parser ();
#-----------------------------------------------
# TODO
#-----------------------------------------------
# PDF_set_info - find out more about this
# Providers - I need to create some provider classes that abstract
# the process of PDF creation. This will enable P::T to work with
# different PDF providers. A provider could be passed in to the
# constructor. If non is passed, P::T should try to instantiate a
# sensible provider depending on what is installed.
#-----------------------------------------------
sub new {
my $class = shift;
my $self = $class->SUPER::new(@_);
$self->{TEMPLATES} = [] unless UNIVERSAL::isa($self->{TEMPLATES}, 'ARRAY');
$self->{PARAM_MAP} = {} unless UNIVERSAL::isa($self->{PARAM_MAP}, 'HASH');
$self->{PDF_VERSION} = 0;
$self->_validate_option($_)
for qw(OPENACTION OPENMODE);
if ( !defined $self->{FILE} && defined $self->{FILENAME} ) {
$self->{FILE} = $self->{FILENAME};
}
$self->parse_xml($self->{FILE}) if defined $self->{FILE};
return $self;
}
sub param {
my $self = shift;
# Allow an arbitrary number of hashrefs, so long as they're the first things
# into param(). Put each one onto the end, de-referenced.
push @_, %{shift @_} while UNIVERSAL::isa($_[0], 'HASH');
(@_ % 2)
&& die __PACKAGE__, "->param() : Odd number of parameters to param()\n";
my %params = @_;
$params{uc $_} = delete $params{$_} for keys %params;
@{$self->{PARAM_MAP}}{keys %params} = @params{keys %params};
return 1;
}
sub write_file {
my $self = shift;
my ($fname) = @_;
my $p = PDF::Writer->new;
$p->open($fname) or die "Could not open file '$fname'.", $/;
$self->_prepare_output($p);
$p->save();
return 1;
}
sub get_buffer {
my $self = shift;
my $p = PDF::Writer->new;
$p->open() or die "Could not open buffer.", $/;
$self->_prepare_output($p);
return $p->stringify();
}
*output = \&get_buffer;
sub parse {
my $self = shift;
my ($file) = @_;
my %Has_TextObject = map { $_ => undef } qw(
BOOKMARK
IMAGE
TEXTBOX
);
my @stack;
my @params = (
Handlers => {
Start => sub {
shift;
my $name = uc shift;
# Pass the PDF encoding in.
if ($name eq 'PDFTEMPLATE') {
if (exists $self->{PDF_ENCODING}) {
push @_, (
PDF_ENCODING => $self->{PDF_ENCODING},
);
}
}
my $node = PDF::FromHTML::Template::Factory->create_node($name, @_);
die "'$name' (@_) didn't make a node!\n" unless defined $node;
if ($name eq 'VAR') {
return unless @stack;
if (exists $stack[-1]{TXTOBJ} && $stack[-1]{TXTOBJ}->isa('TEXTOBJECT')) {
push @{$stack[-1]{TXTOBJ}{STACK}}, $node;
}
}
elsif ($name eq 'PDFTEMPLATE') {
push @{$self->{TEMPLATES}}, $node;
}
else {
push @{$stack[-1]{ELEMENTS}}, $node
if @stack;
}
push @stack, $node;
},
Char => sub {
shift;
return unless @stack;
my $parent = $stack[-1];
if (exists $parent->{TXTOBJ} && $parent->{TXTOBJ}->isa('TEXTOBJECT')) {
push @{$parent->{TXTOBJ}{STACK}}, @_;
}
},
End => sub {
shift;
return unless @stack;
pop @stack if $stack[-1]->isa(uc $_[0]);
},
},
);
if ( exists $self->{PDF_ENCODING} ) {
push @params, ProtocolEncoding => $self->{PDF_ENCODING};
}
if ( ref $file ) {
*INFILE = $file;
}
else {
my ($filename, $dirname) = fileparse($file);
push @params, Base => $dirname;
open( INFILE, '<', $file )
|| die "Cannot open '$file' for reading: $!\n";
}
my $parser = XML::Parser->new( @params );
$parser->parse(do { local $/ = undef; });
close INFILE
unless ref $file;
return 1;
}
*parse_xml = \&parse;
my %NoSetProperty = map { $_ => 1 } qw(
CreationDate Producer ModDate Trapped
);
sub _prepare_output {
my $self = shift;
my ($p) = @_;
$p->parameter('openaction' => $self->{OPENACTION});
$p->parameter('openmode' => $self->{OPENMODE});
if (UNIVERSAL::isa($self->{INFO}, 'HASH')) {
foreach my $key ( keys %{$self->{INFO}} ) {
if ($NoSetProperty{$key}) {
warn "Document property '$key' cannot be set.", $/;
next;
}
$p->info($key, $self->{INFO}{$key});
}
}
else {
$p->info($_, __PACKAGE__) for qw/Creator Author/;
}
# __PAGE__ is incremented after the page is done.
$self->{PARAM_MAP}{__PAGE__} = 1;
# __PAGEDEF__ is incremented when the pagedef begins.
$self->{PARAM_MAP}{__PAGEDEF__} = 0;
my $context = PDF::FromHTML::Template::Factory->create(
'CONTEXT',
# Un-scoped variables
X => 0,
Y => 0,
# Other variables
PDF => $p,
PARAM_MAP => [ $self->{PARAM_MAP} ],
PDF_VERSION => $self->{PDF_VERSION},
DIE_ON_NO_PARAM => $self->{DIE_ON_NO_PARAM},
);
# Do a first pass through, noting important values
# $_->preprocess($context) for @{$self->{TEMPLATES}};
# Do a second pass through, for actual rendering
$_->render($context) for @{$self->{TEMPLATES}};
$context->close_images;
return 1;
}
sub register { shift; PDF::FromHTML::Template::Factory::register(@_) }
1;
__END__
=head1 NAME
PDF::FromHTML::Template - PDF::FromHTML::Template
=head1 SYNOPSIS
use PDF::FromHTML::Template;
my $pdf = PDF::FromHTML::Template->new({
file => 'some_template.xml',
});
$pdf->param(%my_params);
print "Content/type: application/pdf\n\n", $pdf->get_buffer;
$pdf->write_file('some_file.pdf');
=head1 DESCRIPTION
B: This is a fork of L 0.30, originally released by Rob Kinyon,
but (as of September 11, 2006) currently not available on CPAN. Use of this module
outside L is not advised.
PDF::FromHTML::Template is a PDF layout system that uses the same data structures as
L.
=head1 OVERVIEW
PDF::FromHTML::Template is a PDF layout system that uses the same data structures as
L. Unlike L, this is a full layout system. This means
you will have to describe where each item will be on the page. (This is in
contrast to L, which adds on to Lut is determined by
the HTML, not L.)
PDF::FromHTML::Template uses an XML document as the template. However, the XML is not
completely compliant. The only difference (that I'm aware of) is that any node
can have any parameter. (This prevents the creation of a DTD.) The reason for
this is to allow scoping by parents for parameters used by children. (More on
this later.)
Each node in the document corresponds to an object, with each parameter
mapping (mostly) 1 to 1 to an object attribute. Parent-child relationships are
strictly preserved. Each parent provides a scope (similar to variable scope) to
its children. (This is why any node can have any parameter.) If a child needs
the value of a parameter and it doesn't have that value as an attribute, it will
ask its parent for the value. If the parent doesn't have it, it will ask its
parent, and so on.
=head1 METHODS
=over 4
=item * C
This will create a new instance of PDF::FromHTML::Template. $opts is an optional hashref
that can contain the following parameters:
=over 4
=item * file
This is either the name of the file or the filehandle of the open file. If it
is present, C will be called upon that filename/filehandle. Otherwise,
after new() is called, you will have to call C yourself.
filename is a synonym for file.
=item * openaction
This is the action that the PDF reader will take when it opens this file. The
valid values are:
=over 4
=item * fitbox
=item * fitheight
=item * fitpage (default)
=item * fitwidth
=item * retain
=back
=item * openmode
This is the mode that the PDF reader will use when it opens this file. The
valid values are:
=over 4
=item * bookmarks
=item * fullscreen
=item * none (default)
=item * thumbnails
=back
=item * info
This is a hashref of information that you wish to have the PDF retain as
metadata. If this is not present, both Author and Creator will be set to
PDF::FromHTML::Template.
The following keys are not supported:
=over 4
=item * CreationDate
=item * Producer
=item * ModDate
=item * Trapped
=back
=item * pdf_encoding
This is the encoding that the template is in. It defaults to the host
encoding. This is different from the encoding parameter for the pdftemplate
tag.
=back
=item * C
This will parse the XML template into the appropriate datastructure(s) needed
for PDF::FromHTML::Template to function.
=item * C
This is a deprecated synonym for C.
=item * C value, [ key => value, ... ] )>
This will set the parameters that PDF::FromHTML::Template will use to merge the template
with. This method is identical to the HTML::Template or Template Toolkit
method of the same name.
=item * C
This will write the rendered PDF to the file specified in $filename.
=item * C
This will return the rendered PDF stringified in a form appropriate for
returning over an HTTP connection.
=item * C
This is a synonym for C provided for HTML::Template
compatibility.
=item * C
XXX
=back
=head1 USAGE
There are a few consistency rules that that every PDF::FromHTML::Template has to follow:
=over 4
=item 1 The root node is called PDFTEMPLATE
=item 2 There must be at least one PAGEDEF (which does not have to be a direct
child of the PDFTEMPLATE node)
=item 3 All rendering elements (include FONT tags) must be within a PAGEDEF node
=item 4 There must be a FONT tag as an ancestor of every TEXTBOX node
=item 5 Within a PAGEDEF, there can only be one HEADER node and one FOOTER node
=back
For more information about each node, please see the POD for that class.
=head1 WWW CAVEATS
When taking an HTML page and adding a PDF option, there are a few differences
to take into account. The primary one is the idea of pagebreaks. HTML is
displayed as a single page, with scrolling. Paper doesn't scroll, so when
there should be a new page is something PDF::FromHTML::Template works very hard at
determining. It will take into account any header and footer information
you've provided, as well as page sizes.
The second is that you have to determine how wide you want your text to be. One
of the most common activities is to take a tabular report and covert it to a
PDF. In HTML, the browser handles text width for you. Right now, there isn't a
TABLE tag (though work is being done on it). So, you have to layout out your
TEXTBOX nodes by hand. (See the EXAMPLES for some ideas on this.) That said, it
really isn't that hard. TR/TH tags convert to ROW tags easily, and TD tags are
basically TEXTBOX tags. Add a few width="20%" (or whatever) and you're fine.
=head1 BUGS
None, that I'm aware of.
=head1 LIMITATIONS
Currently, the only PDF renderer PDF::FromHTML::Template supports is PDFlib (available at
www.pdflib.com). The next release of PDF::FromHTML::Template will also support PDF::API2.
Unless you need Unicode support, PDFlib Lite is sufficient (and free). Please
see L for more details.
I am aware that PDFlib will not compile under AIX or Cygwin. These are
problems that PDFlib has acknowledged to me.
=head1 AUTHOR/MAINTAINER
Originally written by Dave Ferrance (dave@ferrance.org)
Taken over after v0.05 by Rob Kinyon (rob.kinyon@iinteractive.com)
=head1 CONTRIBUTORS
Patches and ideas provided by:
=over 4
=item * Audrey Tang
Provided the impetus to move to L (which she also wrote).
=item * Michael Kiwala
Aided in the design and testing of the transition from Dave Ferrance's
version.
=item * Nathan Byrd
Provided nearly all the initial doublebyte expertise.
=back
Additionally, there is a mailing list at
L
=head1 COPYRIGHT
This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.
=head1 SEE ALSO
perl(1).
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/PaxHeader/Constants.pm 000644 000765 000024 00000000036 13554101202 025053 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.230957531
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Constants.pm 000644 000765 000024 00000004431 13554101202 023105 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Constants;
use strict;
BEGIN {
use Exporter ();
use vars qw(@ISA @EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT_OK = qw(
%PointsPer
%Verify
);
}
# This is a list of conversions from various units of measure to points.
# The key will be the first letter of the unit.
our %PointsPer = (
I => 72.27, # Inches
P => 1, # Points
);
$PointsPer{C} = ($PointsPer{I} / 2.54); # Centimeters
#GGG Add:
# PDFTemplate properties (to go with %NoSetProperty)
our %Verify = (
#GGG This also needs improvement ... Not all available fonts are listed
'FACE' => {
'__DEFAULT__' => 'Times-Bold',
( map { $_ => 1 } qw(
Courier Courier-Bold Courier-Oblique Courier-BoldOblique
Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique
Times-Roman Times-Bold Times-Italic Times-BoldItalic
Symbol ZapfDingbats
)),
},
'ALIGN' => {
'__DEFAULT__' => 'left',
#GGG Add a full-justify option - this requires a lot of coding prowess
( map { $_ => 1 } qw(
center left right
)),
},
'OPENACTION' => {
'__DEFAULT__' => 'fitpage',
( map { $_ => 1 } qw(
fitbox fitheight fitpage fitwidth retain
)),
},
'OPENMODE' => {
'__DEFAULT__' => 'none',
( map { $_ => 1 } qw(
bookmarks fullscreen none thumbnails
)),
},
# Pagesize is specified in points
'PAGESIZE' => {
'__DEFAULT__' => 'Letter',
'Letter' => {
PAGE_WIDTH => 8.5 * $PointsPer{I},
PAGE_HEIGHT => 11 * $PointsPer{I},
},
'Legal' => {
PAGE_WIDTH => 8.5 * $PointsPer{I},
PAGE_HEIGHT => 14 * $PointsPer{I},
},
'A0' => {
PAGE_WIDTH => 2380,
PAGE_HEIGHT => 3368,
},
'A1' => {
PAGE_WIDTH => 1684,
PAGE_HEIGHT => 2380,
},
'A2' => {
PAGE_WIDTH => 1190,
PAGE_HEIGHT => 1684,
},
'A3' => {
PAGE_WIDTH => 842,
PAGE_HEIGHT => 1190,
},
'A4' => {
PAGE_WIDTH => 595,
PAGE_HEIGHT => 842,
},
},
);
1;
__END__
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Element/ 000755 000765 000024 00000000000 13554103473 022176 5 ustar 00audreyt staff 000000 000000 PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/PaxHeader/Element.pm 000644 000765 000024 00000000036 13554101202 024470 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.236203596
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Element.pm 000644 000765 000024 00000002124 13554101202 022517 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Element;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Base);
use PDF::FromHTML::Template::Base;
}
sub set_color
{
my $self = shift;
my ($context, $attr, $mode, $depth) = @_;
my $color = $context->get($self, $attr, $depth);
return 1 unless $color;
my @colors = map { $_ / 255 } split /,\s*/, $color, 3;
$context->{PDF}->color($mode, 'rgb', @colors);
return 1;
}
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Element
=head1 PURPOSE
To provide a base class for all rendering nodes.
=head1 COLORS
This is the class that handles colors. Colors in PDF::FromHTML::Template are specified in
RGB format, comma-separated. Each number is from 0 to 255, with 0 being none and
255 being most. If a color is not specified, 0 is assumed. Thus, "255,0,0",
"255,0", and "255" will all result in a red color.
Colors should be used for all attributes that have the word "COLOR" in the name.
This includes (but may not be limited to):
=over 4
=item * COLOR
=item * FILLCOLOR
=back
=head1 SEE ALSO
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/PaxHeader/Factory.pm 000644 000765 000024 00000000036 13554101202 024506 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.236687933
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Factory.pm 000644 000765 000024 00000007127 13554101202 022545 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Factory;
use strict;
BEGIN {
use vars qw(%Manifest %isBuildable);
}
%Manifest = (
# These are the instantiable nodes
'ALWAYS' => 'PDF::FromHTML::Template::Container::Always',
'CONDITIONAL' => 'PDF::FromHTML::Template::Container::Conditional',
'FONT' => 'PDF::FromHTML::Template::Container::Font',
'IF' => 'PDF::FromHTML::Template::Container::Conditional',
'LOOP' => 'PDF::FromHTML::Template::Container::Loop',
'PAGEDEF' => 'PDF::FromHTML::Template::Container::PageDef',
'PDFTEMPLATE' => 'PDF::FromHTML::Template::Container::PdfTemplate',
'ROW' => 'PDF::FromHTML::Template::Container::Row',
'SCOPE' => 'PDF::FromHTML::Template::Container::Scope',
'SECTION' => 'PDF::FromHTML::Template::Container::Section',
'HEADER' => 'PDF::FromHTML::Template::Container::Header',
'FOOTER' => 'PDF::FromHTML::Template::Container::Footer',
'BOOKMARK' => 'PDF::FromHTML::Template::Element::Bookmark',
'CIRCLE' => 'PDF::FromHTML::Template::Element::Circle',
'HR' => 'PDF::FromHTML::Template::Element::HorizontalRule',
'IMAGE' => 'PDF::FromHTML::Template::Element::Image',
'PAGEBREAK' => 'PDF::FromHTML::Template::Element::PageBreak',
'LINE' => 'PDF::FromHTML::Template::Element::Line',
'TEXTBOX' => 'PDF::FromHTML::Template::Element::TextBox',
'VAR' => 'PDF::FromHTML::Template::Element::Var',
'WEBLINK' => 'PDF::FromHTML::Template::Element::Weblink',
# These are the helper objects
'TEXTOBJECT' => 'PDF::FromHTML::Template::TextObject',
'CONTEXT' => 'PDF::FromHTML::Template::Context',
'ITERATOR' => 'PDF::FromHTML::Template::Iterator',
'MARGIN' => 'PDF::FromHTML::Template::Container::Margin',
'CONTAINER' => 'PDF::FromHTML::Template::Container',
'ELEMENT' => 'PDF::FromHTML::Template::Element',
'BASE' => 'PDF::FromHTML::Template::Base',
);
%isBuildable = map { $_ => 1 } qw(
ALWAYS
BOOKMARK
CIRCLE
CONDITIONAL
FONT
FOOTER
HEADER
HR
IF
IMAGE
LINE
LOOP
PAGEBREAK
PAGEDEF
PDFTEMPLATE
ROW
SCOPE
SECTION
TEXTBOX
VAR
WEBLINK
);
sub register
{
my %params = @_;
my @param_names = qw(name class isa);
for (@param_names)
{
unless ($params{$_})
{
warn "$_ was not supplied to register()\n";
return 0;
}
}
my $name = uc $params{name};
if (exists $Manifest{$name})
{
warn "$params{name} already exists in the manifest.\n";
return 0;
}
my $isa = uc $params{isa};
unless (exists $Manifest{$isa})
{
warn "$params{isa} does not exist in the manifest.\n";
return 0;
}
$Manifest{$name} = $params{class};
$isBuildable{$name} = 1;
{
no strict 'refs';
unshift @{"$params{class}::ISA"}, $Manifest{$isa};
}
return 1;
}
sub create
{
my $class = shift;
my $name = uc shift;
return unless exists $Manifest{$name};
(my $filename = $Manifest{$name}) =~ s!::!/!g;
eval {
require "$filename.pm";
}; if ($@) {
die "Cannot find or compile PM file for '$name' ($filename)\n";
}
return $Manifest{$name}->new(@_);
}
sub create_node
{
my $class = shift;
my $name = uc shift;
return unless exists $isBuildable{$name};
return $class->create($name, @_);
}
sub isa
{
return UNIVERSAL::isa($_[0], $Manifest{uc $_[1]})
if @_ >= 2 && exists $Manifest{uc $_[1]};
UNIVERSAL::isa(@_)
}
1;
__END__
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/PaxHeader/Iterator.pm 000644 000765 000024 00000000036 13554101202 024670 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.237090293
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Iterator.pm 000644 000765 000024 00000010331 13554101202 022716 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Iterator;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Base);
use PDF::FromHTML::Template::Base;
}
sub new
{
my $class = shift;
my $self = $class->SUPER::new(@_);
unless (PDF::FromHTML::Template::Factory::isa($self->{CONTEXT}, 'CONTEXT'))
{
die "Internal Error: No context object passed to ", __PACKAGE__, $/;
}
$self->{MAXITERS} ||= 0;
# This is the index we will work on NEXT, in whatever direction the
# iterator is going.
$self->{INDEX} = -1;
# This will always increment because it's tracking how many iterations
# have happened on this page, regardless of the direction the iterator
# is traveling.
$self->{ITERS_THIS_PAGE} = 0;
# This is a short-circuit parameter to let the iterator function in a
# null state.
$self->{NO_PARAMS} = 0;
unless ($self->{NAME} =~ /\w/)
{
$self->{NO_PARAMS} = 1;
warn "INTERNAL ERROR: 'NAME' was blank was blank when passed to ", __PACKAGE__, $/;
return $self;
}
# Cache the reference to the appropriate data.
$self->{DATA} = $self->{CONTEXT}->param($self->{NAME});
unless (UNIVERSAL::isa($self->{DATA}, 'ARRAY'))
{
$self->{NO_PARAMS} = 1;
warn "'$self->{NAME}' does not have a list of parameters", $/;
return $self;
}
unless (@{$self->{DATA}})
{
$self->{NO_PARAMS} = 1;
}
$self->{MAX_INDEX} = $#{$self->{DATA}};
return $self;
}
sub enter_scope
{
my $self = shift;
return 0 if $self->{NO_PARAMS};
for my $x ($self->{DATA}[$self->{INDEX}])
{
$x->{uc $_} = delete $x->{$_} for keys %$x;
}
push @{$self->{CONTEXT}{PARAM_MAP}}, $self->{DATA}[$self->{INDEX}];
return 1;
}
sub exit_scope
{
my $self = shift;
return 0 if $self->{NO_PARAMS};
# There has to be the base parameter map and at least the one that
# Iterator::enter_scope() added on top.
@{$self->{CONTEXT}{PARAM_MAP}} > 1 ||
die "Internal Error: ", __PACKAGE__, "'s internal param_map off!", $/;
pop @{$self->{CONTEXT}{PARAM_MAP}};
return 1;
}
sub can_continue
{
my $self = shift;
return 0 if $self->{NO_PARAMS};
return 1 if $self->more_params &&
$self->more_space &&
$self->more_iters;
return 0;
}
sub more_iters
{
my $self = shift;
return 0 if $self->{NO_PARAMS};
return 1 unless $self->{MAXITERS};
return 1 if $self->{MAXITERS} > $self->{ITERS_THIS_PAGE};
return 0;
}
sub more_params
{
my $self = shift;
return 0 if $self->{NO_PARAMS};
return 1 if $self->{MAX_INDEX} > $self->{INDEX};
return 0;
}
sub more_space
{
my $self = shift;
return 0 if $self->{NO_PARAMS};
return 1 if $self->{CONTEXT}->get($self, 'Y') >= ($self->{CONTEXT}->get($self, 'END_Y'));
return 0;
}
# Call this method BEFORE incrementing the index to the next value.
sub _do_globals
{
my $self = shift;
my $data = $self->{DATA}[$self->{INDEX}];
# Perl's arrays are 0-indexed. Thus, the first element is at index "0".
# This means that odd-numbered elements are at even indices, and vice-versa.
# This also means that MAX (the number of elements in the array) can never
# be the value of an index. It is NOT the last index in the array.
$data->{'__FIRST__'} ||= ($self->{INDEX} == 0);
$data->{'__INNER__'} ||= (0 < $self->{INDEX} && $self->{INDEX} < $self->{MAX_INDEX});
$data->{'__LAST__'} ||= ($self->{INDEX} == $self->{MAX_INDEX});
$data->{'__ODD__'} ||= !($self->{INDEX} % 2);
return 1;
}
sub next
{
my $self = shift;
return 0 if $self->{NO_PARAMS};
return 0 unless $self->more_params;
$self->exit_scope;
$self->{INDEX}++;
$self->{ITERS_THIS_PAGE}++;
$self->_do_globals;
$self->enter_scope;
return 1;
}
sub back_up
{
my $self = shift;
return 0 if $self->{NO_PARAMS};
$self->exit_scope;
$self->{INDEX}--;
$self->{ITERS_THIS_PAGE}++;
$self->_do_globals;
$self->enter_scope;
return 1;
}
sub reset
{
my $self = shift;
return 0 if $self->{NO_PARAMS};
$self->{INDEX} = -1;
$self->{ITERS_THIS_PAGE} = 0;
return 1;
}
1;
__END__
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/PaxHeader/Context.pm 000644 000765 000024 00000000036 13554101202 024523 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.237565024
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Context.pm 000644 000765 000024 00000015034 13554101202 022556 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Context;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Base);
use PDF::FromHTML::Template::Base;
use PDF::FromHTML::Template::Constants qw( %PointsPer );
}
# This is a helper object. It is not instantiated by the user,
# nor does it represent an XML object. Rather, every container
# will use this object to maintain the context for its children.
sub new {
my $class = shift;
my $self = $class->SUPER::new(@_);
$self->{FONTS} = {} unless UNIVERSAL::isa($self->{FONTS}, 'HASH');
$self->{IMAGES} = {} unless UNIVERSAL::isa($self->{IMAGES}, 'HASH');
$self->{PARAM_MAP} = [] unless UNIVERSAL::isa($self->{PARAM_MAP}, 'ARRAY');
$self->{STACK} = [] unless UNIVERSAL::isa($self->{STACK}, 'ARRAY');
$self->reset_pagebreak;
return $self;
}
sub param {
my $self = shift;
my ($param, $depth) = @_;
$param = uc $param;
$depth ||= 0;
my $val = undef;
my $found = 0;
for my $map (reverse @{$self->{PARAM_MAP}}) {
next unless exists $map->{$param};
$depth--, next if $depth;
$found = 1;
$val = $map->{$param};
last;
}
die "Parameter '$param' not found", $/
if !$found && $self->{DIE_ON_NO_PARAM};
return $val;
}
#GGG This is god-awful
my %isDimension = map { $_ => 1 } qw(
X Y W H R
START_Y END_Y
X1 X2 Y1 Y2
PAGE_HEIGHT PAGE_WIDTH
HEADER_HEIGHT FOOTER_HEIGHT
LEFT_MARGIN RIGHT_MARGIN
LMARGIN RMARGIN
SIZE WIDTH SCALE
);
sub resolve {
my $self = shift;
my ($obj, $key, $depth) = @_;
$key = uc $key;
$depth ||= 0;
my $obj_val = $obj->{$key};
my $is_param = 0;
$is_param = 1 if $obj_val =~ s/\$(\w+)/$self->param($1)/eg;
return $obj_val unless $isDimension{$key};
#GGG Does this adequately test values to make sure they're legal??
# A value is defined as:
# 1) An optional operator (+, -, *, or /)
# 2) A decimal number
# 3) An optional unit (currently I, P, or C) or % (indicating percentage)
#GGG Convert this to use //x
my ($op, $val, $unit) = $obj_val =~ m!^\s*([\+\*\/\-])?\s*([\d.]*\d)\s*([a-z%]+)?\s*$!oi;
$op ||= '';
if ($unit) {
# Only the first character of the unit is useful, and it needs to be uppercase to key
# into %PointsPer.
my $uom = uc substr($unit, 0, 1);
if ($uom eq '%') {
#GGG Is this all that's needed?
if ($key eq 'W') {
$val *= ($self->get($obj, 'PAGE_WIDTH') -
$self->get($obj, 'LEFT_MARGIN') -
$self->get($obj, 'RIGHT_MARGIN'));
}
elsif ($key eq 'H') {
$val *= ($self->get($obj, 'PAGE_HEIGHT') -
$self->get($obj, 'HEADER_HEIGHT') -
$self->get($obj, 'FOOTER_HEIGHT'));
}
$val /= 100;
}
elsif (exists $PointsPer{$uom}) {
$val *= $PointsPer{$uom};
}
else {
warn "'$unit' is not a recognized unit of measurement.", $/;
}
$obj->{$key} = $op . $val unless $is_param;
$obj_val = $val;
}
return $obj_val unless $op;
my $prev_val = $key eq 'X' || $key eq 'Y'
? $self->{$key}
: $self->get($obj, $key, $depth + 1);
return $obj_val unless defined $prev_val;
return $prev_val unless defined $obj_val;
# Prevent divide-by-zero issues.
return $val if $op eq '/' and $val == 0;
my $new_val;
for ($op) {
/^\+$/ && do { $new_val = ($prev_val + $val); last; };
/^\-$/ && do { $new_val = ($prev_val - $val); last; };
/^\*$/ && do { $new_val = ($prev_val * $val); last; };
/^\/$/ && do { $new_val = ($prev_val / $val); last; };
die "Unknown operator '$op' in arithmetic resolve", $/;
}
return $new_val if defined $new_val;
return;
}
sub enter_scope {
my $self = shift;
my ($obj) = @_;
push @{$self->{STACK}}, $obj;
for my $key (qw(X Y)) {
next unless exists $obj->{$key};
$self->{$key} = $self->resolve($obj, $key);
}
return 1;
}
sub exit_scope {
my $self = shift;
my ($obj, $no_delta) = @_;
unless ($no_delta) {
my $deltas = $obj->deltas($self);
$self->{$_} += $deltas->{$_} for keys %$deltas;
}
pop @{$self->{STACK}};
return 1;
}
sub get {
my $self = shift;
my ($dummy, $key, $depth) = @_;
$depth ||= 0;
$key = uc $key;
return unless @{$self->{STACK}};
my $obj = $self->{STACK}[-1];
if (exists $obj->{"TEMP_$key"}) {
my $val = delete $obj->{"TEMP_$key"};
return $val;
}
return $self->{$key} if $key eq 'X' || $key eq 'Y';
my $val = undef;
my $this_depth = $depth;
foreach my $e (reverse @{$self->{STACK}}) {
next unless exists $e->{$key};
next if $this_depth-- > 0;
$val = $self->resolve($e, $key, $depth);
last;
}
$val = $self->{$key} unless defined $val;
return $val unless defined $val;
return $self->param($1, $depth) if $val =~ /^\$(\S+)$/o;
return $val;
}
sub should_render {
my $self = shift;
my ($obj) = @_;
# The objects for which this would be bad are going to bypass this check as they
# see fit. All other objects should not render if the pagebreak has been tripped.
return 0 if $self->pagebreak_tripped;
return $self->check_end_of_page($obj);
}
sub check_end_of_page {
my $self = shift;
my ($obj) = @_;
my $deltas = $obj->deltas($self);
if (
($self->get($obj, 'Y') || 0) + ($deltas->{Y} || 0)
< ($self->get($obj, 'END_Y') || 0)
) {
$self->trip_pagebreak;
return 0;
}
return 1;
}
sub close_images {
my $self = shift;
my $p = $self->{PDF};
$p->close_image($_) for values %{$self->{IMAGES}};
}
sub new_page_def {
my $self = shift;
$self->{PARAM_MAP}[0]{__PAGEDEF__}++;
$self->{PARAM_MAP}[0]{__PAGEDEF_PAGE__} = 1;
}
sub trip_pagebreak { $_[0]{PB_TRIP} = 1 }
sub reset_pagebreak { $_[0]{PB_TRIP} = 0 }
sub pagebreak_tripped { $_[0]{PB_TRIP} = $_[1] if defined $_[1]; $_[0]{PB_TRIP} }
sub store_font { $_[0]{FONTS}{$_[1]} ||= $_[2] }
sub retrieve_font { $_[0]{FONTS}{$_[1]} }
sub delete_fonts { $_[0]{FONTS} = {}; }
sub store_image { $_[0]{IMAGES}{$_[1]} ||= $_[2] }
sub retrieve_image { $_[0]{IMAGES}{$_[1]} }
sub increment_pagenumber { $_[0]{PARAM_MAP}[0]{$_}++ for qw(__PAGE__ __PAGEDEF_PAGE__) }
1;
__END__
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/ 000755 000765 000024 00000000000 13554103473 022527 5 ustar 00audreyt staff 000000 000000 PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/PaxHeader/Container.pm 000644 000765 000024 00000000036 13554101202 025021 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.242111096
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container.pm 000644 000765 000024 00000005272 13554101202 023057 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Container;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Base);
use PDF::FromHTML::Template::Base;
}
# Containers are objects that can contain arbitrary elements, such as
# PageDefs or Loops.
sub new
{
my $class = shift;
my $self = $class->SUPER::new(@_);
$self->{ELEMENTS} = [] unless UNIVERSAL::isa($self->{ELEMENTS}, 'ARRAY');
return $self;
}
sub _do_page
{
my $self = shift;
my ($context, $method) = @_;
for my $e (@{$self->{ELEMENTS}})
{
$e->enter_scope($context);
$e->$method($context);
$e->exit_scope($context, 1);
}
return 1;
}
sub begin_page { _do_page @_, 'begin_page' }
#{
# my $self = shift;
# my ($context) = @_;
#
# for my $e (@{$self->{ELEMENTS}})
# {
# $e->enter_scope($context);
# $e->begin_page($context);
# $e->exit_scope($context, 1);
# }
#
# return 1;
#}
sub end_page { _do_page @_, 'end_page' }
#{
# my $self = shift;
# my ($context) = @_;
#
# for my $e (@{$self->{ELEMENTS}})
# {
# $e->enter_scope($context);
# $e->end_page($context);
# $e->exit_scope($context, 1);
# }
#
# return 1;
#}
sub reset
{
my $self = shift;
$self->SUPER::reset;
$_->reset for @{$self->{ELEMENTS}};
}
sub iterate_over_children
{
my $self = shift;
my ($context) = @_;
my $continue = 1;
for my $e (grep !$_->has_rendered, @{$self->{ELEMENTS}})
{
$e->enter_scope($context);
my $rc;
if ($rc = $e->render($context))
{
$e->mark_as_rendered;
}
$continue = $rc if $continue;
$e->exit_scope($context);
}
return $continue;
}
sub render
{
my $self = shift;
my ($context) = @_;
return 0 unless $self->should_render($context);
return $self->iterate_over_children($context);
}
sub max_of
{
my $self = shift;
my ($context, $attr) = @_;
my $max = $context->get($self, $attr);
ELEMENT:
foreach my $e (@{$self->{ELEMENTS}})
{
$e->enter_scope($context);
my $v = $e->isa('CONTAINER')
? $e->max_of($context, $attr)
: $e->calculate($context, $attr);
$max = $v if $max < $v;
$e->exit_scope($context, 1);
}
return $max;
}
sub total_of
{
my $self = shift;
my ($context, $attr) = @_;
my $total = 0;
ELEMENT:
foreach my $e (@{$self->{ELEMENTS}})
{
$e->enter_scope($context);
$total += $e->isa('CONTAINER')
? $e->total_of($context, $attr)
: $e->calculate($context, $attr);
$e->exit_scope($context, 1);
}
return $total;
}
1;
__END__
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/PaxHeader/Base.pm 000644 000765 000024 00000000036 13554101202 023751 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.242480758
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Base.pm 000644 000765 000024 00000005430 13554101202 022003 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Base;
use strict;
BEGIN {
}
use PDF::FromHTML::Template::Constants qw(
%Verify
);
use PDF::FromHTML::Template::Factory;
sub new
{
my $class = shift;
push @_, %{shift @_} while UNIVERSAL::isa($_[0], 'HASH');
(@_ % 2) && die "$class->new() called with odd number of option parameters", $/;
my %x = @_;
# Do not use a hashref-slice here because of the uppercase'ing
my $self = {};
$self->{uc $_} = $x{$_} for keys %x;
$self->{__THIS_HAS_RENDERED__} = 0;
bless $self, $class;
}
sub isa { PDF::FromHTML::Template::Factory::isa(@_) }
# These functions are used in the P::T::Container & P::T::Element hierarchies
sub _validate_option
{
my $self = shift;
my ($option, $val_ref) = @_;
$option = uc $option;
return 1 unless exists $Verify{$option} && UNIVERSAL::isa($Verify{$option}, 'HASH');
if (defined $val_ref)
{
if (!defined $$val_ref)
{
$$val_ref = $Verify{$option}{'__DEFAULT__'};
}
elsif (!exists $Verify{$option}{$$val_ref})
{
my $name = ucfirst lc $option;
warn "$name '$$val_ref' unsupported. Defaulting to '$Verify{$option}{'__DEFAULT__'}'", $/;
$$val_ref = $Verify{$option}{'__DEFAULT__'};
}
}
elsif (!defined $self->{$option})
{
$self->{$option} = $Verify{$option}{'__DEFAULT__'};
}
elsif (!exists $Verify{$option}{$self->{$option}})
{
my $name = ucfirst lc $option;
warn "$name '$self->{$option}' unsupported. Defaulting to '$Verify{$option}{'__DEFAULT__'}'", $/;
$self->{$option} = $Verify{$option}{'__DEFAULT__'};
}
return 1;
}
sub calculate { ($_[1])->get(@_[0,2]) }
#{
# my $self = shift;
# my ($context, $attr) = @_;
#
# return $context->get($self, $attr);
#}
sub enter_scope { ($_[1])->enter_scope($_[0]) }
#{
# my $self = shift;
# my ($context) = @_;
#
# return $context->enter_scope($self);
#}
sub exit_scope { ($_[1])->exit_scope(@_[0, 2]) }
#{
# my $self = shift;
# my ($context, $no_delta) = @_;
#
# return $context->exit_scope($self, $no_delta);
#}
sub deltas
{
# my $self = shift;
# my ($context) = @_;
return {};
}
sub reset { $_[0]{__THIS_HAS_RENDERED__} = 0 }
sub mark_as_rendered { $_[0]{__THIS_HAS_RENDERED__} = 1 }
sub has_rendered { $_[0]{__THIS_HAS_RENDERED__} }
sub should_render { ($_[0]{__THIS_HAS_RENDERED__}) || (($_[1])->should_render($_[0])) }
sub resolve
{
# my $self = shift;
# my ($context) = @_;
'';
}
sub render
{
# my $self = shift;
# my ($context) = @_;
return 1;
}
sub begin_page
{
# my $self = shift;
# my ($context) = @_;
return 1;
}
sub end_page
{
# my $self = shift;
# my ($context) = @_;
return 1;
}
1;
__END__
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/PaxHeader/TextObject.pm 000644 000765 000024 00000000036 13554101202 025152 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.242904624
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/TextObject.pm 000644 000765 000024 00000002101 13554101202 023174 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::TextObject;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Base);
use PDF::FromHTML::Template::Base;
use Encode;
}
# This is a helper object. It is not instantiated by the user,
# nor does it represent an XML object. Rather, certain elements,
# such as , can use this object to do text with variable
# substitutions.
sub new
{
my $class = shift;
my $self = $class->SUPER::new(@_);
$self->{STACK} = [] unless UNIVERSAL::isa($self->{STACK}, 'ARRAY');
return $self;
}
sub resolve
{
my $self = shift;
my ($context) = @_;
my $t = '';
for my $tok (@{$self->{STACK}})
{
my $val = $tok;
$val = $val->resolve($context)
if PDF::FromHTML::Template::Factory::isa($val, 'VAR');
my $encoding = $context->get($self, 'PDF_ENCODING');
if ($encoding) {
if (Encode::is_utf8($val)) {
$val = Encode::encode($encoding,$val);
}
}
$t .= $val;
}
return $t;
}
1;
__END__
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/PaxHeader/Header.pm 000644 000765 000024 00000000036 13554101202 026211 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.238126524
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/Header.pm 000644 000765 000024 00000002365 13554101202 024247 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Container::Header;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Container::Margin);
use PDF::FromHTML::Template::Container::Margin;
}
sub enter_scope
{
my $self = shift;
my ($context) = @_;
$self->SUPER::enter_scope( $context );
@{$self}{qw/OLD_X OLD_Y/} = map { $context->get($self, $_) } qw(X Y);
$context->{X} = 0;
$context->{Y} = $context->get($self, 'PAGE_HEIGHT');
return 1;
}
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Container::Header
=head1 PURPOSE
To provide header text and to specify where the header starts, for looping.
=head1 NODE NAME
HEADER
=head1 INHERITANCE
PDF::FromHTML::Template::Container::Margin
=head1 ATTRIBUTES
=over 4
=item * HEADER_HEIGHT - the amount reserved for the header from the bottom of
the page.
=back
=head1 CHILDREN
None
=head1 AFFECTS
Indicates to the PAGEDEF tag where all children may start rendering.
=head1 DEPENDENCIES
None
=head1 USAGE
... Children here will render on every page ...
... Stuff here ...
=head1 AUTHOR
Rob Kinyon (rkinyon@columbus.rr.com)
=head1 SEE ALSO
ALWAYS, FOOTER, PAGEDEF
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/PaxHeader/Always.pm 000644 000765 000024 00000000036 13554101202 026261 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.238530779
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/Always.pm 000644 000765 000024 00000003071 13554101202 024312 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Container::Always;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Container);
use PDF::FromHTML::Template::Container;
}
sub enter_scope
{
my $self = shift;
my ($context) = @_;
$self->SUPER::enter_scope($context);
$self->{OLD_TRIP} = $context->pagebreak_tripped;
$context->reset_pagebreak;
return 1;
}
sub exit_scope
{
my $self = shift;
my ($context) = @_;
$context->pagebreak_tripped($self->{OLD_TRIP});
$self->reset;
return $self->SUPER::exit_scope($context);
}
sub mark_as_rendered {}
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Container::Always
=head1 PURPOSE
To require that any child of this node will always render on every page.
Normally, a node will not render on a given page if a node before it has
triggered a pagebreak. ALWAYS nodes will always render on every page.
Primarily, this is used as a base class for HEADER and FOOTER. However, you
might want something to always render on every page outside the header and
footer areas. For example, a watermark.
=head1 NODE NAME
ALWAYS
=head1 INHERITANCE
PDF::FromHTML::Template::Container
=head1 ATTRIBUTES
None
=head1 CHILDREN
PDF::FromHTML::Template::Container::Margin
PDF::FromHTML::Template::Container::Header
PDF::FromHTML::Template::Container::Footer
=head1 AFFECTS
Nothing
=head1 DEPENDENCIES
None
=head1 USAGE
... Children will render on every page ...
=head1 AUTHOR
Rob Kinyon (rkinyon@columbus.rr.com)
=head1 SEE ALSO
HEADER, FOOTER
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/PaxHeader/Margin.pm 000644 000765 000024 00000000036 13554101202 026236 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.238835766
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/Margin.pm 000644 000765 000024 00000003407 13554101202 024272 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Container::Margin;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Container::Always);
use PDF::FromHTML::Template::Container::Always;
}
# This is the common parent for and . It exists so that
# common code can be factored out. The code here is used for redefining
# Context::should_render(). Normally, it restricts display only to
# between the top and bottom margins. However, footers and headers are
# supposed to write in those margins, so the children of this type of
# node need to be allowed anywhere on the page.
sub enter_scope
{
my $self = shift;
my ($context) = @_;
$self->SUPER::enter_scope($context);
{
no strict 'refs';
my $class = ref $context;
$self->{OLD_CHECK_EOP} = \&{"${class}::check_end_of_page"};
*{"${class}::check_end_of_page"} = sub { return 1 };
}
return 1;
}
sub exit_scope
{
my $self = shift;
my ($context) = @_;
{
no strict 'refs';
my $class = ref $context;
*{"${class}::check_end_of_page"} = delete $self->{OLD_CHECK_EOP};
}
@{$context}{qw/X Y/} = @{$self}{qw/OLD_X OLD_Y/};
return $self->SUPER::exit_scope($context);
}
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Container::Margin
=head1 PURPOSE
A base class for HEADER and FOOTER
=head1 NODE NAME
None (This is not a rendering class)
=head1 INHERITANCE
PDF::FromHTML::Template::Container::Always
=head1 ATTRIBUTES
None
=head1 CHILDREN
PDF::FromHTML::Template::Container::Footer
PDF::FromHTML::Template::Container::Header
=head1 AFFECTS
Nothing
=head1 DEPENDENCIES
None
=head1 USAGE
None
=head1 AUTHOR
Rob Kinyon (rkinyon@columbus.rr.com)
=head1 SEE ALSO
ALWAYS, HEADER, FOOTER
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/PaxHeader/Font.pm 000644 000765 000024 00000000036 13554101202 025727 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.239127159
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/Font.pm 000644 000765 000024 00000006317 13554101202 023766 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Container::Font;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Container);
use PDF::FromHTML::Template::Container;
}
my @current_font = ();
sub new
{
my $class = shift;
my $self = $class->SUPER::new(@_);
$self->{EMBED} = 0 unless defined $self->{EMBED};
return $self;
}
sub render
{
my $self = shift;
my ($context) = @_;
my $p = $context->{PDF};
my $size = $context->get($self, 'H') ||
$context->get($self, 'SIZE') ||
die "Height not set by the time was rendered", $/;
my $face = $context->get($self, 'FACE') ||
die "Face not set by the time was rendered", $/;
my $font = $context->retrieve_font($face);
$font == -1 && die "Font not found for '$face' by the time was rendered", $/;
$p->font($font, $size);
push @current_font, [ $font, $size ];
return 1 unless @{$self->{ELEMENTS}};
my $child_success = $self->iterate_over_children($context);
pop @current_font;
return $child_success unless @current_font;
$p->font(@{$current_font[-1]});
return $child_success;
}
sub mark_as_rendered {}
sub begin_page
{
my $self = shift;
my ($context) = @_;
my $face = $context->get($self, 'FACE') ||
die "Face not set by the time was rendered", $/;
unless ($context->retrieve_font($face))
{
my $encoding = $context->get($self, 'PDF_ENCODING') || 'host';
my $font = $context->{PDF}->find_font(
$face,
$encoding,
$context->get($self, 'EMBED'),
) or die "Font not found for '$face' by the time was rendered", $/;
$context->store_font($face, $font);
}
return $self->SUPER::begin_page($context);
}
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Container::Font
=head1 PURPOSE
To specify the font used for TEXTBOX nodes
=head1 NODE NAME
FONT
=head1 INHERITANCE
PDF::FromHTML::Template::Container
=head1 ATTRIBUTES
=over 4
=item * FACE - this is required. It must be a legal font face recognized by
PDFLib. (q.v. for more details)
=item * H - the point size of the font.
=back
=head1 CHILDREN
None
=head1 AFFECTS
The font used when rendering a TEXTBOX
=head1 DEPENDENCIES
None
=head1 USAGE
... Children will be rendered in 8-point TimesRoman font ...
Please note that not specifying a FONT tag will result in a PDFLib error when
the first TEXTBOX attempts to render. Since not all PDF documents involve text,
PDF::FromHTML::Template does not require a FONT tag.
(I might require a FONT tag if a TEXTBOX tag exists, but only after the non-
standard behavior of FONT is fixed. q.v. the NOTE below.)
=head1 NOTE
For backwards compatability, a stand-alone FONT tag will be treated as if it is
the parent for all nodes until the end of the parent node. This behavior is
deprecated and will be removed in a future release.
... Children here aren't affected by the FONT tag below ...
... Children here _ARE_ affected by the FONT tag above ...
=head1 AUTHOR
Rob Kinyon (rkinyon@columbus.rr.com)
=head1 SEE ALSO
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/PaxHeader/Section.pm 000644 000765 000024 00000000036 13554101202 026425 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.239529144
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/Section.pm 000644 000765 000024 00000004150 13554101202 024455 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Container::Section;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Container);
use PDF::FromHTML::Template::Container;
}
# Sections are used to keep text together and not allow page-breaking
# within this branch of the tree, if possible.
sub new
{
my $class = shift;
my $self = $class->SUPER::new(@_);
$self->{__CHECK_FOR_SPACE__} = 1;
return $self;
}
sub reset
{
my $self = shift;
$self->{__CHECK_FOR_SPACE__} = 1;
return $self->SUPER::reset;
}
sub render
{
my $self = shift;
my ($context) = @_;
return 0 unless $self->should_render($context);
my $child_success = $self->iterate_over_children($context);
$self->{__CHECK_FOR_SPACE__} = $child_success;
return $child_success;
}
sub should_render
{
my $self = shift;
my ($context) = @_;
return 0 if $context->pagebreak_tripped;
unless ($self->{__CHECK_FOR_SPACE__})
{
$self->{__CHECK_FOR_SPACE__} = 1;
return 1;
}
my $y_shift = $self->total_of($context, 'H');
my $end_y = $context->get($self, 'END_Y');
if ($context->{Y} - $y_shift < $end_y)
{
my $start_y = $context->get($self, 'START_Y');
$self->{__CHECK_FOR_SPACE__} = 0 if $y_shift > ($start_y - $end_y);
return 1 if $context->{Y} == $start_y;
$context->trip_pagebreak;
return 0;
}
return 1;
}
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Container::Section
=head1 PURPOSE
To provide a keep-together for children. If a pagebreak would occur within the
section tag, then the entire branch is rendered on the next page. If the branch
would take more than a page anyways, the section tag is ignored.
=head1 NODE NAME
SECTION
=head1 INHERITANCE
PDF::FromHTML::Template::Container
=head1 ATTRIBUTES
None
=head1 CHILDREN
None
=head1 AFFECTS
Nothing
=head1 DEPENDENCIES
None
=head1 USAGE
The children will be rendered on the same page, if at all possible.
=head1 AUTHOR
Rob Kinyon (rkinyon@columbus.rr.com)
=head1 SEE ALSO
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/PaxHeader/PdfTemplate.pm 000644 000765 000024 00000000036 13554101202 027226 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.239875704
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/PdfTemplate.pm 000644 000765 000024 00000004217 13554101202 025262 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Container::PdfTemplate;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Container);
use PDF::FromHTML::Template::Container;
}
sub new {
my $class = shift;
my $self = $class->SUPER::new(@_);
# The default color is black
$self->{COLOR} = '0,0,0' unless exists $self->{COLOR};
return $self;
}
sub should_render {
# my $self = shift;
# my ($context) = @_;
return 1;
}
sub render {
my $self = shift;
my ($context) = @_;
$self->enter_scope($context);
my $child_success = $self->SUPER::render($context)
if $self->should_render($context);
$self->exit_scope($context);
return $child_success;
}
#sub preprocess {
# my $self = shift;
# my ($context) = @_;
#
# $self->enter_scope($context);
#
# $context->{PARAM_MAP}[0]{__LAST_PAGE__} = 0;
# unless ($context->get($self, 'NOLASTPAGE')) {
# my $old_PDF = $context->{PDF};
#
# my $p = PDF::Writer->new;
# $p->open() or die "Could not open buffer.", $/;
#
# $context->{PDF} = $p;
#
# $context->{CALC_LAST_PAGE} = 1;
# $self->SUPER::render($context);
# $context->{CALC_LAST_PAGE} = 0;
#
# $p->close;
# $self->reset;
# $context->delete_fonts;
#
# $context->{PDF} = $old_PDF;
# $context->{PARAM_MAP}[0]{__LAST_PAGE__} = $context->{PARAM_MAP}[0]{__PAGE__} - 1;
# $context->{PARAM_MAP}[0]{__PAGE__} = 1;
# $context->{PARAM_MAP}[0]{__PAGEDEF__} = 0;
# }
#
# $self->exit_scope($context, 1);
#
# return 1;
#}
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Container::PdfTemplate
=head1 PURPOSE
The root node
=head1 NODE NAME
PDFTEMPLATE
=head1 INHERITANCE
PDF::FromHTML::Template::Container
=head1 ATTRIBUTES
=over 4
=item * NOLASTPAGE - If this is set to true, then __LAST_PAGE__ will not be
calculated. This can provide a decent speed improvement.
=back
=head1 CHILDREN
None
=head1 AFFECTS
Nothing
=head1 DEPENDENCIES
None
=head1 USAGE
... Children here ...
=head1 AUTHOR
Rob Kinyon (rkinyon@columbus.rr.com)
=head1 SEE ALSO
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/PaxHeader/Loop.pm 000644 000765 000024 00000000036 13554101202 025732 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.240155248
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/Loop.pm 000644 000765 000024 00000006731 13554101202 023771 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Container::Loop;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Container);
use PDF::FromHTML::Template::Container;
}
sub new
{
my $class = shift;
my $self = $class->SUPER::new(@_);
if (exists $self->{MAXITERS} && $self->{MAXITERS} < 1)
{
die " MAXITERS must be greater than or equal to 1", $/;
}
else
{
$self->{MAXITERS} = 0;
}
return $self;
}
sub _do_page
{
my $self=shift;
my ($context) = @_;
return 0 unless $self->should_render($context);
unless ($self->{ITERATOR} && $self->{ITERATOR}->more_params)
{
$self->{ITERATOR} = $self->make_iterator($context);
}
my $iterator = $self->{ITERATOR};
$iterator->enter_scope;
while ($iterator->can_continue)
{
$iterator->next;
$self->SUPER::begin_page($context);
}
$iterator->exit_scope;
return 1;
}
sub begin_page
{
_do_page(@_,'begin_page');
}
sub end_page
{
_do_page(@_,'end_page');
}
sub make_iterator
{
my $self = shift;
my ($context) = @_;
return PDF::FromHTML::Template::Factory->create('ITERATOR',
NAME => $context->get($self, 'NAME'),
MAXITERS => $context->get($self, 'MAXITERS'),
CONTEXT => $context,
);
}
sub render
{
my $self = shift;
my ($context) = @_;
return 0 unless $self->should_render($context);
unless ($self->{ITERATOR} && $self->{ITERATOR}->more_params)
{
$self->{ITERATOR} = $self->make_iterator($context);
}
my $iterator = $self->{ITERATOR};
$iterator->enter_scope;
while ($iterator->can_continue)
{
$iterator->next;
unless ($self->iterate_over_children($context))
{
$iterator->back_up;
last;
}
$self->reset;
}
$iterator->exit_scope;
if ($iterator->more_params) {
splice(@{$iterator->{DATA}}, 0, $iterator->{INDEX}+1);
$iterator->{MAX_INDEX} = $#{$iterator->{DATA}};
return 0;
}
return 1;
}
sub total_of
{
my $self = shift;
my ($context, $attr) = @_;
my $iterator = $self->make_iterator($context);
my $total = 0;
$iterator->enter_scope;
while ($iterator->can_continue)
{
$iterator->next;
$total += $self->SUPER::total_of($context, $attr);
}
$iterator->exit_scope;
return $total;
}
sub max_of
{
my $self = shift;
my ($context, $attr) = @_;
my $iterator = $self->make_iterator($context);
my $max = $context->get($self, $attr);
$iterator->enter_scope;
while ($iterator->can_continue)
{
$iterator->next;
my $v = $self->SUPER::max_of($context, $attr);
$max = $v if $max < $v;
}
$iterator->exit_scope;
return $max;
}
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Container::Loop
=head1 PURPOSE
To provide a looping construct
=head1 NODE NAME
LOOP
=head1 INHERITANCE
PDF::FromHTML::Template::Container
=head1 ATTRIBUTES
=over 4
=item * NAME - the name of a parameter that points to an array of hashes.
=back
=head1 CHILDREN
None
=head1 AFFECTS
Nothing
=head1 DEPENDENCIES
FOOTER - indicates where to pagebreak
=head1 USAGE
... Children here ...
The children tags will have access to the values specified in LOOPY, as well as
the parameters specifed outside.
=head1 AUTHOR
Rob Kinyon (rkinyon@columbus.rr.com)
=head1 SEE ALSO
HTML::Template, FOOTER
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/PaxHeader/Footer.pm 000644 000765 000024 00000000035 13554101202 026256 x ustar 00audreyt staff 000000 000000 29 mtime=1571848834.24051874
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/Footer.pm 000644 000765 000024 00000002330 13554101202 024305 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Container::Footer;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Container::Margin);
use PDF::FromHTML::Template::Container::Margin;
}
sub enter_scope
{
my $self = shift;
my ($context) = @_;
$self->SUPER::enter_scope($context);
@{$self}{qw/OLD_X OLD_Y/} = map { $context->get($self, $_) } qw(X Y);
$context->{X} = 0;
$context->{Y} = $context->get($self, 'FOOTER_HEIGHT');
return 1;
}
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Container::Footer
=head1 PURPOSE
To provide footer text and to specify where the footer starts, for looping.
=head1 NODE NAME
FOOTER
=head1 INHERITANCE
PDF::FromHTML::Template::Container::Margin
=head1 ATTRIBUTES
=over 4
=item * FOOTER_HEIGHT - the amount reserved for the footer from the bottom of
the page.
=back
=head1 CHILDREN
None
=head1 AFFECTS
Indicates to LOOP tags where to pagebreak.
=head1 DEPENDENCIES
None
=head1 USAGE
... Stuff here ...
... Children here will render on every page ...
=head1 AUTHOR
Rob Kinyon (rkinyon@columbus.rr.com)
=head1 SEE ALSO
ALWAYS, HEADER, LOOP
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/PageDef.pm 000644 000765 000024 00000012700 13554101242 024350 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Container::PageDef;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Container);
use PDF::FromHTML::Template::Container;
}
use PDF::FromHTML::Template::Constants qw( %Verify );
sub new
{
my $class = shift;
my $self = $class->SUPER::new(@_);
$self->{NOPAGENUMBER} = 0 unless defined $self->{NOPAGENUMBER};
$self->{MARGINS} = 0 unless exists $self->{MARGINS};
$self->{$_} = $self->{MARGINS} for grep !exists $self->{$_}, qw(LEFT_MARGIN RIGHT_MARGIN);
return $self;
}
sub find_margin_heights
{
my $self = shift;
my ($context) = @_;
my ($header_height, $footer_height) = (undef, undef);
my $sub;
$sub = sub {
my $obj = shift;
$obj->enter_scope($context) unless $obj->isa('PAGEDEF');
if ($obj->isa('HEADER'))
{
die "Cannot have two tags in the same ", $/ if defined $header_height;
$header_height = $context->get($obj, 'HEADER_HEIGHT');
}
elsif ($obj->isa('FOOTER'))
{
die "Cannot have two tags in the same ", $/ if defined $footer_height;
$footer_height = $context->get($obj, 'FOOTER_HEIGHT');
}
else
{
$sub->($_) for grep { $_->isa('CONTAINER') } @{$obj->{ELEMENTS}};
}
$obj->exit_scope($context, 1) unless $obj->isa('PAGEDEF');
};
$sub->($self);
$header_height ||= 0;
$footer_height ||= 0;
return ($header_height, $footer_height);
}
sub enter_scope
{
my $self = shift;
my ($context) = @_;
$self->SUPER::enter_scope( $context );
my ($pheight, $pwidth) = map { $context->get($self, $_) } qw(PAGE_HEIGHT PAGE_WIDTH);
unless (defined $pheight && defined $pwidth)
{
my $psize = $context->get($self, 'PAGESIZE');
$self->_validate_option('PAGESIZE', \$psize);
for my $attr (qw(PAGE_HEIGHT PAGE_WIDTH))
{
$self->{$attr} = $Verify{PAGESIZE}{$psize}{$attr};
}
($pheight, $pwidth) = @{$self}{qw(PAGE_HEIGHT PAGE_WIDTH)};
}
# swap dimensions if landscape
if ($context->get($self, 'LANDSCAPE'))
{
($pheight, $pwidth) = ($pwidth, $pheight);
@{$self}{qw(PAGE_HEIGHT PAGE_WIDTH)}
= @{$self}{qw(_ORIG_WIDTH _ORIG_HEIGHT)}
= @{$self}{qw(PAGE_WIDTH PAGE_HEIGHT)}
}
return 1;
}
sub exit_scope
{
my $self = shift;
my ($context) = @_;
@{$self}{qw(PAGE_HEIGHT PAGE_WIDTH)} = delete @{$self}{qw(_ORIG_HEIGHT _ORIG_WIDTH)}
if exists $self->{_ORIG_HEIGHT};
return $self->SUPER::exit_scope($context);
}
sub begin_page
{
my $self = shift;
my ($context) = @_;
$context->{X} = 0;
$context->{Y} = $context->get($self, 'START_Y');
$context->reset_pagebreak;
return $self->SUPER::begin_page($context);
}
sub render
{
my $self = shift;
my ($context) = @_;
my ($header_h, $footer_h) = $self->find_margin_heights($context);
my ($pheight, $pwidth) = map { $context->get($self, $_) } qw(PAGE_HEIGHT PAGE_WIDTH);
$self->{START_Y} = $pheight - $header_h;
$self->{END_Y} = $footer_h;
$context->new_page_def;
my $done = 0;
while (!$done)
{
$self->begin_page($context);
$context->{PDF}->begin_page($pwidth, $pheight);
$done = $self->iterate_over_children($context);
$context->{PDF}->end_page;
$self->end_page($context);
$context->increment_pagenumber unless $context->get($self, 'NOPAGENUMBER');
}
return $done;
}
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Container::PageDef
=head1 PURPOSE
To provide the page definition for a given page. Without a pagedef, nothing
renders
=head1 NODE NAME
PAGEDEF
=head1 INHERITANCE
PDF::FromHTML::Template::Container
=head1 ATTRIBUTES
=over 4
=item * MARGINS / LEFT_MARGIN / RIGHT_MARGIN - This determines any space kept
empty on the left and right margins. MARGINS is a shortcut for specifying both
the left and right margins to the same value.
=item * PAGE_HEIGHT / PAGE_WIDTH - the height and width of the paper you want
this pagedef to render to. If both are not specified, the value in PAGESIZE will
be used.
=item * PAGESIZE - This is the paper size you want this pagedef to render to.
Choices are: Letter, Legal, A0, A1, A2, A3, and A4. This attribute will only be
used if PAGE_HEIGHT and PAGE_WIDTH are not set.
=item * LANDSCAPE - The default orientation is portrait. If LANDSCAPE is set to
a true value, then PAGE_HEIGHT and PAGE_WIDTH will be swapped.
=item * NOPAGENUMBER - If this is set to a true value, then this pagedef will
not increment the __PAGE__ parameter. Useful for title pages and the like.
=back
=head1 CHILDREN
None
=head1 AFFECTS
None
=head1 DEPENDENCIES
None
=head1 USAGE
... Children will render to a Legal-sized paper in landscape orientation ...
=head1 NOTE
It is very possible, and often useful, to have more than one pagedef in a given
template. Also, the PAGEDEF does not have to be the direct child of the
PDFTEMPLATE node. It is sometimes useful to have something like:
... Children here ...
=head1 AUTHOR
Rob Kinyon (rkinyon@columbus.rr.com)
=head1 SEE ALSO
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/PaxHeader/Row.pm 000644 000765 000024 00000000036 13554101202 025570 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.241175761
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/Row.pm 000644 000765 000024 00000003016 13554101202 023620 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Container::Row;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Container);
use PDF::FromHTML::Template::Container;
}
sub enter_scope
{
my $self = shift;
my ($context) = @_;
$self->SUPER::enter_scope($context);
$context->{X} = $context->get($self, 'LEFT_MARGIN');
return 1;
}
sub deltas
{
my $self = shift;
my ($context) = @_;
return {
X => $context->get($self, 'X') * -1 + $context->get($self, 'LEFT_MARGIN'),
Y => -1 * $self->max_of($context, 'H'),
};
}
sub total_of
{
my $self = shift;
my ($context, $attr) = @_;
return $self->max_of($context, $attr) if $attr eq 'H';
return $self->SUPER::total_of($context, $attr);
}
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Container::Row
=head1 PURPOSE
To specify a row of text and provide typewriter-like carriage returns at the
end.
=head1 NODE NAME
ROW
=head1 INHERITANCE
PDF::FromHTML::Template::Container
=head1 ATTRIBUTES
=over 4
=item * H - the height the row will consume when it is done.
=item * LEFT_MARGIN - If specifed, the row will start rendering here. Otherwise,
it will default to the PAGEDEF's LEFT_MARGIN.
=back
=head1 CHILDREN
None
=head1 AFFECTS
TEXTBOX
=head1 DEPENDENCIES
None
=head1 USAGE
=head1 AUTHOR
Rob Kinyon (rkinyon@columbus.rr.com)
=head1 SEE ALSO
PAGEDEF, TEXTBOX
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/PaxHeader/Conditional.pm 000644 000765 000024 00000000035 13554101202 027263 x ustar 00audreyt staff 000000 000000 29 mtime=1571848834.24150634
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/Conditional.pm 000644 000765 000024 00000011504 13554101202 025315 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Container::Conditional;
#GGG Convert to be a special case of ?
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Container);
use PDF::FromHTML::Template::Container;
}
my %isOp = (
'=' => '==',
(map { $_ => $_ } ( '>', '<', '==', '!=', '>=', '<=' )),
(map { $_ => $_ } ( 'gt', 'lt', 'eq', 'ne', 'ge', 'le' )),
);
# This cannot be within a should_render() function because the conditional needs
# to return true even if the conditional is false. We are indicating that this
# branch has done everything it needs to do, not that this branch is calling for
# a pagebreak.
sub conditional_passes
{
my $self = shift;
my ($context) = @_;
my $name = $context->get($self, 'NAME');
return 0 unless $name =~ /\S/;
my $val = $context->param($name);
$val = @{$val} while UNIVERSAL::isa($val, 'ARRAY');
$val = ${$val} while UNIVERSAL::isa($val, 'SCALAR');
my $istrue = (defined $val && $val) ? 1 : 0;
my $value = $context->get($self, 'VALUE');
if (defined $value)
{
my $op = $context->get($self, 'OP');
$op = defined $op && exists $isOp{$op}
? $isOp{$op}
: '==';
my $res;
for ($op)
{
/^>$/ && do { $res = ($val > $value); last };
/^<$/ && do { $res = ($val < $value); last };
/^==$/ && do { $res = ($val == $value); last };
/^!=$/ && do { $res = ($val != $value); last };
/^>=$/ && do { $res = ($val >= $value); last };
/^<=$/ && do { $res = ($val <= $value); last };
/^gt$/ && do { $res = ($val gt $value); last };
/^lt$/ && do { $res = ($val lt $value); last };
/^eq$/ && do { $res = ($val eq $value); last };
/^ne$/ && do { $res = ($val ne $value); last };
/^ge$/ && do { $res = ($val ge $value); last };
/^le$/ && do { $res = ($val le $value); last };
die "Unknown operator '$op' in conditional resolve", $/;
}
return 1;
}
elsif (my $is = uc $context->get($self, 'IS'))
{
if ($is eq 'TRUE')
{
return $istrue;
}
else
{
warn "Conditional 'is' value was [$is], defaulting to 'FALSE'" . $/
if $is ne 'FALSE';
return !$istrue;
}
}
return $istrue;
}
sub render
{
my $self = shift;
my ($context) = @_;
return 0 unless $self->should_render($context);
return 1 unless $self->conditional_passes($context);
return $self->iterate_over_children($context);
}
sub max_of
{
my $self = shift;
my ($context, $attr) = @_;
return 0 unless $self->conditional_passes($context);
return $self->SUPER::max_of($context, $attr);
}
sub total_of
{
my $self = shift;
my ($context, $attr) = @_;
return 0 unless $self->conditional_passes($context);
return $self->SUPER::total_of($context, $attr);
}
sub _do_page
{
my $self = shift;
return unless $self->conditional_passes(@_);
return $self->SUPER::_do_page( @_ );
}
sub begin_page
{
_do_page(@_,'begin_page');
}
sub end_page
{
_do_page(@_,'end_page');
}
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Container::Conditional
=head1 PURPOSE
To conditionally allow children to render
=head1 NODE NAME
CONDITIONAL
IF (an alias for CONDITIONAL)
=head1 INHERITANCE
PDF::FromHTML::Template::Container
=head1 ATTRIBUTES
=over 4
=item * NAME - Required. This is a parameter name, whose value will determine
if the conditional passed or fails. If NAME is not specified, the conditional
will consider to always fail.
=item * OP - defaults to == (numeric equality). If VALUE is specified, this will
be how NAME and VALUE are compared. OP can be any of the 6 numeric comparision
operators or the 6 string comparision operators.
=item * VALUE - if this is specified, OP will be checked. This is a standard
attribute, so if you want a parameter, prepend it with '$'.
=item * IS - If there is no VALUE attribute, this will be checked. IS can be
either 'FALSE' or 'TRUE'. The boolean of NAME will be compared and the
conditional will branch appropriately. If NAME has no value, this will fail.
=item * NONE - If there is no IS and no VALUE, then an attempt will be made to
find the variable defined by NAME. If it exists and is true, the condition
will succeed. Otherwise, it will fail.
=back
=head1 CHILDREN
None
=head1 AFFECTS
Nothing
=head1 DEPENDENCIES
None
=head1 USAGE
... Children execute if the current page is not the last page ...
... Children execute if Param1 is string-wise equals to Param2 ...
=head1 AUTHOR
Rob Kinyon (rkinyon@columbus.rr.com)
=head1 SEE ALSO
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/PaxHeader/Scope.pm 000644 000765 000024 00000000036 13554101202 026072 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.241796012
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Container/Scope.pm 000644 000765 000024 00000002162 13554101202 024123 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Container::Scope;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Container);
use PDF::FromHTML::Template::Container;
}
# This is used as a placeholder for scoping values across any number
# of children. It does nothing on its own.
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Container::Scope
=head1 PURPOSE
To provide scoping for children.
=head1 NODE NAME
SCOPE
=head1 INHERITANCE
PDF::FromHTML::Template::Container
=head1 ATTRIBUTES
None
=head1 CHILDREN
None
=head1 AFFECTS
Nothing
=head1 DEPENDENCIES
None
=head1 USAGE
If you have a number of nodes that share common attribute values, but don't have
a common parent, provide them with a no-op parent that allows consolidation of
attribute specification.
In the above example, the two textbox nodes will inherit the W attribute from
the scope tag.
=head1 AUTHOR
Rob Kinyon (rkinyon@columbus.rr.com)
=head1 SEE ALSO
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Element/PaxHeader/Weblink.pm 000644 000765 000024 00000000036 13554101202 026063 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.232037309
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Element/Weblink.pm 000644 000765 000024 00000002511 13554101202 024112 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Element::Weblink;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Element);
use PDF::FromHTML::Template::Element;
}
sub render
{
my $self = shift;
my ($context) = @_;
return 0 unless $self->should_render($context);
return 1 if $context->{CALC_LAST_PAGE};
my $url = $context->get($self, 'URL');
unless (defined $url)
{
warn "Weblink: no URL defined!", $/;
return 1;
}
my @dimensions = map {
$context->get($self, $_) || 0
} qw( X1 Y1 X2 Y2 );
$context->{PDF}->add_weblink( @dimensions, $url );
return 1;
}
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Element::WebLink
=head1 PURPOSE
To provide a clickable web-link
=head1 NODE NAME
WEBLINK
=head1 INHERITANCE
PDF::FromHTML::Template::Element
=head1 ATTRIBUTES
=over 4
=item * URL
The URL to go to, when clicked
=item * X1 / X2 / Y1 / Y2
The dimensions of the clickable area
=back
=head1 CHILDREN
None
=head1 AFFECTS
Nothing
=head1 DEPENDENCIES
None
=head1 USAGE
This node is currently under review as to whether it should be removed and a
URL attribute should be added to various nodes, such as IMAGE, TEXTBOX, and ROW.
=head2 USE AT YOUR OWN RISK
=head1 AUTHOR
Rob Kinyon (rkinyon@columbus.rr.com)
=head1 SEE ALSO
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Element/PaxHeader/Line.pm 000644 000765 000024 00000000036 13554101202 025357 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.232509857
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Element/Line.pm 000644 000765 000024 00000006164 13554101202 023416 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Element::Line;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Element);
use PDF::FromHTML::Template::Element;
}
sub render
{
my $self = shift;
my ($context) = @_;
return 0 unless $self->should_render($context);
return 1 if $context->{CALC_LAST_PAGE};
my $p = $context->{PDF};
$p->save_state;
$self->set_color($context, 'COLOR', 'both');
my $vals = $self->make_vals($context);
my $width = $context->get($self, 'WIDTH') || 1;
$p->linewidth($width);
$p->move($vals->{X1}, $vals->{Y1});
$p->line($vals->{X2}, $vals->{Y2});
$p->stroke;
$p->restore_state;
return 1;
}
sub make_vals
{
my $self = shift;
my ($context) = @_;
my ($x1, $x2, $y1, $y2) = map { $context->get($self, $_) } qw(X1 X2 Y1 Y2);
my %vals;
unless (defined $x1 && defined $x2)
{
#GGG Is the use of W a potential bug here?
my ($pw, $left, $right, $w) = map {
$context->get($self, $_)
} qw( PAGE_WIDTH LEFT_MARGIN RIGHT_MARGIN W );
$w = $pw - $right - $left unless defined $w;
if (defined $x1)
{
$x2 = $x1 + $w;
$x2 = $right if $x2 > $right;
}
elsif (defined $x2)
{
$x1 = $x2 - $w;
$x1 = $left if $x1 < $left;
}
else
{
$x1 = $left;
$x2 = $x1 + $w;
}
}
@vals{qw(X1 X2)} = ($x1, $x2);
unless (defined $y1 && defined $y2)
{
if (defined $y1)
{
$y2 = $y1;
}
elsif (defined $y2)
{
$y1 = $y2;
}
else
{
$y1 = $y2 = $context->get($self, 'Y');
}
}
@vals{qw(Y1 Y2)} = ($y1, $y2);
$self->{VALS} = \%vals;
return \%vals;
}
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Element::Line
=head1 PURPOSE
To draw lines
=head1 NODE NAME
LINE
=head1 INHERITANCE
PDF::FromHTML::Template::Element
=head1 ATTRIBUTES
=over 4
=item * X1 / X2 / Y1 / Y2
The line is drawn from (X1,Y1) to (X2,Y2).
If neither X1 nor X2 are set, X1 is set to the lefthand margin and X2 is set
to X1 + W. If only one is set, the other is set to the first +/- W.
If either of the Y values is not set, it is set to the current Y value.
=item * W
This is the width of the line to be drawn. Used only in calculating X1/X2/Y1/Y2
and only if needed. (q.v. above) Defaults to the distance between the left and
right margins. (q.v. PAGEDEF for more information on these parameters.)
=item * WIDTH
This is the thickness of the line to be drawn. Defaults to 1 pixel.
=item * COLOR
This is the color to draw the line in. Defaults to black.
=back
=head1 CHILDREN
PDF::FromHTML::Template::Element::HorizontalRule
=head1 AFFECTS
Nothing
=head1 DEPENDENCIES
None
=head1 USAGE
This will draw a blue line 3 pixels thick from the spot 1" in from the left and
top to the spot 3" from the left and 2" from the top.
=head1 AUTHOR
Rob Kinyon (rkinyon@columbus.rr.com)
=head1 SEE ALSO
PAGEDEF, HR
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Element/PaxHeader/Circle.pm 000644 000765 000024 00000000036 13554101202 025671 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.233042204
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Element/Circle.pm 000644 000765 000024 00000004261 13554101202 023724 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Element::Circle;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Element);
use PDF::FromHTML::Template::Element;
}
sub new
{
my $class = shift;
my $self = $class->SUPER::new(@_);
# warn 'Warning: missing required attribute R' unless exists $self->{R};
return $self;
}
sub render
{
my $self = shift;
my ($context) = @_;
return 0 unless $self->should_render($context);
return 1 if $context->{CALC_LAST_PAGE};
my ($x, $y, $r) = map { $context->get($self, $_) } qw(X Y R);
return 1 unless defined $r;
my $p = $context->{PDF};
$p->save_state;
$self->set_color($context, 'COLOR', 'stroke');
my $fillcolor = $context->get($self, 'FILLCOLOR');
$self->set_color($context, 'FILLCOLOR', 'fill');
my $width = $context->get($self, 'WIDTH') || 1;
$p->linewidth($width);
$p->circle($x, $y, $r);
if (defined $fillcolor)
{
$p->fill_stroke;
}
else
{
$p->stroke;
}
$p->restore_state;
return 1;
}
sub deltas
{
my $self = shift;
my ($context) = @_;
# my ($x, $y, $r) = map { $context->get($self, $_) } qw(X Y R);
my ($x, $y) = map { $context->get($self, $_) } qw(X Y);
#GGG Have $r involved here?
return {
X => $x - $context->{X},
Y => $y - $context->{Y},
};
}
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Element::Circle
=head1 PURPOSE
To draw a circle.
=head1 NODE NAME
CIRCLE
=head1 INHERITANCE
PDF::FromHTML::Template::Element
=head1 ATTRIBUTES
=over 4
=item * R
This is the radius of the circle to be drawn
=item * COLOR
This is the color the circle should be drawn in. Defaults to black.
=item * FILLCOLOR
This is the color the circle should be filled in with. Defaults to none.
=item * WIDTH
This is the width of the line used to draw the circle. Defaults to 1 pixel.
=back
=head1 CHILDREN
None
=head1 AFFECTS
Nothing
=head1 DEPENDENCIES
None
=head1 USAGE
This will cause a 1-inch radius circle to be drawn at the current position in
red.
=head1 AUTHOR
Rob Kinyon (rkinyon@columbus.rr.com)
=head1 SEE ALSO
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Element/PaxHeader/HorizontalRule.pm 000644 000765 000024 00000000036 13554101202 027451 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.233490403
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Element/HorizontalRule.pm 000644 000765 000024 00000001624 13554101202 025504 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Element::HorizontalRule;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Element::Line);
use PDF::FromHTML::Template::Element::Line;
}
sub deltas
{
my $self = shift;
my ($context) = @_;
my $y_shift = $self->{Y2} - $self->{Y1};
$y_shift = -1 * ($context->get($self, 'H') || 0) unless $y_shift;
return {
Y => $y_shift,
};
}
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Element::HorizontalRule
=head1 PURPOSE
To create a horizontal rule across the page
=head1 NODE NAME
HR
=head1 INHERITANCE
PDF::FromHTML::Template::Element::Line
=head1 ATTRIBUTES
=head1 CHILDREN
None
=head1 AFFECTS
Nothing
=head1 DEPENDENCIES
None
=head1 USAGE
That will create a line across the page at the current Y-position.
=head1 AUTHOR
Rob Kinyon (rkinyon@columbus.rr.com)
=head1 SEE ALSO
LINE
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Element/PaxHeader/TextBox.pm 000644 000765 000024 00000000034 13554101202 026063 x ustar 00audreyt staff 000000 000000 28 mtime=1571848834.2340503
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Element/TextBox.pm 000644 000765 000024 00000023521 13554101202 024120 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Element::TextBox;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Element);
use PDF::FromHTML::Template::Element;
use Encode;
}
sub new
{
my $class = shift;
my $self = $class->SUPER::new(@_);
$self->{TXTOBJ} = PDF::FromHTML::Template::Factory->create('TEXTOBJECT');
return $self;
}
sub get_text
{
my $self = shift;
my ($context) = @_;
my $txt = $context->get($self, 'TEXT');
if (defined $txt)
{
my $txt_obj = PDF::FromHTML::Template::Factory->create('TEXTOBJECT');
push @{$txt_obj->{STACK}}, $txt;
$txt = $txt_obj->resolve($context);
}
elsif ($self->{TXTOBJ})
{
$txt = $self->{TXTOBJ}->resolve($context)
}
else
{
# $txt = Unicode::String::utf8('');
$txt = '';
}
return $txt;
}
sub render
{
my $self = shift;
my ($context) = @_;
delete $self->{TEMP_H} if exists $self->{TEMP_H};
return 0 unless $self->should_render($context);
if ($context->{CALC_LAST_PAGE})
{
$self->{TEMP_H} = $self->calculate($context, 'H');
return 1;
}
my $x = $context->get($self, 'X');
my $y = $context->get($self, 'Y');
my $w = $context->get($self, 'W');
my $h = $context->get($self, 'H');
my $align = $context->get($self, 'ALIGN') ||
$context->get($self, 'JUSTIFY');
$self->_validate_option('ALIGN', \$align);
$self->set_color($context, 'COLOR', 'both');
my ($orig_x, $orig_w) = ($x, $w);
if (defined(my $lmargin = $context->get($self, 'LMARGIN')))
{
$x += $lmargin;
$w -= $lmargin;
}
if (defined(my $rmargin = $context->get($self, 'RMARGIN')))
{
$w -= $rmargin;
}
my $txt = $self->get_text($context);
$self->{TEMP_H} = $self->show_boxed(
$context, $txt,
$x, $y, $w, $h,
$align, '',
);
my $max_h = $context->{STACK}[-2]{MAX_H} || $self->{TEMP_H};
if ($context->get($self, 'BGCOLOR'))
{
$context->{PDF}->save_state;
$self->set_color($context, 'BGCOLOR', 'fill');
$context->{PDF}->rect($orig_x, $y - $max_h + $h, $orig_w, $max_h);
$context->{PDF}->fill;
$context->{PDF}->restore_state;
}
if (my $border = $context->get($self, 'BORDER'))
{
$context->{PDF}->rect($orig_x, $y - $max_h + $h, $orig_w, $max_h, $border);
$context->{PDF}->stroke;
}
$self->set_color($context, 'COLOR', 'both', 1);
return 1;
}
sub deltas
{
my $self = shift;
my ($context) = @_;
return {
X => $context->get($self, 'W'),
Y => 0,
};
}
sub _display_doublebyte
{
my $self = shift;
my ($p, $str, $x, $y, $j, $font_size) = @_;
my $halfwidth_len = ($str =~ tr/\x00-\xff//);
my $len = (length($str) * 2) - $halfwidth_len;
if ($j eq 'right')
{
$x -= $len * $font_size / 2;
}
elsif ($j eq 'center')
{
$x -= ($len / 4) * $font_size;
}
$p->show_xy($str, $x, $y);
return 0;
}
sub _show_boxed
{
my $self = shift;
my $context = shift;
my $encoding = $context->get($self, 'PDF_ENCODING') || 'host';
if (my $text_encoding = $context->get($self, 'TEXT_ENCODING'))
{
require Encode::compat if $] <= 5.008;
require Encode;
unshift @_, Encode::decode($text_encoding => shift(@_))
unless Encode::is_utf8($_[0]);
}
# On non-DBCS, use PDF::Writer's builtin show_boxed.
if ($_[0] !~ /[^\x00-\xff]/) {
my $str = shift;
my $leftovers = $context->{PDF}->show_boxed($str, @_);
$leftovers++ if $leftovers && $leftovers == length($str) - 1;
return $leftovers;
}
my ($p, $str, $x, $y, $w, $h, $j, $m) = ($context->{PDF}, @_);
my $font_size = $p->font_size;
die "Fontsize of 0!", $/ if $font_size <= 0;
if ($w == 0 && $h == 0)
{
return 0 if $m eq 'blind';
return $self->_display_doublebyte($p, $str, $x, $y, $j, $font_size);
}
my $num_lines = int($h / $font_size);
# This is half-width measure
my $chars_per_line = int($w / $font_size * 2);
my $right = $x + $w;
my $mid = int(($x + $right) / 2);
my $current_y = $y + $h - $font_size;
foreach my $line_num (0 .. $num_lines - 1)
{
my $start_x = $x;
$start_x = $right if $j eq 'right';
$start_x = $mid if $j eq 'center';
# if ($str->length <= $chars_per_line)
if (len($str) <= $chars_per_line)
{
return 0 if $m eq 'blind';
return $self->_display_doublebyte($p, $str, $start_x, $current_y, $j, $font_size);
}
# my $str_this_line = $str->substr(0, $chars_per_line);
my $str_this_line;
while (len($str_this_line) <= $chars_per_line) {
$str_this_line .= substr($str, 0, 1, '');
}
$self->_display_doublebyte($p, $str_this_line, $start_x, $current_y, $j, $font_size)
unless $m eq 'blind';
$current_y -= $font_size;
# $str = $str->substr($chars_per_line);
}
# return $str->length;
return length($str);
}
sub len {
my $str = shift;
my $halfwidth_len = ($str =~ tr/\x00-\xff//);
return ((length($str) * 2) - $halfwidth_len);
}
sub show_boxed
{
my $self = shift;
my ($context, $str, $x, $y, $w, $h, $align, $mode) = @_;
my $fsize = $context->{PDF}->font_size;
$fsize = 0 if $fsize < 0;
# return $h unless $str->length && ($fsize && $h / $fsize >= 1);
return $h unless length($str) && ($fsize && $h / $fsize >= 1);
my $total_h = $h;
# my $excess_txt = Unicode::String::utf8('');
my $excess_txt = '';
LOOP:
{
my $leftovers = $self->_show_boxed(
$context, $str,
$x, $y, $w, $h,
$align, $mode,
);
die "Invalid return ($leftovers) from _show_boxed() on string '$str'", $/
if $leftovers > length($str);
last LOOP if $context->get($self, 'TRUNCATE_TEXT');
if ($leftovers < length($str))
{
last LOOP unless $excess_txt || $leftovers;
$str = ($leftovers ? substr($str, -1 * $leftovers) : '' ) . $excess_txt;
$excess_txt = '';
$str =~ s/^[\r\n\s]+//go;
$y -= $h;
$total_h += $h;
redo LOOP;
}
last LOOP unless $leftovers;
$total_h += $h;
$excess_txt = chop($str) . $excess_txt;
$excess_txt = chop($str) . $excess_txt
while $str =~ /[\r\n\s]$/o;
redo LOOP;
}
if ($mode eq 'blind') {
return $total_h if @{$context->{STACK}} < 2;
my $prev_max = $context->{STACK}[-2]{MAX_H};
$context->{STACK}[-2]{MAX_H} = $total_h if $prev_max < $total_h;
}
return $total_h;
}
sub calculate
{
my $self = shift;
my ($context, $attr) = @_;
return $self->SUPER::calculate($context, $attr) unless $attr eq 'H';
return delete $self->{TEMP_H} if exists $self->{TEMP_H};
my $txt = $self->get_text($context);
my $x = $context->get($self, 'X');
my $y = $context->get($self, 'Y');
my $w = $context->get($self, 'W');
my $h = $context->get($self, 'H');
if (defined(my $lmargin = $context->get($self, 'LMARGIN')))
{
$x += $lmargin;
$w -= $lmargin;
}
if (defined(my $rmargin = $context->get($self, 'RMARGIN')))
{
$w -= $rmargin;
}
return $self->show_boxed(
$context, $txt,
$x, $y, $w, $h,
'left', 'blind',
);
}
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Element::TextBox
=head1 PURPOSE
To write text in a specified spot
=head1 NODE NAME
TEXTBOX
=head1 INHERITANCE
PDF::FromHTML::Template::Element
=head1 ATTRIBUTES
=over 4
=item * TEXT
This is the text for this textbox. Can be either as a parameter or as character
children of this node. Defaults to '' (the empty string).
=item * ALIGN / JUSTIFY
This is the orientation of the text in the textbox. Legal values are:
=over 4
=item * Left (default)
=item * Center
=item * Right
=item * Full (NOT IMPLEMENTED)
=back
JUSTIFY is provided for backwards compatibility, and is deprecated.
=item * COLOR
This is the color of the text
=item * BGCOLOR
This is the color of background
=item * BORDER
This is a boolean specifying if a border should be drawn. Currently, the border
is drawn in the same color as the text.
=item * LMARGIN / RMARGIN
These are the paddings within the textbox for the text. This is useful if you
are listing columns of numbers and don't want them to run into one another.
=item * H
Normally, one would not set H, as it should be set by either the FONT or ROW
ancestor. However, it can be useful to do the following:
Some text here
That will create textbox which will occupy four rows of text at whatever size
the font is set to.
=item * TRUNCATE_TEXT
Normally, at textbox will use as many rows it needs to write the text given to
it. (It will always respect its width requirement, even to the point of
splitting words, though it tries hard to preserve words.) However, sometimes
this behavior is undesirable.
Set this to a true value and the height value will be a requirement, not an
option.
=back
=head1 CHILDREN
None
=head1 AFFECTS
Nothing
=head1 DEPENDENCIES
ROW
=head1 USAGE
and stuff
This will put two textboxes on the page at the current Y-position. The first
will occupy 40% of the write-able space and contain the text "Some text here".
The second will occupy the rest and contain the text from Param1, then the text
" and stuff". (This is the only way to mix parameters and static text in the
same textbox.)
=head1 AUTHOR
Rob Kinyon (rkinyon@columbus.rr.com)
=head1 SEE ALSO
ROW
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Element/PaxHeader/Bookmark.pm 000644 000765 000024 00000000036 13554101202 026235 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.234435995
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Element/Bookmark.pm 000644 000765 000024 00000002505 13554101202 024267 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Element::Bookmark;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Element);
use PDF::FromHTML::Template::Element;
}
sub new
{
my $class = shift;
my $self = $class->SUPER::new(@_);
$self->{TXTOBJ} = PDF::FromHTML::Template::Factory->create('TEXTOBJECT');
return $self;
}
sub render
{
my $self = shift;
my ($context) = @_;
return 0 unless $self->should_render($context);
return 1 if $context->{CALC_LAST_PAGE};
my $txt = $self->{TXTOBJ}->resolve($context);
unless (defined $txt)
{
warn "Bookmark: no text defined!", $/;
$txt = 'undefined';
}
$context->{PDF}->add_bookmark($txt, 0, 0);
return 1;
}
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Element::Bookmark
=head1 PURPOSE
Creates a bookmark in the resultant PDF.
=head1 NODE NAME
BOOKMARK
=head1 INHERITANCE
PDF::FromHTML::Template::Element
=head1 ATTRIBUTES
None
=head1 CHILDREN
Text and <VAR> nodes. The text contained will be the location of the
bookmark.
=head1 AFFECTS
Resultant PDF
=head1 DEPENDENCIES
None
=head1 USAGE
That now adds a bookmark for that spot to the PDF, called "Some Bookmark".
=head1 AUTHOR
Rob Kinyon (rkinyon@columbus.rr.com)
=head1 SEE ALSO
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Element/PaxHeader/Var.pm 000644 000765 000024 00000000036 13554101202 025220 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.234835376
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Element/Var.pm 000644 000765 000024 00000002224 13554101202 023250 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Element::Var;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Element);
use PDF::FromHTML::Template::Element;
}
sub resolve { ($_[1])->param($_[0]{NAME}) }
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Element::Var
=head1 PURPOSE
To provide variable support
=head1 NODE NAME
VAR
=head1 INHERITANCE
PDF::FromHTML::Template::Element
=head1 ATTRIBUTES
=over 4
=item * NAME
This is the name of the parameter to substitute
=back
=head1 CHILDREN
None
=head1 AFFECTS
Nothing
=head1 DEPENDENCIES
None
=head1 USAGE
=head1 NOTE
In most cases, the use of VAR is unnecessary as the nodes all have the ability
to use the $-notation for variablized attributes. For example, the filename for
IMAGE or the text for TEXTBOX can be specified by the appropriate attribute.
However, the node is not provided solely for backwards compatibility. There are
some situations where the attribute $-notation is inadequate and a VAR node is
required. (q.v. TEXTBOX for an example)
=head1 AUTHOR
Rob Kinyon (rkinyon@columbus.rr.com)
=head1 SEE ALSO
TEXTBOX, IMAGE
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Element/PaxHeader/PageBreak.pm 000644 000765 000024 00000000036 13554101202 026311 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.235443395
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Element/PageBreak.pm 000644 000765 000024 00000002453 13554101202 024345 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Element::PageBreak;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Element);
use PDF::FromHTML::Template::Element;
}
sub new
{
my $class = shift;
my $self = $class->SUPER::new(@_);
$self->trip(0);
return $self;
}
sub reset
{
my $self = shift;
$self->trip(0);
return $self->SUPER::reset;
}
sub trip { $_[0]{__TRIP_WIRE__} = $_[1] if defined $_[1]; $_[0]{__TRIP_WIRE__} }
sub render
{
my $self = shift;
my ($context) = @_;
return 0 unless $self->should_render($context);
return 1 if $self->trip;
# Regardless of whether a pagebreak actually occurs, this node
# has done its job.
$self->trip(1);
if ($context->get($self, 'Y') != $context->get($self, 'START_Y'))
{
$context->trip_pagebreak;
}
return 0;
}
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Element::PageBreak
=head1 PURPOSE
To insert a hard pagebreak.
=head1 NODE NAME
PAGEBREAK
=head1 INHERITANCE
PDF::FromHTML::Template::Element
=head1 ATTRIBUTES
None
=head1 CHILDREN
None
=head1 AFFECTS
Nothing
=head1 DEPENDENCIES
None
=head1 USAGE
This will cause a pagebreak to occur at the spot the node is.
=head1 AUTHOR
Rob Kinyon (rkinyon@columbus.rr.com)
=head1 SEE ALSO
=cut
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Element/PaxHeader/Image.pm 000644 000765 000024 00000000036 13554101202 025512 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.235826673
PDF-FromHTML-0.33/lib/PDF/FromHTML/Template/Element/Image.pm 000644 000765 000024 00000012726 13554101202 023552 0 ustar 00audreyt staff 000000 000000 package PDF::FromHTML::Template::Element::Image;
use strict;
BEGIN {
use vars qw(@ISA);
@ISA = qw(PDF::FromHTML::Template::Element);
use PDF::FromHTML::Template::Element;
}
sub new
{
my $class = shift;
my $self = $class->SUPER::new(@_);
$self->{TXTOBJ} = PDF::FromHTML::Template::Factory->create('TEXTOBJECT');
return $self;
}
sub _deltas {
my $self = shift;
my ($context) = @_;
return {
X => $context->get($self, 'W'),
Y => $context->get($self, 'H'),
};
}
my %convertImageType = (
'jpg' => 'jpeg',
);
sub begin_page
{
my $self = shift;
my ($context) = @_;
return 1 if $context->{CALC_LAST_PAGE};
my $txt = $context->get($self, 'FILENAME') ||
$self->{TXTOBJ}->resolve($context) ||
die "Image does not have a filename", $/;
my $image = $context->retrieve_image($txt);
my $p = $context->{PDF};
unless ($image)
{
# automatically resolve type if extension is obvious and type was not specified
my $type = $context->get($self, 'TYPE');
unless ($type)
{
($type) = $txt =~ /\.(\w+)$/o;
}
unless ($type)
{
die "Undefined type for '$txt'", $/;
}
$type = lc $type;
$type = $convertImageType{$type} if exists $convertImageType{$type};
$image = $p->open_image($type, $txt, '', 0);
$image == -1 and die "Cannot open file '$txt'", $/;
$context->store_image($txt, $image);
}
$self->{IMAGE_HEIGHT} = $p->image_height($image);
$self->{IMAGE_WIDTH} = $p->image_width($image);
die "Image '$txt' has 0 (or less) height.", $/ if $self->{IMAGE_HEIGHT} <= 0;
die "Image '$txt' has 0 (or less) width.", $/ if $self->{IMAGE_WIDTH} <= 0;
return 1;
}
sub render
{
my $self = shift;
my ($context) = @_;
return 0 unless $self->should_render($context);
return 1 if $context->{CALC_LAST_PAGE};
my $txt = $context->get($self, 'FILENAME') ||
$self->{TXTOBJ}->resolve($context) ||
die "Image does not have a filename", $/;
my $image = $context->retrieve_image($txt);
$image == -1 && die "Image not found for '$txt' when is rendered.", $/;
$self->set_values($context, $txt);
my $p = $context->{PDF};
my ($x, $y, $scale) = map { $context->get($self, $_) } qw(X Y SCALE);
$p->place_image( $image, $x, $y - $self->{H}, $scale );
if ($context->get($self, 'BORDER'))
{
$p->save_state;
$self->set_color($context, 'COLOR', 'both');
my ($w, $h) = map { $context->get($self, $_) } qw(W H);
$p->rect($x, $y, $w, $h);
$p->stroke;
$p->restore_state;
}
return 1;
}
sub set_values
{
my $self = shift;
my ($context, $txt) = @_;
my $scale = $context->get($self, 'SCALE');
if (defined $scale)
{
die "Scale is zero or less when rendering '$txt'.", $/ if $scale <= 0;
$self->{W} = $self->{IMAGE_WIDTH} * $scale;
$self->{H} = $self->{IMAGE_HEIGHT} * $scale;
}
else
{
my ($w, $h) = map { $context->get($self, $_) } qw(W H);
if (defined $w && defined $h)
{
die "Height of zero or less in '$txt'.", $/ if $h <= 0;
die "Width of zero or less in '$txt'.", $/ if $w <= 0;
my $test_scale = $w / $h;
if ($test_scale == ($self->{IMAGE_WIDTH}/$self->{IMAGE_HEIGHT}))
{
$self->{SCALE} = $test_scale;
}
else
{
undef $h;
}
}
if (defined $w)
{
$self->{SCALE} = $w / $self->{IMAGE_WIDTH};
$self->{H} = $self->{IMAGE_HEIGHT} * $self->{SCALE};
}
elsif (defined $h)
{
$self->{SCALE} = $h / $self->{IMAGE_HEIGHT};
$self->{W} = $self->{IMAGE_WIDTH} * $self->{SCALE};
}
else
{
$self->{SCALE} = 0.5;
$self->{W} = $self->{IMAGE_WIDTH} * $self->{SCALE};
$self->{H} = $self->{IMAGE_HEIGHT} * $self->{SCALE};
}
}
return 1;
}
1;
__END__
=head1 NAME
PDF::FromHTML::Template::Element::Image
=head1 PURPOSE
To embed images
=head1 NODE NAME
IMAGE
=head1 INHERITANCE
PDF::FromHTML::Template::Element
=head1 ATTRIBUTES
=over 4
=item * FILENAME
This is the filename for the image.
=item * TYPE
If the image type is not specified in the filename, specify it here.
=item * SCALE / W / H
This is used to scale the image. SCALE is a value by which the image's height
and width will be multiplied to arrive at the final height and width. Or, you
can set W and or H, as the width (or height) you want the image to have, once
scaled.
The algorithm used to calculate scaling has changed, somewhat, from v0.05. It
should result in better calculations, as it tries more avenues. Ultimately, if
it cannot figure out what to do, it will set a SCALE of 0.5 and go from there.
=item * BORDER
This is a boolean, used to specify if you want to draw a border around the image
=item * COLOR
Ignored unless BORDER is specified. This is the color of the border.
=back
=head1 CHILDREN
None
=head1 AFFECTS
Nothing
=head1 DEPENDENCIES
None
=head1 USAGE
In both cases, the image specified by the parameter "Image1" will be placed at
the current X/Y position.
=head1 AUTHOR
Rob Kinyon (rkinyon@columbus.rr.com)
=head1 SEE ALSO
=cut
PDF-FromHTML-0.33/script/PaxHeader/html2pdf.pl 000644 000765 000024 00000000036 13554101202 021600 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.244598412
PDF-FromHTML-0.33/script/html2pdf.pl 000644 000765 000024 00000005553 13554101202 017640 0 ustar 00audreyt staff 000000 000000 #!/usr/local/bin/perl
use strict;
use warnings;
use Getopt::Long;
use PDF::FromHTML;
=head1 NAME
html2pdf.pl - Convert HTML to PDF
=head1 SYNOPSIS
B S<[ B<-l> ]> S<[ B<-e> I ] [ B<-f> I ] [ B<-s> I ]>
S [ I ]>
If I is not given, reads HTML from standard input.
If I is not given, writes PDF to the same name as the input file
with an additional F<.pdf> suffix, or to standard output if it's being
redirected to somewhere other than a terminal.
If I is not given, the input encoding defaults to C.
If I is not given, the base font family defaults to C.
The value of I can be a truetype font file, one of the PDF core fonts,
or one of: C/C/C/C.
If I is not given, the base font size defaults to C<12> points.
If B<-l> is specified, the output uses landscape layout.
=cut
my $font = 'Helvetica';
my $encoding = 'utf-8';
my $size = 12;
my $landscape = 0;
GetOptions(
"e|encoding=s" => \$encoding,
"f|font=s" => \$font,
"s|size=s" => \$size,
"l|landscape" => \$landscape,
);
my $pdf = PDF::FromHTML->new(
encoding => $encoding,
);
local $SIG{__DIE__} = sub { require Carp; Carp::confess(@_) };
my $input_file = @ARGV ? shift : '-';
my $output_file = @ARGV ? shift : (-t STDOUT and $input_file ne '-') ? "$input_file.pdf" : '-';
$pdf->load_file($input_file);
$pdf->convert(
Font => $font,
LineHeight => $size,
Landscape => $landscape,
);
#warn $pdf->twig->sprint;
$pdf->write_file($output_file);
1;
__END__
=head1 AUTHORS
Audrey Tang Ecpan@audreyt.orgE
=head1 COPYRIGHT
Copyright 2004-2008 by Audrey Tang Ecpan@audreyt.orgE.
This software is released under the MIT license cited below.
=head2 The "MIT" License
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
DEALINGS IN THE SOFTWARE.
=cut
PDF-FromHTML-0.33/t/PaxHeader/1-basic.t 000644 000765 000024 00000000036 13554101202 020066 x ustar 00audreyt staff 000000 000000 30 mtime=1571848834.245111024
PDF-FromHTML-0.33/t/1-basic.t 000644 000765 000024 00000000323 13554101202 016114 0 ustar 00audreyt staff 000000 000000 #!/usr/bin/perl
use strict;
print "1..2\n";
require PDF::FromHTML;
print "ok 1 # loading the module\n";
my $pdf = PDF::FromHTML->new;
$pdf->can('load_file') or print "not ";
print "ok 2 # basic API sanity\n";
PDF-FromHTML-0.33/inc/Module/ 000755 000765 000024 00000000000 13554103473 016261 5 ustar 00audreyt staff 000000 000000 PDF-FromHTML-0.33/inc/Module/Install/ 000755 000765 000024 00000000000 13554103473 017667 5 ustar 00audreyt staff 000000 000000 PDF-FromHTML-0.33/inc/Module/AutoInstall.pm 000644 000765 000024 00000062311 13554103471 021057 0 ustar 00audreyt staff 000000 000000 #line 1
package Module::AutoInstall;
use strict;
use Cwd ();
use File::Spec ();
use ExtUtils::MakeMaker ();
use vars qw{$VERSION};
BEGIN {
$VERSION = '1.19';
}
# special map on pre-defined feature sets
my %FeatureMap = (
'' => 'Core Features', # XXX: deprecated
'-core' => 'Core Features',
);
# various lexical flags
my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $InstallDepsTarget, $HasCPANPLUS );
my (
$Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps,
$UpgradeDeps
);
my ( $PostambleActions, $PostambleActionsNoTest, $PostambleActionsUpgradeDeps,
$PostambleActionsUpgradeDepsNoTest, $PostambleActionsListDeps,
$PostambleActionsListAllDeps, $PostambleUsed, $NoTest);
# See if it's a testing or non-interactive session
_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN );
_init();
sub _accept_default {
$AcceptDefault = shift;
}
sub _installdeps_target {
$InstallDepsTarget = shift;
}
sub missing_modules {
return @Missing;
}
sub do_install {
__PACKAGE__->install(
[
$Config
? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
: ()
],
@Missing,
);
}
# initialize various flags, and/or perform install
sub _init {
foreach my $arg (
@ARGV,
split(
/[\s\t]+/,
$ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || ''
)
)
{
if ( $arg =~ /^--config=(.*)$/ ) {
$Config = [ split( ',', $1 ) ];
}
elsif ( $arg =~ /^--installdeps=(.*)$/ ) {
__PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
exit 0;
}
elsif ( $arg =~ /^--upgradedeps=(.*)$/ ) {
$UpgradeDeps = 1;
__PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
exit 0;
}
elsif ( $arg =~ /^--default(?:deps)?$/ ) {
$AcceptDefault = 1;
}
elsif ( $arg =~ /^--check(?:deps)?$/ ) {
$CheckOnly = 1;
}
elsif ( $arg =~ /^--skip(?:deps)?$/ ) {
$SkipInstall = 1;
}
elsif ( $arg =~ /^--test(?:only)?$/ ) {
$TestOnly = 1;
}
elsif ( $arg =~ /^--all(?:deps)?$/ ) {
$AllDeps = 1;
}
}
}
# overrides MakeMaker's prompt() to automatically accept the default choice
sub _prompt {
goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault;
my ( $prompt, $default ) = @_;
my $y = ( $default =~ /^[Yy]/ );
print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] ';
print "$default\n";
return $default;
}
# the workhorse
sub import {
my $class = shift;
my @args = @_ or return;
my $core_all;
print "*** $class version " . $class->VERSION . "\n";
print "*** Checking for Perl dependencies...\n";
my $cwd = Cwd::getcwd();
$Config = [];
my $maxlen = length(
(
sort { length($b) <=> length($a) }
grep { /^[^\-]/ }
map {
ref($_)
? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
: ''
}
map { +{@args}->{$_} }
grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
)[0]
);
# We want to know if we're under CPAN early to avoid prompting, but
# if we aren't going to try and install anything anyway then skip the
# check entirely since we don't want to have to load (and configure)
# an old CPAN just for a cosmetic message
$UnderCPAN = _check_lock(1) unless $SkipInstall || $InstallDepsTarget;
while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
my ( @required, @tests, @skiptests );
my $default = 1;
my $conflict = 0;
if ( $feature =~ m/^-(\w+)$/ ) {
my $option = lc($1);
# check for a newer version of myself
_update_to( $modules, @_ ) and return if $option eq 'version';
# sets CPAN configuration options
$Config = $modules if $option eq 'config';
# promote every features to core status
$core_all = ( $modules =~ /^all$/i ) and next
if $option eq 'core';
next unless $option eq 'core';
}
print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n";
$modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );
unshift @$modules, -default => &{ shift(@$modules) }
if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward compatibility
while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
if ( $mod =~ m/^-(\w+)$/ ) {
my $option = lc($1);
$default = $arg if ( $option eq 'default' );
$conflict = $arg if ( $option eq 'conflict' );
@tests = @{$arg} if ( $option eq 'tests' );
@skiptests = @{$arg} if ( $option eq 'skiptests' );
next;
}
printf( "- %-${maxlen}s ...", $mod );
if ( $arg and $arg =~ /^\D/ ) {
unshift @$modules, $arg;
$arg = 0;
}
# XXX: check for conflicts and uninstalls(!) them.
my $cur = _version_of($mod);
if (_version_cmp ($cur, $arg) >= 0)
{
print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
push @Existing, $mod => $arg;
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
else {
if (not defined $cur) # indeed missing
{
print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
}
else
{
# no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above
print "too old. ($cur < $arg)\n";
}
push @required, $mod => $arg;
}
}
next unless @required;
my $mandatory = ( $feature eq '-core' or $core_all );
if (
!$SkipInstall
and (
$CheckOnly
or ($mandatory and $UnderCPAN)
or $AllDeps
or $InstallDepsTarget
or _prompt(
qq{==> Auto-install the }
. ( @required / 2 )
. ( $mandatory ? ' mandatory' : ' optional' )
. qq{ module(s) from CPAN?},
$default ? 'y' : 'n',
) =~ /^[Yy]/
)
)
{
push( @Missing, @required );
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
elsif ( !$SkipInstall
and $default
and $mandatory
and
_prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
=~ /^[Nn]/ )
{
push( @Missing, @required );
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
else {
$DisabledTests{$_} = 1 for map { glob($_) } @tests;
}
}
if ( @Missing and not( $CheckOnly or $UnderCPAN) ) {
require Config;
my $make = $Config::Config{make};
if ($InstallDepsTarget) {
print
"*** To install dependencies type '$make installdeps' or '$make installdeps_notest'.\n";
}
else {
print
"*** Dependencies will be installed the next time you type '$make'.\n";
}
# make an educated guess of whether we'll need root permission.
print " (You may need to do that as the 'root' user.)\n"
if eval '$>';
}
print "*** $class configuration finished.\n";
chdir $cwd;
# import to main::
no strict 'refs';
*{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
return (@Existing, @Missing);
}
sub _running_under {
my $thing = shift;
print <<"END_MESSAGE";
*** Since we're running under ${thing}, I'll just let it take care
of the dependency's installation later.
END_MESSAGE
return 1;
}
# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
# if we are, then we simply let it taking care of our dependencies
sub _check_lock {
return unless @Missing or @_;
if ($ENV{PERL5_CPANM_IS_RUNNING}) {
return _running_under('cpanminus');
}
my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};
if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS');
}
require CPAN;
if ($CPAN::VERSION > '1.89') {
if ($cpan_env) {
return _running_under('CPAN');
}
return; # CPAN.pm new enough, don't need to check further
}
# last ditch attempt, this -will- configure CPAN, very sorry
_load_cpan(1); # force initialize even though it's already loaded
# Find the CPAN lock-file
my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" );
return unless -f $lock;
# Check the lock
local *LOCK;
return unless open(LOCK, $lock);
if (
( $^O eq 'MSWin32' ? _under_cpan() : == getppid() )
and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore'
) {
print <<'END_MESSAGE';
*** Since we're running under CPAN, I'll just let it take care
of the dependency's installation later.
END_MESSAGE
return 1;
}
close LOCK;
return;
}
sub install {
my $class = shift;
my $i; # used below to strip leading '-' from config keys
my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
my ( @modules, @installed, @modules_to_upgrade );
while (my ($pkg, $ver) = splice(@_, 0, 2)) {
# grep out those already installed
if (_version_cmp(_version_of($pkg), $ver) >= 0) {
push @installed, $pkg;
if ($UpgradeDeps) {
push @modules_to_upgrade, $pkg, $ver;
}
}
else {
push @modules, $pkg, $ver;
}
}
if ($UpgradeDeps) {
push @modules, @modules_to_upgrade;
@installed = ();
@modules_to_upgrade = ();
}
return @installed unless @modules; # nothing to do
return @installed if _check_lock(); # defer to the CPAN shell
print "*** Installing dependencies...\n";
return unless _connected_to('cpan.org');
my %args = @config;
my %failed;
local *FAILED;
if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) {
while () { chomp; $failed{$_}++ }
close FAILED;
my @newmod;
while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) {
push @newmod, ( $k => $v ) unless $failed{$k};
}
@modules = @newmod;
}
if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) {
_install_cpanplus( \@modules, \@config );
} else {
_install_cpan( \@modules, \@config );
}
print "*** $class installation finished.\n";
# see if we have successfully installed them
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) {
push @installed, $pkg;
}
elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
print FAILED "$pkg\n";
}
}
close FAILED if $args{do_once};
return @installed;
}
sub _install_cpanplus {
my @modules = @{ +shift };
my @config = _cpanplus_config( @{ +shift } );
my $installed = 0;
require CPANPLUS::Backend;
my $cp = CPANPLUS::Backend->new;
my $conf = $cp->configure_object;
return unless $conf->can('conf') # 0.05x+ with "sudo" support
or _can_write($conf->_get_build('base')); # 0.04x
# if we're root, set UNINST=1 to avoid trouble unless user asked for it.
my $makeflags = $conf->get_conf('makeflags') || '';
if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) {
# 0.03+ uses a hashref here
$makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST};
} else {
# 0.02 and below uses a scalar
$makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
}
$conf->set_conf( makeflags => $makeflags );
$conf->set_conf( prereqs => 1 );
while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) {
$conf->set_conf( $key, $val );
}
my $modtree = $cp->module_tree;
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
print "*** Installing $pkg...\n";
MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
my $success;
my $obj = $modtree->{$pkg};
if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) {
my $pathname = $pkg;
$pathname =~ s/::/\\W/;
foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
delete $INC{$inc};
}
my $rv = $cp->install( modules => [ $obj->{module} ] );
if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) {
print "*** $pkg successfully installed.\n";
$success = 1;
} else {
print "*** $pkg installation cancelled.\n";
$success = 0;
}
$installed += $success;
} else {
print << ".";
*** Could not find a version $ver or above for $pkg; skipping.
.
}
MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
}
return $installed;
}
sub _cpanplus_config {
my @config = ();
while ( @_ ) {
my ($key, $value) = (shift(), shift());
if ( $key eq 'prerequisites_policy' ) {
if ( $value eq 'follow' ) {
$value = CPANPLUS::Internals::Constants::PREREQ_INSTALL();
} elsif ( $value eq 'ask' ) {
$value = CPANPLUS::Internals::Constants::PREREQ_ASK();
} elsif ( $value eq 'ignore' ) {
$value = CPANPLUS::Internals::Constants::PREREQ_IGNORE();
} else {
die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n";
}
push @config, 'prereqs', $value;
} elsif ( $key eq 'force' ) {
push @config, $key, $value;
} elsif ( $key eq 'notest' ) {
push @config, 'skiptest', $value;
} else {
die "*** Cannot convert option $key to CPANPLUS version.\n";
}
}
return @config;
}
sub _install_cpan {
my @modules = @{ +shift };
my @config = @{ +shift };
my $installed = 0;
my %args;
_load_cpan();
require Config;
if (CPAN->VERSION < 1.80) {
# no "sudo" support, probe for writableness
return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) )
and _can_write( $Config::Config{sitelib} );
}
# if we're root, set UNINST=1 to avoid trouble unless user asked for it.
my $makeflags = $CPAN::Config->{make_install_arg} || '';
$CPAN::Config->{make_install_arg} =
join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
# don't show start-up info
$CPAN::Config->{inhibit_startup_message} = 1;
# set additional options
while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
( $args{$opt} = $arg, next )
if $opt =~ /^(?:force|notest)$/; # pseudo-option
$CPAN::Config->{$opt} = $opt eq 'urllist' ? [$arg] : $arg;
}
if ($args{notest} && (not CPAN::Shell->can('notest'))) {
die "Your version of CPAN is too old to support the 'notest' pragma";
}
local $CPAN::Config->{prerequisites_policy} = 'follow';
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
print "*** Installing $pkg...\n";
my $obj = CPAN::Shell->expand( Module => $pkg );
my $success = 0;
if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) {
my $pathname = $pkg;
$pathname =~ s/::/\\W/;
foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
delete $INC{$inc};
}
my $rv = do {
if ($args{force}) {
CPAN::Shell->force( install => $pkg )
} elsif ($args{notest}) {
CPAN::Shell->notest( install => $pkg )
} else {
CPAN::Shell->install($pkg)
}
};
$rv ||= eval {
$CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, )
->{install}
if $CPAN::META;
};
if ( $rv eq 'YES' ) {
print "*** $pkg successfully installed.\n";
$success = 1;
}
else {
print "*** $pkg installation failed.\n";
$success = 0;
}
$installed += $success;
}
else {
print << ".";
*** Could not find a version $ver or above for $pkg; skipping.
.
}
MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
}
return $installed;
}
sub _has_cpanplus {
return (
$HasCPANPLUS = (
$INC{'CPANPLUS/Config.pm'}
or _load('CPANPLUS::Shell::Default')
)
);
}
# make guesses on whether we're under the CPAN installation directory
sub _under_cpan {
require Cwd;
require File::Spec;
my $cwd = File::Spec->canonpath( Cwd::getcwd() );
my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );
return ( index( $cwd, $cpan ) > -1 );
}
sub _update_to {
my $class = __PACKAGE__;
my $ver = shift;
return
if _version_cmp( _version_of($class), $ver ) >= 0; # no need to upgrade
if (
_prompt( "==> A newer version of $class ($ver) is required. Install?",
'y' ) =~ /^[Nn]/
)
{
die "*** Please install $class $ver manually.\n";
}
print << ".";
*** Trying to fetch it from CPAN...
.
# install ourselves
_load($class) and return $class->import(@_)
if $class->install( [], $class, $ver );
print << '.'; exit 1;
*** Cannot bootstrap myself. :-( Installation terminated.
.
}
# check if we're connected to some host, using inet_aton
sub _connected_to {
my $site = shift;
return (
( _load('Socket') and Socket::inet_aton($site) ) or _prompt(
qq(
*** Your host cannot resolve the domain name '$site', which
probably means the Internet connections are unavailable.
==> Should we try to install the required module(s) anyway?), 'n'
) =~ /^[Yy]/
);
}
# check if a directory is writable; may create it on demand
sub _can_write {
my $path = shift;
mkdir( $path, 0755 ) unless -e $path;
return 1 if -w $path;
print << ".";
*** You are not allowed to write to the directory '$path';
the installation may fail due to insufficient permissions.
.
if (
eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(
qq(
==> Should we try to re-execute the autoinstall process with 'sudo'?),
((-t STDIN) ? 'y' : 'n')
) =~ /^[Yy]/
)
{
# try to bootstrap ourselves from sudo
print << ".";
*** Trying to re-execute the autoinstall process with 'sudo'...
.
my $missing = join( ',', @Missing );
my $config = join( ',',
UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
if $Config;
return
unless system( 'sudo', $^X, $0, "--config=$config",
"--installdeps=$missing" );
print << ".";
*** The 'sudo' command exited with error! Resuming...
.
}
return _prompt(
qq(
==> Should we try to install the required module(s) anyway?), 'n'
) =~ /^[Yy]/;
}
# load a module and return the version it reports
sub _load {
my $mod = pop; # method/function doesn't matter
my $file = $mod;
$file =~ s|::|/|g;
$file .= '.pm';
local $@;
return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
}
# report version without loading a module
sub _version_of {
my $mod = pop; # method/function doesn't matter
my $file = $mod;
$file =~ s|::|/|g;
$file .= '.pm';
foreach my $dir ( @INC ) {
next if ref $dir;
my $path = File::Spec->catfile($dir, $file);
next unless -e $path;
require ExtUtils::MM_Unix;
return ExtUtils::MM_Unix->parse_version($path);
}
return undef;
}
# Load CPAN.pm and it's configuration
sub _load_cpan {
return if $CPAN::VERSION and $CPAN::Config and not @_;
require CPAN;
# CPAN-1.82+ adds CPAN::Config::AUTOLOAD to redirect to
# CPAN::HandleConfig->load. CPAN reports that the redirection
# is deprecated in a warning printed at the user.
# CPAN-1.81 expects CPAN::HandleConfig->load, does not have
# $CPAN::HandleConfig::VERSION but cannot handle
# CPAN::Config->load
# Which "versions expect CPAN::Config->load?
if ( $CPAN::HandleConfig::VERSION
|| CPAN::HandleConfig->can('load')
) {
# Newer versions of CPAN have a HandleConfig module
CPAN::HandleConfig->load;
} else {
# Older versions had the load method in Config directly
CPAN::Config->load;
}
}
# compare two versions, either use Sort::Versions or plain comparison
# return values same as <=>
sub _version_cmp {
my ( $cur, $min ) = @_;
return -1 unless defined $cur; # if 0 keep comparing
return 1 unless $min;
$cur =~ s/\s+$//;
# check for version numbers that are not in decimal format
if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) {
if ( ( $version::VERSION or defined( _load('version') )) and
version->can('new')
) {
# use version.pm if it is installed.
return version->new($cur) <=> version->new($min);
}
elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
{
# use Sort::Versions as the sorting algorithm for a.b.c versions
return Sort::Versions::versioncmp( $cur, $min );
}
warn "Cannot reliably compare non-decimal formatted versions.\n"
. "Please install version.pm or Sort::Versions.\n";
}
# plain comparison
local $^W = 0; # shuts off 'not numeric' bugs
return $cur <=> $min;
}
# nothing; this usage is deprecated.
sub main::PREREQ_PM { return {}; }
sub _make_args {
my %args = @_;
$args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing }
if $UnderCPAN or $TestOnly;
if ( $args{EXE_FILES} and -e 'MANIFEST' ) {
require ExtUtils::Manifest;
my $manifest = ExtUtils::Manifest::maniread('MANIFEST');
$args{EXE_FILES} =
[ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ];
}
$args{test}{TESTS} ||= 't/*.t';
$args{test}{TESTS} = join( ' ',
grep { !exists( $DisabledTests{$_} ) }
map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );
my $missing = join( ',', @Missing );
my $config =
join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
if $Config;
$PostambleActions = (
($missing and not $UnderCPAN)
? "\$(PERL) $0 --config=$config --installdeps=$missing"
: "\$(NOECHO) \$(NOOP)"
);
my $deps_list = join( ',', @Missing, @Existing );
$PostambleActionsUpgradeDeps =
"\$(PERL) $0 --config=$config --upgradedeps=$deps_list";
my $config_notest =
join( ',', (UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config}),
'notest', 1 )
if $Config;
$PostambleActionsNoTest = (
($missing and not $UnderCPAN)
? "\$(PERL) $0 --config=$config_notest --installdeps=$missing"
: "\$(NOECHO) \$(NOOP)"
);
$PostambleActionsUpgradeDepsNoTest =
"\$(PERL) $0 --config=$config_notest --upgradedeps=$deps_list";
$PostambleActionsListDeps =
'@$(PERL) -le "print for @ARGV" '
. join(' ', map $Missing[$_], grep $_ % 2 == 0, 0..$#Missing);
my @all = (@Missing, @Existing);
$PostambleActionsListAllDeps =
'@$(PERL) -le "print for @ARGV" '
. join(' ', map $all[$_], grep $_ % 2 == 0, 0..$#all);
return %args;
}
# a wrapper to ExtUtils::MakeMaker::WriteMakefile
sub Write {
require Carp;
Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
if ($CheckOnly) {
print << ".";
*** Makefile not written in check-only mode.
.
return;
}
my %args = _make_args(@_);
no strict 'refs';
$PostambleUsed = 0;
local *MY::postamble = \&postamble unless defined &MY::postamble;
ExtUtils::MakeMaker::WriteMakefile(%args);
print << "." unless $PostambleUsed;
*** WARNING: Makefile written with customized MY::postamble() without
including contents from Module::AutoInstall::postamble() --
auto installation features disabled. Please contact the author.
.
return 1;
}
sub postamble {
$PostambleUsed = 1;
my $fragment;
$fragment .= <<"AUTO_INSTALL" if !$InstallDepsTarget;
config :: installdeps
\t\$(NOECHO) \$(NOOP)
AUTO_INSTALL
$fragment .= <<"END_MAKE";
checkdeps ::
\t\$(PERL) $0 --checkdeps
installdeps ::
\t$PostambleActions
installdeps_notest ::
\t$PostambleActionsNoTest
upgradedeps ::
\t$PostambleActionsUpgradeDeps
upgradedeps_notest ::
\t$PostambleActionsUpgradeDepsNoTest
listdeps ::
\t$PostambleActionsListDeps
listalldeps ::
\t$PostambleActionsListAllDeps
END_MAKE
return $fragment;
}
1;
__END__
#line 1197
PDF-FromHTML-0.33/inc/Module/Install.pm 000644 000765 000024 00000027145 13554103470 020233 0 ustar 00audreyt staff 000000 000000 #line 1
package Module::Install;
# For any maintainers:
# The load order for Module::Install is a bit magic.
# It goes something like this...
#
# IF ( host has Module::Install installed, creating author mode ) {
# 1. Makefile.PL calls "use inc::Module::Install"
# 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
# 3. The installed version of inc::Module::Install loads
# 4. inc::Module::Install calls "require Module::Install"
# 5. The ./inc/ version of Module::Install loads
# } ELSE {
# 1. Makefile.PL calls "use inc::Module::Install"
# 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
# 3. The ./inc/ version of Module::Install loads
# }
use 5.006;
use strict 'vars';
use Cwd ();
use File::Find ();
use File::Path ();
use vars qw{$VERSION $MAIN};
BEGIN {
# All Module::Install core packages now require synchronised versions.
# This will be used to ensure we don't accidentally load old or
# different versions of modules.
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
$VERSION = '1.19';
# Storage for the pseudo-singleton
$MAIN = undef;
*inc::Module::Install::VERSION = *VERSION;
@inc::Module::Install::ISA = __PACKAGE__;
}
sub import {
my $class = shift;
my $self = $class->new(@_);
my $who = $self->_caller;
#-------------------------------------------------------------
# all of the following checks should be included in import(),
# to allow "eval 'require Module::Install; 1' to test
# installation of Module::Install. (RT #51267)
#-------------------------------------------------------------
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) { die <<"END_DIE" }
Please invoke ${\__PACKAGE__} with:
use inc::${\__PACKAGE__};
not:
use ${\__PACKAGE__};
END_DIE
# This reportedly fixes a rare Win32 UTC file time issue, but
# as this is a non-cross-platform XS module not in the core,
# we shouldn't really depend on it. See RT #24194 for detail.
# (Also, this module only supports Perl 5.6 and above).
eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
# If the script that is loading Module::Install is from the future,
# then make will detect this and cause it to re-run over and over
# again. This is bad. Rather than taking action to touch it (which
# is unreliable on some platforms and requires write permissions)
# for now we should catch this and refuse to run.
if ( -f $0 ) {
my $s = (stat($0))[9];
# If the modification time is only slightly in the future,
# sleep briefly to remove the problem.
my $a = $s - time;
if ( $a > 0 and $a < 5 ) { sleep 5 }
# Too far in the future, throw an error.
my $t = time;
if ( $s > $t ) { die <<"END_DIE" }
Your installer $0 has a modification time in the future ($s > $t).
This is known to create infinite loops in make.
Please correct this, then run $0 again.
END_DIE
}
# Build.PL was formerly supported, but no longer is due to excessive
# difficulty in implementing every single feature twice.
if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
Module::Install no longer supports Build.PL.
It was impossible to maintain duel backends, and has been deprecated.
Please remove all Build.PL files and only use the Makefile.PL installer.
END_DIE
#-------------------------------------------------------------
# To save some more typing in Module::Install installers, every...
# use inc::Module::Install
# ...also acts as an implicit use strict.
$^H |= strict::bits(qw(refs subs vars));
#-------------------------------------------------------------
unless ( -f $self->{file} ) {
foreach my $key (keys %INC) {
delete $INC{$key} if $key =~ /Module\/Install/;
}
local $^W;
require "$self->{path}/$self->{dispatch}.pm";
File::Path::mkpath("$self->{prefix}/$self->{author}");
$self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
$self->{admin}->init;
@_ = ($class, _self => $self);
goto &{"$self->{name}::import"};
}
local $^W;
*{"${who}::AUTOLOAD"} = $self->autoload;
$self->preload;
# Unregister loader and worker packages so subdirs can use them again
delete $INC{'inc/Module/Install.pm'};
delete $INC{'Module/Install.pm'};
# Save to the singleton
$MAIN = $self;
return 1;
}
sub autoload {
my $self = shift;
my $who = $self->_caller;
my $cwd = Cwd::getcwd();
my $sym = "${who}::AUTOLOAD";
$sym->{$cwd} = sub {
my $pwd = Cwd::getcwd();
if ( my $code = $sym->{$pwd} ) {
# Delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
}
unless ($$sym =~ s/([^:]+)$//) {
# XXX: it looks like we can't retrieve the missing function
# via $$sym (usually $main::AUTOLOAD) in this case.
# I'm still wondering if we should slurp Makefile.PL to
# get some context or not ...
my ($package, $file, $line) = caller;
die <<"EOT";
Unknown function is found at $file line $line.
Execution of $file aborted due to runtime errors.
If you're a contributor to a project, you may need to install
some Module::Install extensions from CPAN (or other repository).
If you're a user of a module, please contact the author.
EOT
}
my $method = $1;
if ( uc($method) eq $method ) {
# Do nothing
return;
} elsif ( $method =~ /^_/ and $self->can($method) ) {
# Dispatch to the root M:I class
return $self->$method(@_);
}
# Dispatch to the appropriate plugin
unshift @_, ( $self, $1 );
goto &{$self->can('call')};
};
}
sub preload {
my $self = shift;
unless ( $self->{extensions} ) {
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
);
}
my @exts = @{$self->{extensions}};
unless ( @exts ) {
@exts = $self->{admin}->load_all_extensions;
}
my %seen;
foreach my $obj ( @exts ) {
while (my ($method, $glob) = each %{ref($obj) . '::'}) {
next unless $obj->can($method);
next if $method =~ /^_/;
next if $method eq uc($method);
$seen{$method}++;
}
}
my $who = $self->_caller;
foreach my $name ( sort keys %seen ) {
local $^W;
*{"${who}::$name"} = sub {
${"${who}::AUTOLOAD"} = "${who}::$name";
goto &{"${who}::AUTOLOAD"};
};
}
}
sub new {
my ($class, %args) = @_;
delete $INC{'FindBin.pm'};
{
# to suppress the redefine warning
local $SIG{__WARN__} = sub {};
require FindBin;
}
# ignore the prefix on extension modules built from top level.
my $base_path = Cwd::abs_path($FindBin::Bin);
unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) {
delete $args{prefix};
}
return $args{_self} if $args{_self};
$base_path = VMS::Filespec::unixify($base_path) if $^O eq 'VMS';
$args{dispatch} ||= 'Admin';
$args{prefix} ||= 'inc';
$args{author} ||= ($^O eq 'VMS' ? '_author' : '.author');
$args{bundle} ||= 'inc/BUNDLES';
$args{base} ||= $base_path;
$class =~ s/^\Q$args{prefix}\E:://;
$args{name} ||= $class;
$args{version} ||= $class->VERSION;
unless ( $args{path} ) {
$args{path} = $args{name};
$args{path} =~ s!::!/!g;
}
$args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
$args{wrote} = 0;
bless( \%args, $class );
}
sub call {
my ($self, $method) = @_;
my $obj = $self->load($method) or return;
splice(@_, 0, 2, $obj);
goto &{$obj->can($method)};
}
sub load {
my ($self, $method) = @_;
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
) unless $self->{extensions};
foreach my $obj (@{$self->{extensions}}) {
return $obj if $obj->can($method);
}
my $admin = $self->{admin} or die <<"END_DIE";
The '$method' method does not exist in the '$self->{prefix}' path!
Please remove the '$self->{prefix}' directory and run $0 again to load it.
END_DIE
my $obj = $admin->load($method, 1);
push @{$self->{extensions}}, $obj;
$obj;
}
sub load_extensions {
my ($self, $path, $top) = @_;
my $should_reload = 0;
unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
unshift @INC, $self->{prefix};
$should_reload = 1;
}
foreach my $rv ( $self->find_extensions($path) ) {
my ($file, $pkg) = @{$rv};
next if $self->{pathnames}{$pkg};
local $@;
my $new = eval { local $^W; require $file; $pkg->can('new') };
unless ( $new ) {
warn $@ if $@;
next;
}
$self->{pathnames}{$pkg} =
$should_reload ? delete $INC{$file} : $INC{$file};
push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
}
$self->{extensions} ||= [];
}
sub find_extensions {
my ($self, $path) = @_;
my @found;
File::Find::find( {no_chdir => 1, wanted => sub {
my $file = $File::Find::name;
return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
my $subpath = $1;
return if lc($subpath) eq lc($self->{dispatch});
$file = "$self->{path}/$subpath.pm";
my $pkg = "$self->{name}::$subpath";
$pkg =~ s!/!::!g;
# If we have a mixed-case package name, assume case has been preserved
# correctly. Otherwise, root through the file to locate the case-preserved
# version of the package name.
if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
my $content = Module::Install::_read($File::Find::name);
my $in_pod = 0;
foreach ( split /\n/, $content ) {
$in_pod = 1 if /^=\w/;
$in_pod = 0 if /^=cut/;
next if ($in_pod || /^=cut/); # skip pod text
next if /^\s*#/; # and comments
if ( m/^\s*package\s+($pkg)\s*;/i ) {
$pkg = $1;
last;
}
}
}
push @found, [ $file, $pkg ];
}}, $path ) if -d $path;
@found;
}
#####################################################################
# Common Utility Functions
sub _caller {
my $depth = 0;
my $call = caller($depth);
while ( $call eq __PACKAGE__ ) {
$depth++;
$call = caller($depth);
}
return $call;
}
sub _read {
local *FH;
open( FH, '<', $_[0] ) or die "open($_[0]): $!";
binmode FH;
my $string = do { local $/; };
close FH or die "close($_[0]): $!";
return $string;
}
sub _readperl {
my $string = Module::Install::_read($_[0]);
$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
$string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
$string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
return $string;
}
sub _readpod {
my $string = Module::Install::_read($_[0]);
$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
return $string if $_[0] =~ /\.pod\z/;
$string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
$string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
$string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
$string =~ s/^\n+//s;
return $string;
}
sub _write {
local *FH;
open( FH, '>', $_[0] ) or die "open($_[0]): $!";
binmode FH;
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
close FH or die "close($_[0]): $!";
}
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
sub _version {
my $s = shift || 0;
my $d =()= $s =~ /(\.)/g;
if ( $d >= 2 ) {
# Normalise multipart versions
$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
}
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map {
$_ . '0' x (3 - length $_)
} $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
sub _cmp {
_version($_[1]) <=> _version($_[2]);
}
# Cloned from Params::Util::_CLASS
sub _CLASS {
(
defined $_[0]
and
! ref $_[0]
and
$_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
) ? $_[0] : undef;
}
1;
# Copyright 2008 - 2012 Adam Kennedy.
PDF-FromHTML-0.33/inc/Module/Install/Fetch.pm 000644 000765 000024 00000004627 13554103472 021266 0 ustar 00audreyt staff 000000 000000 #line 1
package Module::Install::Fetch;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.19';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
sub get_file {
my ($self, %args) = @_;
my ($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
$args{url} = $args{ftp_url}
or (warn("LWP support unavailable!\n"), return);
($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
}
$|++;
print "Fetching '$file' from $host... ";
unless (eval { require Socket; Socket::inet_aton($host) }) {
warn "'$host' resolve failed!\n";
return;
}
return unless $scheme eq 'ftp' or $scheme eq 'http';
require Cwd;
my $dir = Cwd::getcwd();
chdir $args{local_dir} or return if exists $args{local_dir};
if (eval { require LWP::Simple; 1 }) {
LWP::Simple::mirror($args{url}, $file);
}
elsif (eval { require Net::FTP; 1 }) { eval {
# use Net::FTP to get past firewall
my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
$ftp->login("anonymous", 'anonymous@example.com');
$ftp->cwd($path);
$ftp->binary;
$ftp->get($file) or (warn("$!\n"), return);
$ftp->quit;
} }
elsif (my $ftp = $self->can_run('ftp')) { eval {
# no Net::FTP, fallback to ftp.exe
require FileHandle;
my $fh = FileHandle->new;
local $SIG{CHLD} = 'IGNORE';
unless ($fh->open("|$ftp -n")) {
warn "Couldn't open ftp: $!\n";
chdir $dir; return;
}
my @dialog = split(/\n/, <<"END_FTP");
open $host
user anonymous anonymous\@example.com
cd $path
binary
get $file $file
quit
END_FTP
foreach (@dialog) { $fh->print("$_\n") }
$fh->close;
} }
else {
warn "No working 'ftp' program available!\n";
chdir $dir; return;
}
unless (-f $file) {
warn "Fetching failed: $@\n";
chdir $dir; return;
}
return if exists $args{size} and -s $file != $args{size};
system($args{run}) if exists $args{run};
unlink($file) if $args{remove};
print(((!exists $args{check_for} or -e $args{check_for})
? "done!" : "failed! ($!)"), "\n");
chdir $dir; return !$?;
}
1;
PDF-FromHTML-0.33/inc/Module/Install/Metadata.pm 000644 000765 000024 00000043302 13554103471 021745 0 ustar 00audreyt staff 000000 000000 #line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.19';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
my @boolean_keys = qw{
sign
};
my @scalar_keys = qw{
name
module_name
abstract
version
distribution_type
tests
installdirs
};
my @tuple_keys = qw{
configure_requires
build_requires
requires
recommends
bundles
resources
};
my @resource_keys = qw{
homepage
bugtracker
repository
};
my @array_keys = qw{
keywords
author
};
*authors = \&author;
sub Meta { shift }
sub Meta_BooleanKeys { @boolean_keys }
sub Meta_ScalarKeys { @scalar_keys }
sub Meta_TupleKeys { @tuple_keys }
sub Meta_ResourceKeys { @resource_keys }
sub Meta_ArrayKeys { @array_keys }
foreach my $key ( @boolean_keys ) {
*$key = sub {
my $self = shift;
if ( defined wantarray and not @_ ) {
return $self->{values}->{$key};
}
$self->{values}->{$key} = ( @_ ? $_[0] : 1 );
return $self;
};
}
foreach my $key ( @scalar_keys ) {
*$key = sub {
my $self = shift;
return $self->{values}->{$key} if defined wantarray and !@_;
$self->{values}->{$key} = shift;
return $self;
};
}
foreach my $key ( @array_keys ) {
*$key = sub {
my $self = shift;
return $self->{values}->{$key} if defined wantarray and !@_;
$self->{values}->{$key} ||= [];
push @{$self->{values}->{$key}}, @_;
return $self;
};
}
foreach my $key ( @resource_keys ) {
*$key = sub {
my $self = shift;
unless ( @_ ) {
return () unless $self->{values}->{resources};
return map { $_->[1] }
grep { $_->[0] eq $key }
@{ $self->{values}->{resources} };
}
return $self->{values}->{resources}->{$key} unless @_;
my $uri = shift or die(
"Did not provide a value to $key()"
);
$self->resources( $key => $uri );
return 1;
};
}
foreach my $key ( grep { $_ ne "resources" } @tuple_keys) {
*$key = sub {
my $self = shift;
return $self->{values}->{$key} unless @_;
my @added;
while ( @_ ) {
my $module = shift or last;
my $version = shift || 0;
push @added, [ $module, $version ];
}
push @{ $self->{values}->{$key} }, @added;
return map {@$_} @added;
};
}
# Resource handling
my %lc_resource = map { $_ => 1 } qw{
homepage
license
bugtracker
repository
};
sub resources {
my $self = shift;
while ( @_ ) {
my $name = shift or last;
my $value = shift or next;
if ( $name eq lc $name and ! $lc_resource{$name} ) {
die("Unsupported reserved lowercase resource '$name'");
}
$self->{values}->{resources} ||= [];
push @{ $self->{values}->{resources} }, [ $name, $value ];
}
$self->{values}->{resources};
}
# Aliases for build_requires that will have alternative
# meanings in some future version of META.yml.
sub test_requires { shift->build_requires(@_) }
sub install_requires { shift->build_requires(@_) }
# Aliases for installdirs options
sub install_as_core { $_[0]->installdirs('perl') }
sub install_as_cpan { $_[0]->installdirs('site') }
sub install_as_site { $_[0]->installdirs('site') }
sub install_as_vendor { $_[0]->installdirs('vendor') }
sub dynamic_config {
my $self = shift;
my $value = @_ ? shift : 1;
if ( $self->{values}->{dynamic_config} ) {
# Once dynamic we never change to static, for safety
return 0;
}
$self->{values}->{dynamic_config} = $value ? 1 : 0;
return 1;
}
# Convenience command
sub static_config {
shift->dynamic_config(0);
}
sub perl_version {
my $self = shift;
return $self->{values}->{perl_version} unless @_;
my $version = shift or die(
"Did not provide a value to perl_version()"
);
# Normalize the version
$version = $self->_perl_version($version);
# We don't support the really old versions
unless ( $version >= 5.005 ) {
die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
}
$self->{values}->{perl_version} = $version;
}
sub all_from {
my ( $self, $file ) = @_;
unless ( defined($file) ) {
my $name = $self->name or die(
"all_from called with no args without setting name() first"
);
$file = join('/', 'lib', split(/-/, $name)) . '.pm';
$file =~ s{.*/}{} unless -e $file;
unless ( -e $file ) {
die("all_from cannot find $file from $name");
}
}
unless ( -f $file ) {
die("The path '$file' does not exist, or is not a file");
}
$self->{values}{all_from} = $file;
# Some methods pull from POD instead of code.
# If there is a matching .pod, use that instead
my $pod = $file;
$pod =~ s/\.pm$/.pod/i;
$pod = $file unless -e $pod;
# Pull the different values
$self->name_from($file) unless $self->name;
$self->version_from($file) unless $self->version;
$self->perl_version_from($file) unless $self->perl_version;
$self->author_from($pod) unless @{$self->author || []};
$self->license_from($pod) unless $self->license;
$self->abstract_from($pod) unless $self->abstract;
return 1;
}
sub provides {
my $self = shift;
my $provides = ( $self->{values}->{provides} ||= {} );
%$provides = (%$provides, @_) if @_;
return $provides;
}
sub auto_provides {
my $self = shift;
return $self unless $self->is_admin;
unless (-e 'MANIFEST') {
warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
return $self;
}
# Avoid spurious warnings as we are not checking manifest here.
local $SIG{__WARN__} = sub {1};
require ExtUtils::Manifest;
local *ExtUtils::Manifest::manicheck = sub { return };
require Module::Build;
my $build = Module::Build->new(
dist_name => $self->name,
dist_version => $self->version,
license => $self->license,
);
$self->provides( %{ $build->find_dist_packages || {} } );
}
sub feature {
my $self = shift;
my $name = shift;
my $features = ( $self->{values}->{features} ||= [] );
my $mods;
if ( @_ == 1 and ref( $_[0] ) ) {
# The user used ->feature like ->features by passing in the second
# argument as a reference. Accomodate for that.
$mods = $_[0];
} else {
$mods = \@_;
}
my $count = 0;
push @$features, (
$name => [
map {
ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
} @$mods
]
);
return @$features;
}
sub features {
my $self = shift;
while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
$self->feature( $name, @$mods );
}
return $self->{values}->{features}
? @{ $self->{values}->{features} }
: ();
}
sub no_index {
my $self = shift;
my $type = shift;
push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
return $self->{values}->{no_index};
}
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
} else {
$self->can($key)->($self, $value);
}
}
return $self;
}
sub write {
my $self = shift;
return $self unless $self->is_admin;
$self->admin->write_meta;
return $self;
}
sub version_from {
require ExtUtils::MM_Unix;
my ( $self, $file ) = @_;
$self->version( ExtUtils::MM_Unix->parse_version($file) );
# for version integrity check
$self->makemaker_args( VERSION_FROM => $file );
}
sub abstract_from {
require ExtUtils::MM_Unix;
my ( $self, $file ) = @_;
$self->abstract(
bless(
{ DISTNAME => $self->name },
'ExtUtils::MM_Unix'
)->parse_abstract($file)
);
}
# Add both distribution and module name
sub name_from {
my ($self, $file) = @_;
if (
Module::Install::_read($file) =~ m/
^ \s*
package \s*
([\w:]+)
[\s|;]*
/ixms
) {
my ($name, $module_name) = ($1, $1);
$name =~ s{::}{-}g;
$self->name($name);
unless ( $self->module_name ) {
$self->module_name($module_name);
}
} else {
die("Cannot determine name from $file\n");
}
}
sub _extract_perl_version {
if (
$_[0] =~ m/
^\s*
(?:use|require) \s*
v?
([\d_\.]+)
\s* ;
/ixms
) {
my $perl_version = $1;
$perl_version =~ s{_}{}g;
return $perl_version;
} else {
return;
}
}
sub perl_version_from {
my $self = shift;
my $perl_version=_extract_perl_version(Module::Install::_read($_[0]));
if ($perl_version) {
$self->perl_version($perl_version);
} else {
warn "Cannot determine perl version info from $_[0]\n";
return;
}
}
sub author_from {
my $self = shift;
my $content = Module::Install::_read($_[0]);
if ($content =~ m/
=head \d \s+ (?:authors?)\b \s*
([^\n]*)
|
=head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
.*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
([^\n]*)
/ixms) {
my $author = $1 || $2;
# XXX: ugly but should work anyway...
if (eval "require Pod::Escapes; 1") {
# Pod::Escapes has a mapping table.
# It's in core of perl >= 5.9.3, and should be installed
# as one of the Pod::Simple's prereqs, which is a prereq
# of Pod::Text 3.x (see also below).
$author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
{
defined $2
? chr($2)
: defined $Pod::Escapes::Name2character_number{$1}
? chr($Pod::Escapes::Name2character_number{$1})
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
# Pod::Text < 3.0 has yet another mapping table,
# though the table name of 2.x and 1.x are different.
# (1.x is in core of Perl < 5.6, 2.x is in core of
# Perl < 5.9.3)
my $mapping = ($Pod::Text::VERSION < 2)
? \%Pod::Text::HTML_Escapes
: \%Pod::Text::ESCAPES;
$author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
{
defined $2
? chr($2)
: defined $mapping->{$1}
? $mapping->{$1}
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
else {
$author =~ s{E}{<}g;
$author =~ s{E}{>}g;
}
$self->author($author);
} else {
warn "Cannot determine author info from $_[0]\n";
}
}
#Stolen from M::B
my %license_urls = (
perl => 'http://dev.perl.org/licenses/',
apache => 'http://apache.org/licenses/LICENSE-2.0',
apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1',
artistic => 'http://opensource.org/licenses/artistic-license.php',
artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
lgpl => 'http://opensource.org/licenses/lgpl-license.php',
lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
bsd => 'http://opensource.org/licenses/bsd-license.php',
gpl => 'http://opensource.org/licenses/gpl-license.php',
gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
mit => 'http://opensource.org/licenses/mit-license.php',
mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
open_source => undef,
unrestricted => undef,
restrictive => undef,
unknown => undef,
);
sub license {
my $self = shift;
return $self->{values}->{license} unless @_;
my $license = shift or die(
'Did not provide a value to license()'
);
$license = __extract_license($license) || lc $license;
$self->{values}->{license} = $license;
# Automatically fill in license URLs
if ( $license_urls{$license} ) {
$self->resources( license => $license_urls{$license} );
}
return 1;
}
sub _extract_license {
my $pod = shift;
my $matched;
return __extract_license(
($matched) = $pod =~ m/
(=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
(=head \d.*|=cut.*|)\z
/xms
) || __extract_license(
($matched) = $pod =~ m/
(=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?)
(=head \d.*|=cut.*|)\z
/xms
);
}
sub __extract_license {
my $license_text = shift or return;
my @phrases = (
'(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1,
'(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
'Artistic and GPL' => 'perl', 1,
'GNU general public license' => 'gpl', 1,
'GNU public license' => 'gpl', 1,
'GNU lesser general public license' => 'lgpl', 1,
'GNU lesser public license' => 'lgpl', 1,
'GNU library general public license' => 'lgpl', 1,
'GNU library public license' => 'lgpl', 1,
'GNU Free Documentation license' => 'unrestricted', 1,
'GNU Affero General Public License' => 'open_source', 1,
'(?:Free)?BSD license' => 'bsd', 1,
'Artistic license 2\.0' => 'artistic_2', 1,
'Artistic license' => 'artistic', 1,
'Apache (?:Software )?license' => 'apache', 1,
'GPL' => 'gpl', 1,
'LGPL' => 'lgpl', 1,
'BSD' => 'bsd', 1,
'Artistic' => 'artistic', 1,
'MIT' => 'mit', 1,
'Mozilla Public License' => 'mozilla', 1,
'Q Public License' => 'open_source', 1,
'OpenSSL License' => 'unrestricted', 1,
'SSLeay License' => 'unrestricted', 1,
'zlib License' => 'open_source', 1,
'proprietary' => 'proprietary', 0,
);
while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
$pattern =~ s#\s+#\\s+#gs;
if ( $license_text =~ /\b$pattern\b/i ) {
return $license;
}
}
return '';
}
sub license_from {
my $self = shift;
if (my $license=_extract_license(Module::Install::_read($_[0]))) {
$self->license($license);
} else {
warn "Cannot determine license info from $_[0]\n";
return 'unknown';
}
}
sub _extract_bugtracker {
my @links = $_[0] =~ m#L<(
https?\Q://rt.cpan.org/\E[^>]+|
https?\Q://github.com/\E[\w_]+/[\w_]+/issues|
https?\Q://code.google.com/p/\E[\w_\-]+/issues/list
)>#gx;
my %links;
@links{@links}=();
@links=keys %links;
return @links;
}
sub bugtracker_from {
my $self = shift;
my $content = Module::Install::_read($_[0]);
my @links = _extract_bugtracker($content);
unless ( @links ) {
warn "Cannot determine bugtracker info from $_[0]\n";
return 0;
}
if ( @links > 1 ) {
warn "Found more than one bugtracker link in $_[0]\n";
return 0;
}
# Set the bugtracker
bugtracker( $links[0] );
return 1;
}
sub requires_from {
my $self = shift;
my $content = Module::Install::_readperl($_[0]);
my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg;
while ( @requires ) {
my $module = shift @requires;
my $version = shift @requires;
$self->requires( $module => $version );
}
}
sub test_requires_from {
my $self = shift;
my $content = Module::Install::_readperl($_[0]);
my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
while ( @requires ) {
my $module = shift @requires;
my $version = shift @requires;
$self->test_requires( $module => $version );
}
}
# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
# numbers (eg, 5.006001 or 5.008009).
# Also, convert double-part versions (eg, 5.8)
sub _perl_version {
my $v = $_[-1];
$v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
$v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
$v =~ s/(\.\d\d\d)000$/$1/;
$v =~ s/_.+$//;
if ( ref($v) ) {
# Numify
$v = $v + 0;
}
return $v;
}
sub add_metadata {
my $self = shift;
my %hash = @_;
for my $key (keys %hash) {
warn "add_metadata: $key is not prefixed with 'x_'.\n" .
"Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
$self->{values}->{$key} = $hash{$key};
}
}
######################################################################
# MYMETA Support
sub WriteMyMeta {
die "WriteMyMeta has been deprecated";
}
sub write_mymeta_yaml {
my $self = shift;
# We need YAML::Tiny to write the MYMETA.yml file
unless ( eval { require YAML::Tiny; 1; } ) {
return 1;
}
# Generate the data
my $meta = $self->_write_mymeta_data or return 1;
# Save as the MYMETA.yml file
print "Writing MYMETA.yml\n";
YAML::Tiny::DumpFile('MYMETA.yml', $meta);
}
sub write_mymeta_json {
my $self = shift;
# We need JSON to write the MYMETA.json file
unless ( eval { require JSON; 1; } ) {
return 1;
}
# Generate the data
my $meta = $self->_write_mymeta_data or return 1;
# Save as the MYMETA.yml file
print "Writing MYMETA.json\n";
Module::Install::_write(
'MYMETA.json',
JSON->new->pretty(1)->canonical->encode($meta),
);
}
sub _write_mymeta_data {
my $self = shift;
# If there's no existing META.yml there is nothing we can do
return undef unless -f 'META.yml';
# We need Parse::CPAN::Meta to load the file
unless ( eval { require Parse::CPAN::Meta; 1; } ) {
return undef;
}
# Merge the perl version into the dependencies
my $val = $self->Meta->{values};
my $perl = delete $val->{perl_version};
if ( $perl ) {
$val->{requires} ||= [];
my $requires = $val->{requires};
# Canonize to three-dot version after Perl 5.6
if ( $perl >= 5.006 ) {
$perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e
}
unshift @$requires, [ perl => $perl ];
}
# Load the advisory META.yml file
my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
my $meta = $yaml[0];
# Overwrite the non-configure dependency hashes
delete $meta->{requires};
delete $meta->{build_requires};
delete $meta->{recommends};
if ( exists $val->{requires} ) {
$meta->{requires} = { map { @$_ } @{ $val->{requires} } };
}
if ( exists $val->{build_requires} ) {
$meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
}
return $meta;
}
1;
PDF-FromHTML-0.33/inc/Module/Install/AutoInstall.pm 000644 000765 000024 00000004162 13554103471 022465 0 ustar 00audreyt staff 000000 000000 #line 1
package Module::Install::AutoInstall;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.19';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
sub AutoInstall { $_[0] }
sub run {
my $self = shift;
$self->auto_install_now(@_);
}
sub write {
my $self = shift;
$self->auto_install(@_);
}
sub auto_install {
my $self = shift;
return if $self->{done}++;
# Flatten array of arrays into a single array
my @core = map @$_, map @$_, grep ref,
$self->build_requires, $self->requires;
my @config = @_;
# We'll need Module::AutoInstall
$self->include('Module::AutoInstall');
require Module::AutoInstall;
my @features_require = Module::AutoInstall->import(
(@config ? (-config => \@config) : ()),
(@core ? (-core => \@core) : ()),
$self->features,
);
my %seen;
my @requires = map @$_, map @$_, grep ref, $self->requires;
while (my ($mod, $ver) = splice(@requires, 0, 2)) {
$seen{$mod}{$ver}++;
}
my @build_requires = map @$_, map @$_, grep ref, $self->build_requires;
while (my ($mod, $ver) = splice(@build_requires, 0, 2)) {
$seen{$mod}{$ver}++;
}
my @configure_requires = map @$_, map @$_, grep ref, $self->configure_requires;
while (my ($mod, $ver) = splice(@configure_requires, 0, 2)) {
$seen{$mod}{$ver}++;
}
my @deduped;
while (my ($mod, $ver) = splice(@features_require, 0, 2)) {
push @deduped, $mod => $ver unless $seen{$mod}{$ver}++;
}
$self->requires(@deduped);
$self->makemaker_args( Module::AutoInstall::_make_args() );
my $class = ref($self);
$self->postamble(
"# --- $class section:\n" .
Module::AutoInstall::postamble()
);
}
sub installdeps_target {
my ($self, @args) = @_;
$self->include('Module::AutoInstall');
require Module::AutoInstall;
Module::AutoInstall::_installdeps_target(1);
$self->auto_install(@args);
}
sub auto_install_now {
my $self = shift;
$self->auto_install(@_);
Module::AutoInstall::do_install();
}
1;
PDF-FromHTML-0.33/inc/Module/Install/Win32.pm 000644 000765 000024 00000003403 13554103472 021126 0 ustar 00audreyt staff 000000 000000 #line 1
package Module::Install::Win32;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.19';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
# determine if the user needs nmake, and download it if needed
sub check_nmake {
my $self = shift;
$self->load('can_run');
$self->load('get_file');
require Config;
return unless (
$^O eq 'MSWin32' and
$Config::Config{make} and
$Config::Config{make} =~ /^nmake\b/i and
! $self->can_run('nmake')
);
print "The required 'nmake' executable not found, fetching it...\n";
require File::Basename;
my $rv = $self->get_file(
url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
local_dir => File::Basename::dirname($^X),
size => 51928,
run => 'Nmake15.exe /o > nul',
check_for => 'Nmake.exe',
remove => 1,
);
die <<'END_MESSAGE' unless $rv;
-------------------------------------------------------------------------------
Since you are using Microsoft Windows, you will need the 'nmake' utility
before installation. It's available at:
http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe
or
ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe
Please download the file manually, save it to a directory in %PATH% (e.g.
C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to
that directory, and run "Nmake15.exe" from there; that will create the
'nmake.exe' file needed by this module.
You may then resume the installation process described in README.
-------------------------------------------------------------------------------
END_MESSAGE
}
1;
PDF-FromHTML-0.33/inc/Module/Install/WriteAll.pm 000644 000765 000024 00000002376 13554103472 021757 0 ustar 00audreyt staff 000000 000000 #line 1
package Module::Install::WriteAll;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.19';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
sub WriteAll {
my $self = shift;
my %args = (
meta => 1,
sign => 0,
inline => 0,
check_nmake => 1,
@_,
);
$self->sign(1) if $args{sign};
$self->admin->WriteAll(%args) if $self->is_admin;
$self->check_nmake if $args{check_nmake};
unless ( $self->makemaker_args->{PL_FILES} ) {
# XXX: This still may be a bit over-defensive...
unless ($self->makemaker(6.25)) {
$self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL';
}
}
# Until ExtUtils::MakeMaker support MYMETA.yml, make sure
# we clean it up properly ourself.
$self->realclean_files('MYMETA.yml');
if ( $args{inline} ) {
$self->Inline->write;
} else {
$self->Makefile->write;
}
# The Makefile write process adds a couple of dependencies,
# so write the META.yml files after the Makefile.
if ( $args{meta} ) {
$self->Meta->write;
}
# Experimental support for MYMETA
if ( $ENV{X_MYMETA} ) {
if ( $ENV{X_MYMETA} eq 'JSON' ) {
$self->Meta->write_mymeta_json;
} else {
$self->Meta->write_mymeta_yaml;
}
}
return 1;
}
1;
PDF-FromHTML-0.33/inc/Module/Install/Can.pm 000644 000765 000024 00000006405 13554103471 020731 0 ustar 00audreyt staff 000000 000000 #line 1
package Module::Install::Can;
use strict;
use Config ();
use ExtUtils::MakeMaker ();
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.19';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
# check if we can load some module
### Upgrade this to not have to load the module if possible
sub can_use {
my ($self, $mod, $ver) = @_;
$mod =~ s{::|\\}{/}g;
$mod .= '.pm' unless $mod =~ /\.pm$/i;
my $pkg = $mod;
$pkg =~ s{/}{::}g;
$pkg =~ s{\.pm$}{}i;
local $@;
eval { require $mod; $pkg->VERSION($ver || 0); 1 };
}
# Check if we can run some command
sub can_run {
my ($self, $cmd) = @_;
my $_cmd = $cmd;
return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
next if $dir eq '';
require File::Spec;
my $abs = File::Spec->catfile($dir, $cmd);
return $abs if (-x $abs or $abs = MM->maybe_command($abs));
}
return;
}
# Can our C compiler environment build XS files
sub can_xs {
my $self = shift;
# Ensure we have the CBuilder module
$self->configure_requires( 'ExtUtils::CBuilder' => 0.27 );
# Do we have the configure_requires checker?
local $@;
eval "require ExtUtils::CBuilder;";
if ( $@ ) {
# They don't obey configure_requires, so it is
# someone old and delicate. Try to avoid hurting
# them by falling back to an older simpler test.
return $self->can_cc();
}
# Do we have a working C compiler
my $builder = ExtUtils::CBuilder->new(
quiet => 1,
);
unless ( $builder->have_compiler ) {
# No working C compiler
return 0;
}
# Write a C file representative of what XS becomes
require File::Temp;
my ( $FH, $tmpfile ) = File::Temp::tempfile(
"compilexs-XXXXX",
SUFFIX => '.c',
);
binmode $FH;
print $FH <<'END_C';
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
int main(int argc, char **argv) {
return 0;
}
int boot_sanexs() {
return 1;
}
END_C
close $FH;
# Can the C compiler access the same headers XS does
my @libs = ();
my $object = undef;
eval {
local $^W = 0;
$object = $builder->compile(
source => $tmpfile,
);
@libs = $builder->link(
objects => $object,
module_name => 'sanexs',
);
};
my $result = $@ ? 0 : 1;
# Clean up all the build files
foreach ( $tmpfile, $object, @libs ) {
next unless defined $_;
1 while unlink;
}
return $result;
}
# Can we locate a (the) C compiler
sub can_cc {
my $self = shift;
if ($^O eq 'VMS') {
require ExtUtils::CBuilder;
my $builder = ExtUtils::CBuilder->new(
quiet => 1,
);
return $builder->have_compiler;
}
my @chunks = split(/ /, $Config::Config{cc}) or return;
# $Config{cc} may contain args; try to find out the program part
while (@chunks) {
return $self->can_run("@chunks") || (pop(@chunks), next);
}
return;
}
# Fix Cygwin bug on maybe_command();
if ( $^O eq 'cygwin' ) {
require ExtUtils::MM_Cygwin;
require ExtUtils::MM_Win32;
if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
*ExtUtils::MM_Cygwin::maybe_command = sub {
my ($self, $file) = @_;
if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
ExtUtils::MM_Win32->maybe_command($file);
} else {
ExtUtils::MM_Unix->maybe_command($file);
}
}
}
}
1;
__END__
#line 245
PDF-FromHTML-0.33/inc/Module/Install/Include.pm 000644 000765 000024 00000001015 13554103471 021603 0 ustar 00audreyt staff 000000 000000 #line 1
package Module::Install::Include;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.19';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
sub include {
shift()->admin->include(@_);
}
sub include_deps {
shift()->admin->include_deps(@_);
}
sub auto_include {
shift()->admin->auto_include(@_);
}
sub auto_include_deps {
shift()->admin->auto_include_deps(@_);
}
sub auto_include_dependent_dists {
shift()->admin->auto_include_dependent_dists(@_);
}
1;
PDF-FromHTML-0.33/inc/Module/Install/Makefile.pm 000644 000765 000024 00000027437 13554103471 021755 0 ustar 00audreyt staff 000000 000000 #line 1
package Module::Install::Makefile;
use strict 'vars';
use ExtUtils::MakeMaker ();
use Module::Install::Base ();
use Fcntl qw/:flock :seek/;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.19';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
sub Makefile { $_[0] }
my %seen = ();
sub prompt {
shift;
# Infinite loop protection
my @c = caller();
if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
}
# In automated testing or non-interactive session, always use defaults
if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
local $ENV{PERL_MM_USE_DEFAULT} = 1;
goto &ExtUtils::MakeMaker::prompt;
} else {
goto &ExtUtils::MakeMaker::prompt;
}
}
# Store a cleaned up version of the MakeMaker version,
# since we need to behave differently in a variety of
# ways based on the MM version.
my $makemaker = eval $ExtUtils::MakeMaker::VERSION;
# If we are passed a param, do a "newer than" comparison.
# Otherwise, just return the MakeMaker version.
sub makemaker {
( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
}
# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
# as we only need to know here whether the attribute is an array
# or a hash or something else (which may or may not be appendable).
my %makemaker_argtype = (
C => 'ARRAY',
CONFIG => 'ARRAY',
# CONFIGURE => 'CODE', # ignore
DIR => 'ARRAY',
DL_FUNCS => 'HASH',
DL_VARS => 'ARRAY',
EXCLUDE_EXT => 'ARRAY',
EXE_FILES => 'ARRAY',
FUNCLIST => 'ARRAY',
H => 'ARRAY',
IMPORTS => 'HASH',
INCLUDE_EXT => 'ARRAY',
LIBS => 'ARRAY', # ignore ''
MAN1PODS => 'HASH',
MAN3PODS => 'HASH',
META_ADD => 'HASH',
META_MERGE => 'HASH',
PL_FILES => 'HASH',
PM => 'HASH',
PMLIBDIRS => 'ARRAY',
PMLIBPARENTDIRS => 'ARRAY',
PREREQ_PM => 'HASH',
CONFIGURE_REQUIRES => 'HASH',
SKIP => 'ARRAY',
TYPEMAPS => 'ARRAY',
XS => 'HASH',
# VERSION => ['version',''], # ignore
# _KEEP_AFTER_FLUSH => '',
clean => 'HASH',
depend => 'HASH',
dist => 'HASH',
dynamic_lib=> 'HASH',
linkext => 'HASH',
macro => 'HASH',
postamble => 'HASH',
realclean => 'HASH',
test => 'HASH',
tool_autosplit => 'HASH',
# special cases where you can use makemaker_append
CCFLAGS => 'APPENDABLE',
DEFINE => 'APPENDABLE',
INC => 'APPENDABLE',
LDDLFLAGS => 'APPENDABLE',
LDFROM => 'APPENDABLE',
);
sub makemaker_args {
my ($self, %new_args) = @_;
my $args = ( $self->{makemaker_args} ||= {} );
foreach my $key (keys %new_args) {
if ($makemaker_argtype{$key}) {
if ($makemaker_argtype{$key} eq 'ARRAY') {
$args->{$key} = [] unless defined $args->{$key};
unless (ref $args->{$key} eq 'ARRAY') {
$args->{$key} = [$args->{$key}]
}
push @{$args->{$key}},
ref $new_args{$key} eq 'ARRAY'
? @{$new_args{$key}}
: $new_args{$key};
}
elsif ($makemaker_argtype{$key} eq 'HASH') {
$args->{$key} = {} unless defined $args->{$key};
foreach my $skey (keys %{ $new_args{$key} }) {
$args->{$key}{$skey} = $new_args{$key}{$skey};
}
}
elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
$self->makemaker_append($key => $new_args{$key});
}
}
else {
if (defined $args->{$key}) {
warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
}
$args->{$key} = $new_args{$key};
}
}
return $args;
}
# For mm args that take multiple space-separated args,
# append an argument to the current list.
sub makemaker_append {
my $self = shift;
my $name = shift;
my $args = $self->makemaker_args;
$args->{$name} = defined $args->{$name}
? join( ' ', $args->{$name}, @_ )
: join( ' ', @_ );
}
sub build_subdirs {
my $self = shift;
my $subdirs = $self->makemaker_args->{DIR} ||= [];
for my $subdir (@_) {
push @$subdirs, $subdir;
}
}
sub clean_files {
my $self = shift;
my $clean = $self->makemaker_args->{clean} ||= {};
%$clean = (
%$clean,
FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
);
}
sub realclean_files {
my $self = shift;
my $realclean = $self->makemaker_args->{realclean} ||= {};
%$realclean = (
%$realclean,
FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
);
}
sub libs {
my $self = shift;
my $libs = ref $_[0] ? shift : [ shift ];
$self->makemaker_args( LIBS => $libs );
}
sub inc {
my $self = shift;
$self->makemaker_args( INC => shift );
}
sub _wanted_t {
}
sub tests_recursive {
my $self = shift;
my $dir = shift || 't';
unless ( -d $dir ) {
die "tests_recursive dir '$dir' does not exist";
}
my %tests = map { $_ => 1 } split / /, ($self->tests || '');
require File::Find;
File::Find::find(
sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 },
$dir
);
$self->tests( join ' ', sort keys %tests );
}
sub write {
my $self = shift;
die "&Makefile->write() takes no arguments\n" if @_;
# Check the current Perl version
my $perl_version = $self->perl_version;
if ( $perl_version ) {
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
}
# Make sure we have a new enough MakeMaker
require ExtUtils::MakeMaker;
if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
# This previous attempted to inherit the version of
# ExtUtils::MakeMaker in use by the module author, but this
# was found to be untenable as some authors build releases
# using future dev versions of EU:MM that nobody else has.
# Instead, #toolchain suggests we use 6.59 which is the most
# stable version on CPAN at time of writing and is, to quote
# ribasushi, "not terminally fucked, > and tested enough".
# TODO: We will now need to maintain this over time to push
# the version up as new versions are released.
$self->build_requires( 'ExtUtils::MakeMaker' => 6.59 );
$self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 );
} else {
# Allow legacy-compatibility with 5.005 by depending on the
# most recent EU:MM that supported 5.005.
$self->build_requires( 'ExtUtils::MakeMaker' => 6.36 );
$self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 );
}
# Generate the MakeMaker params
my $args = $self->makemaker_args;
$args->{DISTNAME} = $self->name;
$args->{NAME} = $self->module_name || $self->name;
$args->{NAME} =~ s/-/::/g;
$args->{VERSION} = $self->version or die <<'EOT';
ERROR: Can't determine distribution version. Please specify it
explicitly via 'version' in Makefile.PL, or set a valid $VERSION
in a module, and provide its file path via 'version_from' (or
'all_from' if you prefer) in Makefile.PL.
EOT
if ( $self->tests ) {
my @tests = split ' ', $self->tests;
my %seen;
$args->{test} = {
TESTS => (join ' ', grep {!$seen{$_}++} @tests),
};
} elsif ( $Module::Install::ExtraTests::use_extratests ) {
# Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness.
# So, just ignore our xt tests here.
} elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
$args->{test} = {
TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ),
};
}
if ( $] >= 5.005 ) {
$args->{ABSTRACT} = $self->abstract;
$args->{AUTHOR} = join ', ', @{$self->author || []};
}
if ( $self->makemaker(6.10) ) {
$args->{NO_META} = 1;
#$args->{NO_MYMETA} = 1;
}
if ( $self->makemaker(6.17) and $self->sign ) {
$args->{SIGN} = 1;
}
unless ( $self->is_admin ) {
delete $args->{SIGN};
}
if ( $self->makemaker(6.31) and $self->license ) {
$args->{LICENSE} = $self->license;
}
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq,
map { @$_ } # flatten [module => version]
map { @$_ }
grep $_,
($self->requires)
);
# Remove any reference to perl, PREREQ_PM doesn't support it
delete $args->{PREREQ_PM}->{perl};
# Merge both kinds of requires into BUILD_REQUIRES
my $build_prereq = ($args->{BUILD_REQUIRES} ||= {});
%$build_prereq = ( %$build_prereq,
map { @$_ } # flatten [module => version]
map { @$_ }
grep $_,
($self->configure_requires, $self->build_requires)
);
# Remove any reference to perl, BUILD_REQUIRES doesn't support it
delete $args->{BUILD_REQUIRES}->{perl};
# Delete bundled dists from prereq_pm, add it to Makefile DIR
my $subdirs = ($args->{DIR} || []);
if ($self->bundles) {
my %processed;
foreach my $bundle (@{ $self->bundles }) {
my ($mod_name, $dist_dir) = @$bundle;
delete $prereq->{$mod_name};
$dist_dir = File::Basename::basename($dist_dir); # dir for building this module
if (not exists $processed{$dist_dir}) {
if (-d $dist_dir) {
# List as sub-directory to be processed by make
push @$subdirs, $dist_dir;
}
# Else do nothing: the module is already present on the system
$processed{$dist_dir} = undef;
}
}
}
unless ( $self->makemaker('6.55_03') ) {
%$prereq = (%$prereq,%$build_prereq);
delete $args->{BUILD_REQUIRES};
}
if ( my $perl_version = $self->perl_version ) {
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
if ( $self->makemaker(6.48) ) {
$args->{MIN_PERL_VERSION} = $perl_version;
}
}
if ($self->installdirs) {
warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS};
$args->{INSTALLDIRS} = $self->installdirs;
}
my %args = map {
( $_ => $args->{$_} ) } grep {defined($args->{$_} )
} keys %$args;
my $user_preop = delete $args{dist}->{PREOP};
if ( my $preop = $self->admin->preop($user_preop) ) {
foreach my $key ( keys %$preop ) {
$args{dist}->{$key} = $preop->{$key};
}
}
my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
$self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
}
sub fix_up_makefile {
my $self = shift;
my $makefile_name = shift;
my $top_class = ref($self->_top) || '';
my $top_version = $self->_top->VERSION || '';
my $preamble = $self->preamble
? "# Preamble by $top_class $top_version\n"
. $self->preamble
: '';
my $postamble = "# Postamble by $top_class $top_version\n"
. ($self->postamble || '');
local *MAKEFILE;
open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
eval { flock MAKEFILE, LOCK_EX };
my $makefile = do { local $/; };
$makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
$makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
$makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g;
$makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
$makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
# Module::Install will never be used to build the Core Perl
# Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks
# PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist
$makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
#$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
# Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
$makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g;
# XXX - This is currently unused; not sure if it breaks other MM-users
# $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
seek MAKEFILE, 0, SEEK_SET;
truncate MAKEFILE, 0;
print MAKEFILE "$preamble$makefile$postamble" or die $!;
close MAKEFILE or die $!;
1;
}
sub preamble {
my ($self, $text) = @_;
$self->{preamble} = $text . $self->{preamble} if defined $text;
$self->{preamble};
}
sub postamble {
my ($self, $text) = @_;
$self->{postamble} ||= $self->admin->postamble;
$self->{postamble} .= $text if defined $text;
$self->{postamble}
}
1;
__END__
#line 544
PDF-FromHTML-0.33/inc/Module/Install/Scripts.pm 000644 000765 000024 00000001011 13554103471 021643 0 ustar 00audreyt staff 000000 000000 #line 1
package Module::Install::Scripts;
use strict 'vars';
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.19';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
sub install_script {
my $self = shift;
my $args = $self->makemaker_args;
my $exe = $args->{EXE_FILES} ||= [];
foreach ( @_ ) {
if ( -f $_ ) {
push @$exe, $_;
} elsif ( -d 'script' and -f "script/$_" ) {
push @$exe, "script/$_";
} else {
die("Cannot find script '$_'");
}
}
}
1;
PDF-FromHTML-0.33/inc/Module/Install/Base.pm 000644 000765 000024 00000002147 13554103471 021101 0 ustar 00audreyt staff 000000 000000 #line 1
package Module::Install::Base;
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
$VERSION = '1.19';
}
# Suspend handler for "redefined" warnings
BEGIN {
my $w = $SIG{__WARN__};
$SIG{__WARN__} = sub { $w };
}
#line 42
sub new {
my $class = shift;
unless ( defined &{"${class}::call"} ) {
*{"${class}::call"} = sub { shift->_top->call(@_) };
}
unless ( defined &{"${class}::load"} ) {
*{"${class}::load"} = sub { shift->_top->load(@_) };
}
bless { @_ }, $class;
}
#line 61
sub AUTOLOAD {
local $@;
my $func = eval { shift->_top->autoload } or return;
goto &$func;
}
#line 75
sub _top {
$_[0]->{_top};
}
#line 90
sub admin {
$_[0]->_top->{admin}
or
Module::Install::Base::FakeAdmin->new;
}
#line 106
sub is_admin {
! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
}
sub DESTROY {}
package Module::Install::Base::FakeAdmin;
use vars qw{$VERSION};
BEGIN {
$VERSION = $Module::Install::Base::VERSION;
}
my $fake;
sub new {
$fake ||= bless(\@_, $_[0]);
}
sub AUTOLOAD {}
sub DESTROY {}
# Restore warning handler
BEGIN {
$SIG{__WARN__} = $SIG{__WARN__}->();
}
1;
#line 159