File Coverage

blib/lib/Games/ScottAdams/File.pm

Criterion	Covered	Total	%
statement	27	56	48.2
branch	8	16	50.0
condition	0	4	0.0
subroutine	5	11	45.4
pod	0	8	0.0
total	40	95	42.1

# $Id: File.pm,v 1.3 2006/11/03 20:59:19 mike Exp $

# File.pm - a cleverer IO::File-alike that does pushback

package Games::ScottAdams::File;
use strict;

# This module simply implements a slightly cleverer IO::File-alike
# that remembers the filename, maintains a notion of the current line
# number (useful for diagnostics) and can maintain an arbitrary number
# of pushback lines.  It clearly has wider applicability outside of
# the Scott Adams module and should probably not be a
# Games::ScottAdams class.

use IO::File;


sub new {
    my $class = shift();
    my($filename) = @_;

    my $f = new IO::File("<$filename")
	or return undef;

    return bless {
	f => $f,
	filename => $filename,
	linenumber => 0,
	pushback => [],
	buf => "",		# for getint() and getstring() only
    }, $class;
}


sub getline {
    my $this = shift();
    my($trim) = @_;

    my $line = pop @{ $this->{pushback} };
    if (!defined $line) {
      AGAIN:
	$this->{linenumber}++;
	$line = $this->{f}->getline();
	return undef if !defined $line;
    }

    if ($trim) {
	$line =~ s/#.*//;
	$line =~ s/\s+$//;
	goto AGAIN if $line =~ /^$/;
    }

    return $line;
}


sub ungetline {
    my $this = shift();
    my($line) = @_;

    push @{ $this->{pushback} }, $line;
}


# Calls to getint() and getstring() may be freely intermixed, but
# won't play nice if mixed with getline() and ungetline() calls.

sub getint {
    my $this = shift();
    $this->_refresh();
    die "getint($this) on non-int buffer '" . $this->{buf} . "'"
	if $this->{buf} !~ /^\d/;

    $this->{buf} =~ s/(\d+)//;
    return $1;
}

sub getstring {
    my $this = shift();
    $this->_refresh();

    $this->{buf} =~ s/^[""]//
	or die "getstring($this) on non-string buffer '" . $this->{buf} . "'";

    my $string = "";
    while ($this->{buf} !~ /[""]/) {
	$string .= $this->{buf};
	$this->{buf} = $this->getline();
    }

    $this->{buf} =~ s/^(.*?)[""]//
	or die "can't happen";

    $string .= $1;
    $string =~ s/[``"]/"/g;
    return $string;
}

# PRIVATE to getint() and getstring()
sub _refresh {
    my $this = shift();
    while ($this->{buf} =~ /^\s*$/) {
	$this->{buf} = $this->getline();
    }
    $this->{buf} =~ s/^\s*//;
}


sub warn {
    my $this = shift();

    print STDERR $this->{filename}, ':', $this->{linenumber}, ': ',
	'WARNING: ', @_, "\n";
}


sub fatal {
    my $this = shift();

    my $filename = $this->{filename} || '[unknown]';
    my $linenumber = $this->{linenumber} || '[unknown]';
    print STDERR $filename, ':', $linenumber, ': ERROR: ', @_, "\n";
    exit 1;
}


sub close {
    my $this = shift();

    $this->{f}->close();
}


1;