#!/usr/bin/perl

my $VERSION = "0.5.3";

# Ok, some common programming sense first.
use strict;
use warnings;
use Getopt::Std;    # for command line arguments

sub assign;
sub parseValue;
sub parsePosition;
sub parseOptionals;
sub rawsymbols;
sub compareArray;
sub uniq;
sub compileRule;
sub chopIntoSymbols;
sub matchPosition;
sub applyRule;
sub output;

sub HELPMESSAGE;
sub DEBUG;

$| = 1; #autoflush

# get those args
my %clarg;
getopts("ucHl:r:o:h:d:", \%clarg);


# And check their values, too
if (!$clarg{l}) {
    print "Didn't get lexicon file.\n";
    HELPMESSAGE 1;
} elsif (!$clarg{r}) {
    print "Didn't get rules file.\n";
    HELPMESSAGE 1;
}

if ($clarg{H}) {
    $clarg{h} ||= "\\n\\t( < \\o )\\t\\c";
} else {
    $clarg{h} ||= "\\n\\t\\c";
}

$clarg{d} = int($clarg{d}||0);

if ($clarg{d} < 0 || $clarg{d} > 3) {
    die "Debug level not valid. Specify a level from 0 to 3.\n";
}

#my $IOlayer = ":encoding(UTF-8)";
my $IOlayer = ":utf8";
$IOlayer = "" if $clarg{u};


my %var = ();   # Hold the variable array refs
my @rule = ();  # Hold the rule hash refs
my @global_polygraphs = (); # Hold all found polygraphs


# Open the output file
my $outFH;
if (! $clarg{o}) {
    $outFH = \*STDOUT;
} else {
    unless(open $outFH, ">$IOlayer", $clarg{o}) {
        die "Could not open output file ($clarg{o}): $!\n";
    }
}
if ($IOlayer) {
    binmode $outFH, "$IOlayer";
    binmode STDOUT, "$IOlayer";
}


# Read and compile the rules file
my $ruleset = file->new($clarg{r}, $IOlayer) or die "Could not read ruleset file ($clarg{r}): $!\n";
while (my $line = $ruleset->nextline) {


    # Reformat the line so that it's a little more tidy
    $line =~ s/^\s+//;
    $line =~ s/\s+$//;

    # What kind of line is it?

    if ($line =~ m/^\#/ || !$line) {                        # Comment or whiteline
        next;                                               # That was too easy

    } elsif ($line =~ m/^([A-Z][A-Z0-9]*)\s*=\s*(.*)$/) {   # Assignment
        assign $1, $2;

    } elsif ($line =~ m!/.*/!) {                            # Rule
        push @rule, compileRule($line);
    } else {
        warn "Unrecognized line in rules file, line $. ($line)\n";
    }
}


# Woaw, we made it to here?
# Then the rules file must be okay. At least syntactically.

# Let's sort out the global polygraphs

@global_polygraphs = sort {length $b <=> length $a} uniq @global_polygraphs;

# So... time to open and read the lex file
my $lexfile = file->new($clarg{l}, $IOlayer) or die "Could not read lexicon file ($clarg{l}): $!\n";

# Read the lexicon word for word, apply all rules on each word, then write the
# new word away

