File Coverage

571
572						=cut
573
574						sub XML_start
575						{
576	0			0	1	my ($self, $context, $tag, %attrs) = @_;
577	0					my ($name, $type, $t);
578
579	0	0				if ($tag eq 'font')
		0
580	0					{ $context->{'tree'}[-1] = $self; }
581						elsif ($tag eq 'table')
582						{
583	0					$name = $attrs{'name'};
584	0	0				unless (defined $self->{$name})
585						{
586	0		0			$type = $tables{$name} \|\| 'PDF::API3::Compat::API2::Basic::TTF::Table';
587	0					$t = $type;
588	0	0				if ($^O eq "MacOS")
589	0					{ $t =~ s/^\|::/:/oig; }
590						else
591	0					{ $t =~ s\|::\|/\|oig; }
592	0					require "$t.pm";
593	0					$self->{$name} = $type->new('PARENT' => $self, 'NAME' => $name, 'read' => 1);
594						}
595	0					$context->{'receiver'} = ($context->{'tree'}[-1] = $self->{$name});
596						}
597	0					$context;
598						}
599
600
601						sub XML_end
602						{
603	0			0	0	my ($self) = @_;
604	0					my ($context, $tag, %attrs) = @_;
605	0					my ($i);
606
607	0	0	0			return undef unless ($tag eq 'table' && $attrs{'name'} eq 'loca');
608	0	0	0			if (defined $context->{'glyphs'} && $context->{'glyphs'} ne $self->{'loca'}{'glyphs'})
609						{
610	0					for ($i = 0; $i <= $#{$context->{'glyphs'}}; $i++)
	0
611	0	0				{ $self->{'loca'}{'glyphs'}[$i] = $context->{'glyphs'}[$i] if defined $context->{'glyphs'}[$i]; }
612	0					$context->{'glyphs'} = $self->{'loca'}{'glyphs'};
613						}
614	0					return undef;
615						}
616
617						=head2 $f->update
618
619						Sends update to all the tables in the font and then resets all the isDirty
620						flags on each table. The data structure in now consistent as a font (we hope).
621
622						=cut
623
624						sub update
625						{
626	0			0	1	my ($self) = @_;
627
628	0			0		$self->tables_do(sub { $_[0]->update; });
	0
629
630	0					$self;
631						}
632
633						=head2 $f->dirty
634
635						Dirties all the tables in the font
636
637						=cut
638
639						sub dirty
640	0			0	1	{ $_[0]->tables_do(sub { $_[0]->dirty; }); $_[0]; }
	0			0
	0
641
642						=head2 $f->tables_do(&func)
643
644						Calls &func for each table in the font. Calls the table in alphabetical sort
645						order as per the order in the directory:
646
647						&func($table, $name);
648
649						=cut
650
651						sub tables_do
652						{
653	0			0	1	my ($self, $func) = @_;
654	0					my ($t);
655
656	0					foreach $t (sort grep {length($_) == 4} keys %$self)
	0
657	0					{ &$func($self->{$t}, $t); }
658	0					$self;
659						}
660
661
662						=head2 $f->release
663
664						Releases ALL of the memory used by the TTF font and all of its component
665						objects. After calling this method, do B expect to have anything left in
666						the C object.
667
668						B, that it is important that you call this method on any
669						C object when you wish to destruct it and free up its memory.
670						Internally, we track things in a structure that can result in circular
671						references, and without calling 'C' these will not properly get
672						cleaned up by Perl. Once you've called this method, though, don't expect to be
673						able to do anything else with the C object; it'll have B
674						internal state whatsoever.
675
676						B As part of the brute-force cleanup done here, this method
677						will throw a warning message whenever unexpected key values are found within
678						the C object. This is done to help ensure that any unexpected
679						and unfreed values are brought to your attention so that you can bug us to keep
680						the module updated properly; otherwise the potential for memory leaks due to
681						dangling circular references will exist.
682
683						=cut
684
685						sub release
686						{
687	0			0	1	my ($self) = @_;
688
689	0	0				return($self) unless(ref $self);
690						# delete stuff that we know we can, here
691
692	0					my @tofree = map { delete $self->{$_} } keys %{$self};
	0
	0
693
694	0					while (my $item = shift @tofree)
695						{
696	0					my $ref = ref($item);
697	0	0				if (UNIVERSAL::can($item, 'release'))
		0
		0
698	0					{ $item->release(); }
699						elsif ($ref eq 'ARRAY')
700	0					{ push( @tofree, @{$item} ); }
	0
701						elsif (UNIVERSAL::isa($ref, 'HASH'))
702	0					{ release($item); }
703						}
704
705						# check that everything has gone - it better had!
706	0					foreach my $key (keys %{$self})
	0
707	0					{ warn ref($self) . " still has '$key' key left after release.\n"; }
708						}
709
710						1;
711
712						=head1 BUGS
713
714						Bugs abound aplenty I am sure. There is a lot of code here and plenty of scope.
715						The parts of the code which haven't been implemented yet are:
716
717						=over 4
718
719						=item Post
720
721						Version 4 format types are not supported yet.
722
723						=item Cmap
724
725						Format type 2 (MBCS) has not been implemented yet and therefore may cause
726						somewhat spurious results for this table type.
727
728						=item Kern
729
730						Only type 0 & type 2 tables are supported (type 1 & type 3 yet to come).
731
732						=item TTC
733
734						The current PDF::API3::Compat::API2::Basic::TTF::Font::out method does not support the writing of TrueType
735						Collections.
736
737						=back
738
739						In addition there are weaknesses or features of this module library
740
741						=over 4
742
743						=item *
744
745						There is very little (or no) error reporting. This means that if you have
746						garbled data or garbled data structures, then you are liable to generate duff
747						fonts.
748
749						=item *
750
751						The exposing of the internal data structures everywhere means that doing
752						radical re-structuring is almost impossible. But it stop the code from becoming
753						ridiculously large.
754
755						=back
756
757						Apart from these, I try to keep the code in a state of "no known bugs", which
758						given the amount of testing this code has had, is not a guarantee of high
759						quality, yet.
760
761						For more details see the appropriate class files.
762
763						=head1 AUTHOR
764
765						Martin Hosken Martin_Hosken@sil.org
766
767						Copyright Martin Hosken 1998.
768
769						No warranty or expression of effectiveness, least of all regarding anyone's
770						safety, is implied in this software or documentation.
771
772						=head2 Licensing
773
774						The Perl TTF module is licensed under the Perl Artistic License.
775