File Coverage

blib/lib/PostScript/FontInfo.pm

Criterion	Covered	Total	%
statement	58	69	84.0
branch	12	28	42.8
condition	2	6	33.3
subroutine	11	15	73.3
pod	8	8	100.0
total	91	126	72.2

# RCS Status      : $Id: FontInfo.pm,v 1.12 2003-10-23 14:12:27+02 jv Exp $
# Author          : Johan Vromans
# Created On      : December 1998
# Last Modified By: Johan Vromans
# Last Modified On: Thu Oct 23 14:12:25 2003
# Update Count    : 57
# Status          : Released

################ Module Preamble ################

package PostScript::FontInfo;

use strict;

BEGIN { require 5.005; }

use IO qw(File);

use vars qw($VERSION);
$VERSION = "1.05";

sub new {
    my $class = shift;
    my $font = shift;
    my (%atts) = (error => 'die',
		  verbose => 0, trace => 0, debug => 0,
		  @_);
    my $self = { file => $font };
    bless $self, $class;

    return $self unless defined $font;

    $self->{debug}   = $atts{debug};
    $self->{trace}   = $self->{debug} || $atts{trace};
    $self->{verbose} = $self->{trace} || $atts{verbose};

    my $error = lc($atts{error});
    $self->{die} = sub {
	die(@_)     if $error eq "die";
	warn(@_)    if $error eq "warn";
    };

    eval {
	$self->_loadinfo;
    };

    if ( $@ ) {
	$self->_die($@);
	return undef;
    }

    $self;
}

sub FileName	{ my $self = shift; $self->{file};    }
sub FontName	{ my $self = shift; $self->{name};    }
sub FullName	{ my $self = shift; $self->{fullname};}
sub InfoData	{ my $self = shift; $self->{data};    }
sub FontFamily	{ my $self = shift; $self->{family};  }
sub Version	{ my $self = shift; $self->{version}; }
sub PCFileNamePrefix { my $self = shift; $self->{pcprefix}; }

sub _loadinfo ($) {

    my ($self) = shift;

    my $data;			# inf data

    eval {			# so we can use die

	my $fn = $self->{file};
	my $fh = new IO::File;	# font file
	my $sz = -s $fn;	# file size

	$fh->open ($fn) || $self->_die("$fn: $!\n");
	print STDERR ("$fn: Loading INF file\n") if $self->{verbose};

	# Read in the inf data.
	my $len = 0;
	while ( $fh->sysread ($data, 32768, $len) > 0 ) {
	    $len = length ($data);
	}
	$fh->close;
	print STDERR ("Read $len bytes from $fn\n") if $self->{trace};
	$self->_die("$fn: Expecting $sz bytes, got $len bytes\n") unless $sz == $len;

	# Normalise line endings.
	$data =~ s/\015\012?/\n/g;

	if ( $data !~ /^FontName\s+\(\S+\)$/m ) {
	    $self->_die("$fn: Not a recognizable INF file\n");
	}

    };

    $self->{name}    = $1 if $data =~ /^FontName\s+\((\S+)\)$/mi;
    $self->{fullname}= $1 if $data =~ /^FullName\s+\((.+?)\)$/mi;
    $self->{family}  = $1 if $data =~ /^FamilyName\s+\((.+)\)$/mi;
    $self->{version} = $1 if $data =~ /^Version\s+\((.+)\)$/mi;
    $self->{pcprefix}= lc($1)
      if $data =~ /^PCFileNamePrefix\s+\((.+)\)$/mi;
    $self->{data}    = $data;

    $self;
}

sub _die {
    my ($self, @msg) = @_;
    $self->{die}->(@msg);
}

1;

__END__