while (my $word = $lexfile->nextline) {
    my $_word = $word;
    $word =~ s/(^\s+|\s+$)//g;
    if ($word eq "" || $word =~ m/^\#/) {
        output $_word;
        next;
    }
    my $comment;
    ($word, $comment) = $word =~ m/^(.+?)(?:\s*(\#.+))?$/;
    $comment ||= "";    # prevent undefinedness
    my $was = $word;
    for my $rule (@rule) {
        $word = applyRule($rule, $word);
    }
    my $template = $clarg{h};
    $template =~ s/\\n/$word/g;
    $template =~ s/\\o/$was/g;
    $template =~ s/\\c/$comment/g;
    $template =~ s/\\t/\t/g;
    output "$template\n";
}

exit; # <-------- woohoo see that? We made it to the end








sub assign {
    my ($var, $value) = @_;

    if (exists $var{$var}) {
        warn "Warning: you already assigned to $var at line $.\n";
    }

    $var{$var} = [my @symbols = parseValue($value, "assignment")];

    for my $s (@symbols) {
        push @global_polygraphs, $s if length($s) > 1;
    }
}



sub parseValue {
    # Parse values
    # That is, substitute variable names with their values and also
    # turn the thing into symbols (monograph vs polygraph, that kind of shit)
    #
    # Returns an array ref, where each element is one symbol - kinda...
    # How is that for niftehness!

    my $value = shift;
    my $where = shift;

    my @options = ();

    for my $s (rawsymbols($value, $where)) {
        if ($s =~ m/^([A-Z]|<[A-Z][A-Z0-9]*>)$/) {
            my $vname = $1;
            $vname =~ s/(^<|>$)//g;
            if (exists $var{$vname}) {
                push @options, @{$var{$vname}};
            } else {
                warn "Warning: attempt to include undefined variable $vname in $where at line $.\n";
            }

        } elsif ($s =~ m/^\[(.+)\]$/) {
            my $polygraph = $1;

            push @options, parsePosition($polygraph, $where);
            # this is a little bit cheesy since we're not parsing
            # a Position but parsePosition does exactly what needs
            # to be done

        } else {
            push @options, $s;
        }
    }

#    for (@options) {
#        if (length $_ > 1) {
#            push @global_polygraphs, $_;
#        }
#    }


    return @options;
}



sub parsePosition {
    # Parse positions - O RLY?
    # YA RLY. It does variable substitution and while it is at it, it creates an
    # array of all possible positions.
    # That is... all raw characters in a position string are just considered parts of
    # polygraphs, but symbols in variables are dealt with accordingly
    # So for each symbol in a variable, another possible option exists.
    # Well, this subroutine just creates a list with all those options
    # And as a little present it returns it too.

    
    my $position = shift;
    my $where = shift;

    my @options = ("");

    my $varname = ""; # name of the variable that's currently going to be included
    my $parsevar = 0; # flag to determine if we should parse a variable's value into it

    my $lastliteral = "";
    
    my @c = split(//, $position);
    shift @c;

    for my $c (split //, $position) {
        my $nextc = shift @c || "";
        if ($varname) {
            if ($c ne '>') {
                $varname .= $c;
                next;
            } else {
                $varname =~ s/(^<|>$)//g;
                $parsevar = 1;
            }
        } elsif ($c eq '<') {
            $varname = '<';
            next;

        } elsif ($c =~ m/[A-Z]/) {
            $varname = $c;
            $parsevar = 1;

        } elsif ($c eq "+") {
            # ignore pluses here - handle them when parsing variables
            next;
        } elsif ($c eq ">") {
            die "Syntax error: unmatched right angle '>' bracket in $where at line $.\n";
        } else {
            $_ .= $c for @options;    
        }


        if ($parsevar) {
            $parsevar = 0;

            if ($varname !~ m/^[A-Z][A-Z0-9]*$/) {
                die "Syntax error: invalid variable name in $where at line $.\n";
            }

            if (exists $var{$varname}) {
                my @symbols = @{$var{$varname}};

                my @newoptions = ();
                for my $o (@options) {
                    for my $varsymbol (@symbols) {
                        my $_v = $varsymbol;

                        if ($nextc eq "+") {
                            $_v = "$_v$_v";
                            my $cID = 0;

                            while ( ($c[$cID]||"") eq "+") {    # block added for v0.2
                                $cID++;                         # to support multiple
                                $_v .= $varsymbol;              # pluses
                            }
                        }

                        push @newoptions, "$o$_v"
                    }
                }
                
                
                @options = @newoptions;

            } else {
                warn "Warning: attempt to include undefined variable $varname in $where at line $.\n";
            }
            $varname = "";
        }
    }

            
    if ($varname) {
        die "Syntax error: unmatched left angle bracket '<' in $where at $.\n";
    }

#    my @polygraphs = ();
#    for my $_o (@options) {
#        my $o = $_o;
#        $o =~ s/(^\#|\#$)//g;
#        my ($before, $after) = split(/_/, $o, 2);
#        push @polygraphs, cachePolygraphs $before if $before;
#        push @polygraphs, cachePolygraphs $after if $after;
#    }


    # Parse optionals into the options
    # Confusing? Hmm, yeah... :(
    my @optional_options = ();

    for (@options) {
        push @optional_options, parseOptionals $_, $where;
    }

    @options = @optional_options;
    

    
    # Just make sure we put the polygraphs in @global_polygraphs
#    for my $_o (@options) {
#        my $o = $_o;
#        $o =~ s/(^\#|\#$)//g;
#        my ($before, $after) = split(/_/, $o, 2);

#        push @global_polygraphs, $before if length($before|"") > 1;
#        push @global_polygraphs, $after if length($after||"") > 1;
#    }
    
    return @options;

};


sub parseOptionals {
    my $string = shift;
    my $where = shift;

    DEBUG 3, "-- parseOptionals: parsing optionals in '$string' ($where) --";

    my @options = ("");

    my $optional_offset = -1;  # contains OFFSET of "("

    my $nested = 0;     # is there a "(" inside a "( )" pair?
    my $depth = 0;      # how many ")"s should be found to break out of the nested
                        # parens pairs?

    my $offset = -1;   # contains current offset in the string 

   
    for my $c (split //, $string) {
        $offset++;
        if ($c eq "(") {
            if ($optional_offset > -1) {
                $nested = 1;
                $depth++;
            } else {
                $optional_offset = $offset;
            }
        }

        elsif ($c eq ")") {
            if ($depth) {
                $depth--;
            }

            elsif ($optional_offset > -1 ) {

                my $length = $offset - $optional_offset;

                my @parens = ();
                if ($nested) {
                    DEBUG 3, "  parseOptionals: found nested optional '", substr($string, $optional_offset+1, $length-1), "'";
                    @parens = parseOptionals(substr($string, $optional_offset+1, $length-1), "nested optional in $where)");
                    push @parens, "";
                } else {
                    DEBUG 3, "  parseOptionals: found optional: ", substr($string, $optional_offset+1, $length-1);
                    @parens = (substr($string, $optional_offset+1, $length-1), "");
                }

                my @newoptions = ();
                for my $i (0..$#options) {
                    my @add = ();

                    for my $p (@parens) {
                        push @add, $options[$i] . $p;
                    }
                    push  @newoptions, @add;
                }
                @options = @newoptions;

                $optional_offset = -1;
                $nested = 0;
            } else {
                die "Syntax error: unmatched right paren ')' in $where at line $.\n";
            }

        } elsif ($optional_offset == -1)  {
            for (@options) {
                $_ .= $c
            }
        }

    DEBUG 3, "  parseOptionals: '$string' rendered into (", join(", ", map {"'$_'"} @options), ")";
   
    }

    if ($optional_offset > -1) {
        die "Syntax error: unmatched left paren '(' in $where at line $.\n";
    }

    @options = sort {length $b <=> length $a} uniq @options;
    return @options;
}



sub rawsymbols {
    # Parses a value into an array of symbols
    # At this moment, a variable just counts as one symbol

    my $value = shift;
    my $where = shift;
    
    my $found = "";
    my $search = ""; # name of the variable that's currently going to be included

    my @symbols = ();
    for my $c (split //, $value) {
        if ($search) {
            if ($c ne $search) {
                if ($search eq "]" && $c eq "[") {
                    die "Syntax error: attempt to nest polygraphs in $where at line $.\n";
                } elsif ($search eq ">" && $c eq "<") {
                    die "Syntax error: attempt to nest multichar variable names in $where at line $.\n";
                }        

                $found .= $c;
                next;
            } else {
                push @symbols, $found . $c;
                $search = $found = "";
            }

        } elsif ($c eq '<') {
            $found = "<";
            $search = ">";
        } elsif ($c eq "]") {
            die "Syntax error: attempt to close unopened polygraph symbol in $where at line $.\n";
        } elsif ($c eq "[") {
            $search = "]";
            $found = "[";

        } else {
            push @symbols, $c;
        }
    }


    if ($search eq '>') {
        die "Syntax error: unclosed variable name in $where at line $.\n";
    } elsif ($search eq ']') {
        die "Syntax error: unclosed polygraph symbol in $where at line $.\n";
    }
    return @symbols;
}

sub compareArray {
    my @a = @{+shift};
    my @b = @{+shift};

    DEBUG 3, "compareArray( [", join(", ", map {"'$_'"} grep {defined $_} @a), "],";
    DEBUG 3, "              [", join(", ", map {"'$_'"}  grep {defined $_} @b), "],";

    if (@a != @b) {     # compare their lengths
        return 0;       # remember how an array in scalar contexts
    }                   # just counts as the number of elements in it

    for (my $i = 0; $i < @a; $i++) {
        if (defined $a[$i] != defined $b[$i]) {
            return 0;
        } elsif ($a[$i] ne $b[$i]) {
            return 0;
        }
    }

    return 1;
}

sub uniq {
    my @a = @_;

    my %uniq = ();
    my @out = ();
    for my $e (@a) {
        if (!exists $uniq{$e}) {
            $uniq{$e} = 1;
            push @out, $e;
        }
    }

    return @out;
}
    






sub compileRule {
    # Compiles a raw rule
    # That means that it extracts all different parts (see also the comment at the big
    # regexp below) and throws them at parseValue or parsePosition or just wherever they
    # need to be thrown at.
    # Then it craps all that parsed stuff into the hash ref that the Rule object really is
    # and then it returns the object


    my $rawrule = shift;


    # Extract the various parts
    my ($rawOriginal, $rawNew, $position, $exceptions) = $rawrule =~ 
        m!
            ^
            ([^/]*)             # the Original
            /                   # delimiter
            ([^/]*)             # the New
            /                   # delimter
            ([^/]*?)             # Position

            (?:
                \s+UNLESS\s+(.+)    # Exception 1
            )?                      # Exceptions are optional
            $
        !x;

    # Good, get exceptions sorted out into a nice array

    $exceptions ||= "";
    my @exceptions;
    if ($exceptions) {
        @exceptions = grep {length $_} split( /(.+?)\s+OR\s+/, $exceptions);
    }
    
    # And get variables work nicely
    @exceptions = map {parsePosition($_, "Exception")} @exceptions;


    # Get those raw values parsed
    my @original = parseValue($rawOriginal, "Original");
    my @new = parseValue($rawNew, "New");

    # Let's see... Position doesn't need to be parsed
    # Neither do the exceptions

    # So let's crap all this stuff in the Rule object now.
    # No wait!
    # First check if the Original and the New actually have the same
    # number of symbols...

    my $rO = scalar rawsymbols($rawOriginal, "Original");
    my $rN = scalar rawsymbols($rawNew, "New");
    if ($rO != $rN) {
        unless ($rN == 0) {
            die "Syntax error: number of symbols in Original (", scalar @original,
                " symbols) and New (", scalar @new, " symbols) didn't match. Check line $. of your rules file.\n";
        }
    }



    # *Now* crap it in
    @original = ("") unless @original;
    @new = ("") unless @new;

    my %rule = ();        

    $rule{RAWRULE} = $rawrule;
    $rule{ORIGINAL} = \@original;
    $rule{NEW} = \@new;
    $rule{POSITION} = [parsePosition($position, "Position")];
    $rule{EXCEPTIONS} = \@exceptions;


    # Now create a list of polygraphs that occur in this rule

    my @polygraphs = ();
    for (@original) {
        push @polygraphs, $_ if length($_) > 1;
    }

#    for ((@original, @new)) {
#        push @polygraphs, $_ if length($_) > 1;
#    }
#    for ((@{$rule{POSITION}}, @exceptions)) {
#        my $c = $_;
#        $c =~ s/(^\#|\#$)//g;
#        my ($before, $after) = split(/_/, $c, 2);
#        push @polygraphs, $before if length($before|"") > 1;
#        push @polygraphs, $after if length($after||"") > 1;
#    }
#
    # Remove duplicate elements, sort by descending length
    @polygraphs = sort {length $b <=> length $a} uniq @polygraphs;

    $rule{POLYGRAPHS} = \@polygraphs;
    
    # And return the whole rule thing :D

    return \%rule;
}

sub chopIntoSymbols {
    # Using the polygraph symbols in a rule, this subroutine
    # splits up a given word into an array where each element
    # is the first best matching polygraphor just a monograph

    my $word = shift;
    my $polygraphs = shift;
    my @polygraphs = ();
    if ($polygraphs) {
        @polygraphs = @{$polygraphs};
    }

    my @symbols = ();

    CHARACTER:
    for (my $c=0; $c < length($word); $c++) {
        my $char = substr($word, $c, 1);

        
        SYMBOL:
        for my $s (@polygraphs) {
        
            DEBUG 1, "  S=$s - ", substr($word,$c, length($s));

            if (substr($word, $c, length($s)) eq $s) {

                push @symbols, $s;
                $c += length($s)-1;
                next CHARACTER;
            }
        }

        push @symbols, $char;
    }

    # Put in the global polygraphs now
    # by merging subsequent monographs into polygraphs
    # if we must
    my @out_symbols = ();
    SYMBOL:
    for (my $c = 0; $c < @symbols; $c++) {
        
        if (length($symbols[$c]) > 1) {
            push @out_symbols, $symbols[$c];
            next;
        }

        GPG:
        for my $gpg (@global_polygraphs) {
            if ($c + length($gpg) - 1> $#symbols) {
                # Don't get beyond the end of @symbols ;P
                next GPG;
            }

            if (join("", @symbols[$c..$c+length($gpg)-1]) eq $gpg) {
                push @out_symbols, $gpg;
                $c += length($gpg) - 1;
                next SYMBOL;
            }
        }

        push @out_symbols, $symbols[$c];
    }



    DEBUG 3, "chopIntoSymbols: got '$word' / ",
        join(", ", map {"'$_'"} @polygraphs), " / ",
        join(", ", map {"'$_'"} @global_polygraphs), " = (",
        join(", ", map {"'$_'"} grep {length $_} @out_symbols), ")";
   
    return grep {length $_} @out_symbols;
}






sub matchPosition {
    # Check if an Original fits in the position somewhere;
    my $word = shift;
    my $rule = shift;
    my @word = @{$word};
    my $c = shift;
    my $position = shift;
    my $original = shift;

    if ($position eq "_") {
        return 1;
    }

    my $wantinitial = 0;
    my $wantfinal = 0;

    $wantinitial = 1 if index($position, "#") == 0;
    $wantfinal = 1 if rindex($position, "#") == length($position)-1;


    $position =~ s/\#//g;

    DEBUG 3, "position: '$position'; original: '$original'; wantinitial: $wantinitial; wantfinal: $wantfinal";


    my $ismatch = 0;

    if (index($position, "_") > -1) {
        my ($before, $after) = split(/_/, $position);

        my @before = ();
        my @after = ();
        @before = chopIntoSymbols $before, $rule->{POLYGRAPHS} if $before;
        @after = chopIntoSymbols $after, $rule->{POLYGRAPHS} if $after;

        DEBUG 3, "\@word: (", join(", ", @word), ")";
        DEBUG 3, "\@before: (", join(", ", @before), ")";
        DEBUG 3, "\@after: (", join(", ", @after), ")";

        if ($c - @before < 0) {
            return 0;
        }

        if (
            (!$before || compareArray([@word[$c-@before .. $c-1]], \@before)) &&
            (!$after || compareArray([@word[$c+1 .. $c+@after]], \@after))
        ) {

            DEBUG 3, "Before: '$before' (in word: '", join("",@word[$c-@before .. @before]), "')";
            DEBUG 3, "After: '$after' (in word: '", join("", @word[$c+length($original) .. @after]), "')";

            if ($wantinitial && $c - @before != 0) {
                DEBUG 3, "wantinitial failure";
                return 0;
            }
 
            if ($wantfinal && $c + @after + 1 != @word) {
                DEBUG 3, "wantfinal failure";
                return 0;
            }

            DEBUG 3, "match";
            return 1;

        } else {
            return 0;
        }

    } else {

        my @position = chopIntoSymbols $position;

        my $where = -1;
        for (my $id = 0; $id < @word; $id++) { 
            if ($id + @position > @word) {
                last;

            }elsif (compareArray([@word[$id..$id+@position-1]], \@position)) {
                $where = $id;
                last;
            }
            $id ++;
        }

            
#        my $where = index($word, $position);
        DEBUG 3, "No _; where: $where [@word]";

        if ($where == -1) {
            return 0;
        }

        if ($wantinitial && $where != 0) {
            return 0;
        }

        if ($wantfinal && rindex($word, $position) != length($word) - length($original)) {
            return 0;
        }

        return 1;
    }
}

       

           
            








sub applyRule {
    my $rule = shift;
    my $word = shift;

    my %rule = %{$rule};

    my @outword = ();

    DEBUG 3, "-- Rule $rule{RAWRULE} on '$word' --";
    use Data::Dumper;
    DEBUG 3, Dumper \$rule;

    my @word = chopIntoSymbols $word, $rule{POLYGRAPHS};
    my $sID = -1;
    DEBUG 1, "-- Applying rule $rule{RAWRULE} to word '$word' (", join(" + ", map { $sID++; "$sID:" . qq("$_") } @word), ") --";

    CHARACTER:
    for (my $c=0; $c < @word; $c++) {
        DEBUG 2, "  Pos $c";
        my @new = @{$rule{NEW}};
        unshift @new, pop @new;     # Prepare it for first cycle

        ORIGINAL:
        for my $o (@{$rule{ORIGINAL}}) {

            push @new, shift @new;
            DEBUG 2, "  $word: O='$o' at pos $c ('$word[$c]')";

            if($word[$c] eq $o) {

                DEBUG 1, "  Original matches at '$o' (symbol $c)";

                # Ok so we got ourselves a match here, but is it in the right position?
                # Let's find out...

                POSITION:
                for my $p (@{$rule{POSITION}}) {

                    if (matchPosition(\@word, $rule, $c, $p, $o)) {

                        DEBUG 1, "  Position '$p' matches";

                        # So even the positions match,
                        # Now let's check for the exceptions

                        EXCEPTION:
                        for my $e (@{$rule{EXCEPTIONS}}) {
                            if (matchPosition(\@word, $rule, $c, $e, $o)) {
                                DEBUG 1, "  Exception '$e' matches, skipping Original '$o'";
                                next ORIGINAL;
                            }
                        }


                        DEBUG 1, "  '$o' > '$new[0]' ($rule{RAWRULE})"; 
                        push @outword, $new[0];
                        next CHARACTER;
                    }
                }
            }
        }
 
        push @outword, $word[$c];

    }

    # Return the re-assembled word
    my $outword = join("", grep {length $_} @outword);
    if ($word ne $outword) {
        DEBUG 1, "  '$word' > '", join("", grep {length $_} @outword), "'";
    } else {
        DEBUG 1, "  '$word' unaffected by $rule{RAWRULE}";
    }
    return join("", grep {length $_} @outword);
}




sub output {
#    my $outFH = shift;
    my $toconsole = $clarg{c};
    my $body = join("", @_);

    if ($toconsole && $outFH eq \*STDOUT) {
        $toconsole = 0;
    }

    print $outFH $body;
    if ($toconsole) {
        print $body;
    }
}



















sub HELPMESSAGE {
print << "EOF";
Usage:  perl vsca.pl <options>
Version $VERSION
 -l <file>   Specify lexicon file (IE, your original word list)
 -r <file>   Specify rules file
 -o <file>   Optional. Specify output file. If omitted, output goes to console
 
 -c          Send output both to output file and console
 -d <level>  Output debug information. Levels are 1, 2, 3
 
 -H          History. Output original word too, according to the template
                in the -h switch. Default template: "\\n\\t( < \\o)\\t\\c"

 -h <template>  Define template for -H. Specifying -h implies setting -H.
                Use \\n for new word, \\o for orignal word, \\c for comment,
                \\t for horizontal tab.
                Without -h or -H, "\\n\\t\\c" is assumed.

 -u          Disables UTF-8 IO layer so that plain text files (8-bit bytes
             instead of UTF-8 multi-byte characters) will work properly

EOF
exit shift;
}


sub DEBUG {
    my $level = shift;
    my $body = join("", @_);

    if ($level <= $clarg{d}) {
        output "$body\n";
    }
}






package file;

sub new {
    my ($class, $filename, $IOlayer) = @_;
    $IOlayer||="";
    
    open my $fh, "<$IOlayer", "$filename" or return;
    my $file;
    do {
        local $/ = undef;
        $file = <$fh>;
    };
    close $fh;
    my $n = $/;
    $file =~ s/(
          \x0A\x0D |          # LF+CR
         \x0D\x0A |           # CR+LF
         \x0A | \x0C | \x0D | # LF or FF or CR
         \x85 |               # U+0085
         \x{2028} |           # U+2028
         \x{2029}             # U+2029
    )/$n/gx;

    if ($IOlayer) {
        # Remove Byte Order Mark if it's there, but only if -u is not given
        $file =~ s/\x{FEFF}//g;
    }

    
    my $self ={};
    my @lines = split($n, $file);
    $self->{FILE} = \@lines;
    bless $self, $class;
    return $self;
}

sub nextline {
    my $self = shift;


    my @lines = @{$self->{FILE}};
    if (@lines) {
        my $line = shift @lines;
        $self->{FILE} = \@lines;
        return $line || " ";
    }
    return;
}