File Coverage

blib/lib/Mxpress/PDF.pm

Criterion	Covered	Total	%
statement	429	472	90.8
branch	48	90	53.3
condition	32	86	37.2
subroutine	41	41	100.0
pod			n/a
total	550	689	79.8

use v5.18;
use strict;
use warnings;

package Mxpress::PDF {
	our $VERSION = '0.01';
	use MooX::Pression (
		version	=> '0.01',
		authority => 'cpan:LNATION',
	);
	use Colouring::In;
	use constant mm => 25.4 / 72;
	use constant pt => 1;
	class File () {
		has file_name (type => Str, required => 1);
		has pdf (required => 1, type => Object);
		has pages (required => 1, type => ArrayRef);
		has page (type => Object);
		has page_args (type => HashRef);
		method add_page (Map %args) {
			my $page = $self->FACTORY->page(
				$self->pdf,
				page_size => 'A4',
				%{ $self->page_args },
				%args,
			);
			push @{$self->pages}, $page;
			$self->page($page);
			$self->boxed->add( fill_colour => $page->background ) if $page->background;
			$self;
		}
		method save {
			$self->pdf->saveas();
			$self->pdf->end();
		}
	}
	class Page {
		with Utils;
		has page_size (type => Str, required => 1);
		has background (type => Str);
		has page_num (type => Num);
		has current (type => Object);
		has is_rotated (is => 'rw');
		has x (is => 'rw', type => Num);
		has y (is => 'rw', type => Num);
				has w (is => 'rw', type => Num);
		has h (is => 'rw', type => Num);
		factory page (Object $pdf, Map %args) {
	 		my $page = $pdf->page();
			$page->mediabox($args{page_size});
			my ($blx, $bly, $trx, $try) = $page->get_mediabox;
			my $new_page = $class->new(
				current => $page,
				($args{is_rotated} ? (
					x => 0,
					w => $try,
					h => $trx,
					y => $trx,
				) : (
					x => 0,
					w => $trx,
					h => $try,
					y => $try,
				)),
				%args
			);
			return $new_page;
		}
		method rotate {
			my ($h, $w) = ($self->h, $self->w);
			$self->current->mediabox(
				0,
				0,
				$self->w($h),
				$self->h($self->y($w))
			);
			$self->is_rotated(!$self->is_rotated);
			return $self;
		}
	}
	role Utils {
		method parse_position (ArrayRef $position) {
			my ($x, $y, $w, $h) = map {
				$_ =~ m/[^\d\.]/ ? $_ : $_/mm
			} @{$position};
			$x = $self->page->x + $self->padding unless defined $x;
			$y = $self->page->y unless defined $y;
			$y = $self->page->y if $y =~ m/current/;
			$w = $self->page->w - ($x == $self->padding ? $self->padding * 2 : $x + $self->padding) unless defined $w;
			$h = $self->page->y - 10/mm unless defined $h;
			return ($x, $y, $w, $h);
		}
		method valid_colour (Str $css) {
			return Colouring::In->new($css)->toHEX(1);
		}
	}
	class Plugin {
		with Utils;
		has file ( is => rw, type => Object );
		has page ( required => 1, is => rw, type => Object );
		method set_page (Object $page) {
			$self->page($page);
		}
		method set_attrs (Map %args) {
			$self->can($_) && $self->$_($args{$_}) for keys %args;
		}
		class +Font {
			has colour ( is => 'rw', type => Str );
			has size ( is => 'rw', type => Num );
			has family ( is => 'rw', type => Str );
			has loaded ( is => 'rw', type => HashRef );
			factory font (Object $file, Map %args) {
				return $class->new(
					file => $file,
					page => $file->page,
					colour => $file->page->valid_colour($args{colour} || '#000'),
					size => 9/pt,
					family => 'Times',
					%args
				);
			}
			method load () { $self->find($self->family); }
			method find (Str $family, Str $enc?) {
				my $loaded = $self->loaded;
				unless ($loaded->{$family}) {
					$loaded->{$family} = $self->file->pdf->corefont($family, -encoding => $enc || 'latin1');
					$self->loaded($loaded);
				}
				return $loaded->{$family};
			}
		}
		class +Boxed {
			has fill_colour ( is => 'rw', type => Str );
			has position ( is => 'rw', type => ArrayRef );
			has padding ( is => 'rw', type => Num );
			factory boxed (Object $file, Map %args) {
				return $class->new(
					page => $file->page,
					fill_colour => $file->page->valid_colour($args{fill_colour} || '#fff'),
					padding => $args{padding} || 0
				);
			}
			method add (Map %args) {
				$self->set_attrs(%args);
				my $box = $self->page->current->gfx;
				my $boxed = $box->rect($self->parse_position($self->position || [0, 0, $self->page->w * mm, $self->page->h * mm]));
				$boxed->fillcolor($self->fill_colour);
				$boxed->fill;
				return $self->page;
			}
		}
		class +Text {
			has padding ( is => 'rw', type => Num );
			has font ( is => 'rw', type => Object );
			has paragraph_space ( is => 'rw', type => Num );
			has first_line_indent ( is => 'rw', type => Num );
			has first_paragraph_indent ( is => 'rw', type => Num );
			has align ( is => 'rw', type => Str ); #enum
			has margin_top ( is => 'rw', type => Num );
			has margin_bottom ( is => 'rw', type => Num );
			has indent ( is => 'rw', type => Num );
			has next_page;
			factory text (Object $file, Map %args) {
				$class->generic_new($file, %args);
			}
			method generic_new (Object $file, Map %args) {
				return $class->new({
					file => $file,
					page => $file->page,
					next_page => do { method {
						my $self = shift;
						$file->add_page;
						$self->set_page($file->page);
						return $file->page;
					} },
					padding => $args{padding} ? $args{padding}/mm : 0,
					align => 'left',
					font => $class->FACTORY->font(
						$file,
						%{$args{font}}
					)
				});
			}
			method add (Str $string, Map %args) {
				$self->set_attrs(%args);
				my ($xpos, $ypos);
				my @paragraphs = split /\n/, $string;
				# instantiate a new pdf text object
				my $text = $self->page->current->text;
				$text->font( $self->font->load, $self->font->size );
				$text->fillcolor( $self->font->colour );
				my ($total_width, $space_width, %width) = $self->_calculate_widths($string, $text);
				my ($l, $x, $y, $w, $h) = (
					$self->font->size,
					$self->parse_position($args{position} || [])
				);
				$ypos = $y - $l;
				$ypos -= $self->margin_top/mm if $self->margin_top;
				my ($fl, $fp, @paragraph) = (1, 1, split ( / /, shift(@paragraphs) || '' ));
				# while we have enough height to add a new line
				while ($ypos >= $y - $h) {
					unless (@paragraph) {
						last unless scalar @paragraphs;
						@paragraph = split( / /, shift(@paragraphs) );
						$ypos -= $self->paragraph_space/mm if $self->paragraph_space;
						last unless $ypos >= $y - $h;
						($fl, $fp) = (1, 0);
					}
					$xpos = $x;
					my @line = ();
		 			my $line_width = 0;
					($xpos, $line_width) = $self->_set_indent($xpos, $line_width, $fl, $fp);
					while (@paragraph and ($line_width + (scalar(@line) * $space_width) + $width{$paragraph[0]}) < $w) {
						$line_width += $width{$paragraph[0]};
						push @line, shift(@paragraph);
					}
					my ($wordspace, $align);
					if ($self->align eq 'fulljustify' or $self->align eq 'justify' and @paragraph) {
						if (scalar(@line) == 1) {
							@line = split( //, $line[0] );
						}
						$wordspace = ($w - $line_width) / (scalar(@line) - 1);
						$align = 'justify';
					} else {
						$align = ($self->align eq 'justify') ? 'left' : $self->align;
						$wordspace = $space_width;
					}
					$line_width += $wordspace * (scalar(@line) - 1);
					if ($align eq 'justify') {
						foreach my $word (@line) {
							$text->translate($xpos, $ypos);
							$text->text($word);
							$xpos += ($width{$word} + $wordspace) if (@line);
						}
					} else {
						if ($align eq 'right') {
							$xpos += $w - $line_width;
						} elsif ($align eq 'center') {
							$xpos += ($w/2) - ($line_width / 2);
						}
						$text->translate($xpos, $ypos);
						$text->text(join(' ', @line));
					}
					$ypos -= $l if @paragraph;
					$fl = 0;
				}
				unshift( @paragraphs, join( ' ', @paragraph ) ) if scalar(@paragraph);
				$ypos -= $self->margin_bottom/mm if $self->margin_bottom;
				$self->page->y($ypos);
				if (scalar @paragraphs && $self->next_page) {
					my $next_page = $self->next_page->($self);
					return $self->add(join("\n", @paragraphs), %args);
				}
				return $self->file;
			}
			method _set_indent (Num $xpos, Num $line_width, Num $fl, Num $fp) {
	 			if ($fl && $self->first_line_indent) {
					$xpos += $self->first_line_indent;
					$line_width += $self->first_line_indent;
				} elsif ($fp && $self->first_paragraph_indent) {
					$xpos = $self->first_paragraph_indent;
					$line_width = $xpos;
				} elsif ($self->indent) {
					$xpos += $self->indent;
					$line_width += $self->indent
				}
				return ($xpos, $line_width);
			}
			method _calculate_widths (Str $string, Object $text) {
				my @words = split /\s+/, $string;
				# calculate width of space
				my $space_width = $text->advancewidth(' ');
				# calculate the width of each word
				my %width = ();
				my $total_width = 0;
				foreach (@words) {
					next if exists $width{$_};
					$width{$_} = $text->advancewidth($_);
					$total_width += $width{$_} + $space_width;
				}
				return ($total_width, $space_width, %width);
			}
		}
		class +Title {
			extends Plugin::Text;
			factory title (Object $file, Map %args) {
				$args{font}->{size} ||= 50/pt;
				$class->generic_new($file, %args);
			}
		}
		class +Subtitle {
			extends Plugin::Text;
			factory subtitle (Object $file, Map %args) {
				$args{font}->{size} ||= 25/pt;
				$class->generic_new($file, %args);
			}
		}
	}
	class Factory {
		use PDF::API2;
		factory new_pdf (Str $name, Map %args) {
			my @plugins = (qw/font boxed text title subtitle/, ($args{plugins} ? @{$args{plugins}} : ()));
			# TODO /o\
			my $spec = Mxpress::PDF::File->_generate_package_spec;
			for my $p (@plugins) {
				my $meth = "_store_${p}";
				$spec->{has}->{$meth} = { is => 'rw' };
				$spec->{can}->{$p} = {
					named => 0,
					signature => [],
					caller => 'Mxpress::PDF',
					optimize => 0,
					code => sub {
						my $class = $_[0]->$meth;
						if (!$class) {
							$class = $factory->$p($_[0], %{$args{$p}});
							$_[0]->$meth($class)
						} else {
							$class->set_page($_[0]->page);
						}
						return $class;
					}
				};
			}
			{ no strict; no warnings; *Mxpress::PDF::File::_generate_package_spec = sub { return $spec } };
			my $file = Mxpress::PDF::File->generate_package();
			return $file->new(
				file_name => $name,
				pages => [],
				page_num => 0,
				page_size => 'A4',
				page_args => $args{page} || {},
				pdf => PDF::API2->new( -file => sprintf("%s.pdf", $name)),
			);
		}
	}
}

1;

__END__

=head1 NAME

Mxpress::PDF - The great new Mxpress::PDF!

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.01';

=head1 SYNOPSIS

	use Mxpress::PDF;

	Mxpress::PDF->new_pdf('test-pdf',
		page => { background => '#000' },
		title => { font => { colour => '#f00' } },
		subtitle => { padding => 5, font => { colour => '#0ff' } },
		text => { padding => 5, font => { colour => '#fff' } }
	)->add_page->title->add(
		'This is a title',
		position => [5, 297]
	)->subtitle->add(
		'This is a subtitle.'
	)->text->add(
		'This is some text.'
	)->save();

=head2 Note

experimental.

=head1 AUTHOR

LNATION, C<< <thisusedtobeanemail at gmail.com> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-mxpress-pdf at rt.cpan.org>, or through
the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Mxpress-PDF>. I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

	perldoc Mxpress::PDF

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Mxpress-PDF>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Mxpress-PDF>

=item * CPAN Ratings

L<https://cpanratings.perl.org/d/Mxpress-PDF>

=item * Search CPAN

L<https://metacpan.org/release/Mxpress-PDF>

=back

=head1 ACKNOWLEDGEMENTS

=head1 LICENSE AND COPYRIGHT

This software is Copyright (c) 2020 by LNATION.

This is free software, licensed under:

	The Artistic License 2.0 (GPL Compatible)

=cut

1; # End of Mxpress::PDF