# -*- perl -*-
#
# $Id: Tokenizer.pm,v 1.2 1995/09/03 04:15:53 qjb Exp $
# $Source: /home/qjb/source/perl/modules/RCS/Tokenizer.pm,v $
# $Author: qjb $
#

require 5.000;
use strict qw(refs subs);

package Tokenizer;
$package = "Tokenizer";

# Field names
$f_filename = "filename";
$f_comment = "comment";
$f_tok_chars = "tok_chars";
$f_filehandle = "filehandle";
$f_line = "line";
$f_tokens = "tokens";

# Static Variables

# Routines

sub new
{
    shift;
    my $rep = +{$package => {} };

    if (! ((@_ >= 1) && (@_ <= 3)))
    {
	die "$package: new $package(filename[, comment_char[, tok_chars]])\n";
    }

    local($filename, $comment, $tok_chars) = @_;
    $comment = "" unless defined($comment);
    $tok_chars = "" unless defined($tok_chars);
    local(*F);
    open(F, "<$filename") ||
	die "$package: can't open $filename to read: $!\n";

    $rep->{$package}{$f_filename} = $filename;
    $rep->{$package}{$f_comment} = $comment;
    $rep->{$package}{$f_tok_chars} = $tok_chars;
    $rep->{$package}{$f_filehandle} = *F;
    $rep->{$package}{$f_line} = 0;
    $rep->{$package}{$f_tokens} = [];

    bless $rep;
}

sub next
{
    my $rep = shift;
    local($tokens) = $rep->{$package}{$f_tokens};
    local($comment) = $rep->{$package}{$f_comment};
    local($tok_chars) = $rep->{$package}{$f_tok_chars};
    local(*F) = $rep->{$package}{$f_filehandle};
    while (@{$tokens} == 0)
    {
	# Don't say local($line) = <F>; -- this is array context....
	local($line);
	$line = <F>;
	$rep->{$package}{$f_line} = $.;
	if (defined($line))
	{
	    chomp($line);
	    if ($comment)
	    {
		$line =~ s/$comment.*//;
	    }
	    $line =~ s/^\s+//;
	    @{$tokens} = split(/\s+/, $line);
	}
	else
	{
	    close(F);
	    return undef;
	}
    }

    local($t) = shift(@{$tokens});
    if (($tok_chars ne "") && ($t =~ m/^([^$tok_chars]*)([$tok_chars])(.*)$/))
    {
	unshift(@{$tokens}, $3) if ($3 ne "");
	unshift(@{$tokens}, $2);
	unshift(@{$tokens}, $1) if ($1 ne "");
	shift(@{$tokens});
    }
    else
    {
	$t;
    }
}

sub line
{
    my $rep = shift;
    $rep->{$package}{$f_line};
}

sub test
{
    shift;
    local($t, $a);
    $t = new Tokenizer(@_);
    while (defined ($a = $t->next()))
    {
	printf "%d: %s\n", $t->line(), $a;
    }
}

1;