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__