use warnings;
use strict;

package Text::Parser 0.700;

# ABSTRACT: Bundles common text file reading, extensible to read any arbitrary text grammar. Stop re-writing mundane code to parse your next text file. This module supersedes the older and now defunct TextFileParser.

use Exporter 'import';
our (@EXPORT_OK) = ();
our (@EXPORT)    = (@EXPORT_OK);


use Exception::Class (
    'Text::Parser::Exception',
    'Text::Parser::Exception::ParsingError' => {
        isa         => 'Text::Parser::Exception',
        description => 'For all parsing errors',
        alias       => 'throw_text_parsing_error'
    },
    'Text::Parser::Exception::FileNotFound' => {
        isa         => 'Text::Parser::Exception',
        description => 'File not found',
        alias       => 'throw_file_not_found'
    },
    'Text::Parser::Exception::FileNotReadable' => {
        isa         => 'Text::Parser::Exception',
        description => 'File not readable',
        alias       => 'throw_file_not_readable'
    },
    'Text::Parser::Exception::InvalidFileHandle' => {
        isa         => 'Text::Parser::Exception',
        description => 'Bad argument supplied to filehandle()',
        alias       => 'throw_invalid_filehandle'
    },
    'Text::Parser::Exception::InvalidFilename' => {
        isa         => 'Text::Parser::Exception',
        description => 'Bad argument supplied to filename()',
        alias       => 'throw_bad_filename'
    },
    'Text::Parser::Exception::FileCantOpen' => {
        isa         => 'Text::Parser::Exception',
        description => 'Error opening file',
        alias       => 'throw_cant_open'
    },
    'Text::Parser::Exception::BadReadInput' => {
        isa => 'Text::Parser::Exception',
        description =>
            'The user called read() method with an unsupported type of input',
        alias => 'throw_bad_input_to_read',
    },
);

use Try::Tiny;


sub new {
    my $pkg = shift;
    bless {}, $pkg;
}


sub read {
    my ( $self, $input ) = @_;
    return if not $self->__is_file_known_or_opened($input);
    $self->__store_check_input($input);
    $self->__read_and_close_filehandle();
}

sub __store_check_input {
    my ( $self, $input ) = @_;
    return                           if not defined $input;
    return $self->filename($input)   if ref($input) eq '';
    return $self->filehandle($input) if ref($input) eq 'GLOB';
    __throw_bad_input_to_read( ref($input) );
}

sub __throw_bad_input_to_read {
    throw_bad_input_to_read error => 'Unexpected ' . shift
        . ' type input to read() ; must be either string filename or GLOB';
}

sub __is_file_known_or_opened {
    my ( $self, $fname ) = @_;
    return 0 if not defined $fname and not exists $self->{__filehandle};
    return 0 if defined $fname and not $fname;
    return 1;
}

sub __read_and_close_filehandle {
    my $self = shift;
    $self->__init_read_fh;
    $self->__read_file_handle;
    $self->__close_file;
}

sub __init_read_fh {
    my $self = shift;
    $self->lines_parsed(0);
    $self->{__bytes_read} = 0;
    delete $self->{__records} if exists $self->{__records};
    delete $self->{__abort_reading};
}

sub __read_file_handle {
    my $self = shift;
    my $fh   = $self->filehandle();
    while (<$fh>) {
        last if not $self->__parse_line_and_next($_);
    }
}

sub __parse_line_and_next {
    my $self = shift;
    $self->lines_parsed( $self->lines_parsed + 1 );
    $self->__try_to_parse(shift);
    return not exists $self->{__abort_reading};
}

sub __try_to_parse {
    my ( $self, $line ) = @_;
    try { $self->save_record($line); }
    catch {
        $self->__close_file;
        $_->rethrow;
    };
}

sub __close_file {
    my $self = shift;
    close $self->{__filehandle};
    delete $self->{__filehandle};
}


sub filename {
    my $self = shift;
    $self->__open_file( $self->__is_readable_file(shift) ) if scalar(@_);
    return ( exists $self->{__filename} ) ? $self->{__filename} : undef;
}

sub __is_readable_file {
    my ( $self, $fname ) = @_;
    throw_bad_filename( error => "$fname is not a string" )
        if ref($fname) ne '';
    throw_file_not_found( error => "$fname is not a file" )
        if not -f $fname;
    throw_file_not_readable( error => "$fname is not readable" )
        if not -r $fname;
    return $fname;
}

sub __open_file {
    my ( $self, $fname ) = @_;
    $self->{__filename} = $fname;
    $self->__close_file if exists $self->{__filehandle};
    open my $fh, "<$fname"
        or throw_cant_open( error => "Error while opening file $fname" );
    $self->filehandle($fh);
}


sub filehandle {
    my ( $self, $fhref ) = @_;
    $self->__save_file_handle($fhref) if $self->__check_file_handle($fhref);
    return ( exists $self->{__filehandle} ) ? $self->{__filehandle} : undef;
}

sub __save_file_handle {
    my ( $self, $fhref ) = @_;
    $self->{__filehandle} = $$fhref;
    $self->{__size}       = ( stat $$fhref )[7];
}

sub __check_file_handle {
    my ( $self, $fhref ) = @_;
    return 0 if not defined $fhref;
    throw_invalid_filehandle( error => "$fhref is not a valid filehandle" )
        if ref($fhref) ne 'GLOB';
    throw_file_not_readable(
        error => "The filehandle $$fhref is not readable" )
        if not -r $$fhref;
    return 1;
}


sub lines_parsed {
    my $self = shift;
    return $self->{__current_line} = shift if @_;
    return ( exists $self->{__current_line} ) ? $self->{__current_line} : 0;
}


sub save_record {
    my $self = shift;
    $self->{__records} = [] if not defined $self->{__records};
    push @{ $self->{__records} }, shift;
}


sub abort_reading {
    my $self = shift;
    $self->{__abort_reading} = 1;
}


sub get_records {
    my $self = shift;
    return () if not exists $self->{__records};
    return @{ $self->{__records} };
}


sub last_record {
    my $self = shift;
    return undef if not exists $self->{__records};
    my (@record) = @{ $self->{__records} };
    return $record[$#record];
}


sub pop_record {
    my $self = shift;
    return undef if not exists $self->{__records};
    pop @{ $self->{__records} };
}


1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Text::Parser - Bundles common text file reading, extensible to read any arbitrary text grammar. Stop re-writing mundane code to parse your next text file. This module supersedes the older and now defunct TextFileParser.

=head1 VERSION

version 0.700

=head1 SYNOPSIS

    use Text::Parser;

    my $parser = Text::Parser->new();
    $parser->read(shift @ARGV);
    print $parser->get_records, "\n";

The above code treats the first command-line argument as a filename, and assuming it is a text file, it will print the content of the file to C<STDOUT>.

=head1 RATIONALE

A simple text parser should have to only specify the "grammar" of the format it intends to read in the form of a few routines. Everything else, like opening a file handle, reading line by line, or tracking how many lines have been read, should be "automatic". Unfortunately, that's not how most programs seem to work. Most programmers spend (waste?) time writing code that calls C<open>, C<close>, etc., and must keep track of things that should have been simple features of every text file parser. And if they have to read multiple files, usually, the calls to C<open>, C<close>, and other things are repeated, and one has to repeat the checks for readability etc. This is an utter waste of time.

C<Text::Parser> does all mundane operations like C<open> file, C<close> file, line-count, and storage/deletion/retrieval of records, etc. You don't have to bother with all that when you write a parser for your favorite text file format. Instead you can usually override just one method (C<save_records>) and voila! you have a parser. Look at L<these examples|/EXAMPLES> to see how easy this can be.

=head1 DESCRIPTION

C<Text::Parser> is a bare-bones text file parsing class. It is actually ignorant of the file format, and cannot recognize any grammars, but derived classes that inherit from it can specify this. They can do this by overriding some of the methods in this class.

Future versions are expected to include progress-bar support. All these software features are file-format independent and can be re-used in parsing any text file format. Thus derived classes of C<Text::Parser> will be able to take advantage of these features without having to re-write the code again.

=head1 EXAMPLES

The following examples should illustrate the use of inheritance to parse various types of text file formats.

=head2 Basic principle

Derived classes simply need to override one method : C<save_record>. With the help of that any arbitrary file format can be read. C<save_record> should interpret the format of the text and store it in some form by calling C<SUPER::save_record>. The C<main::> program will then use the records and create an appropriate data structure with it.

=head2 Example 1 : A simple CSV Parser

We will write a parser for a simple CSV file that reads each line and stores the records as array references.

    package Text::Parser::CSV;
    use parent 'Text::Parser';

    sub save_record {
        my ($self, $line) = @_;
        chomp $line;
        my (@fields) = split /,/, $line;
        $self->SUPER::save_record(\@fields);
    }

That's it! Now in C<main::> you can write something like this:

    use Text::Parser::CSV;
    
    my $csvp = Text::Parser::CSV->new();
    $csvp->read(shift @ARGV);
    foreach my $aref ($csvp->get_records) {
        my (@arr) = @{$aref};
        print "@arr\n";
    }

The above program reads the content of a given CSV file and prints the content out in space-separated form.

=head3 Error checking

It is easy to add any error checks using exceptions. One of the easiest ways to do this is to C<use L<Exception::Class>>. We'll demonstrate the use for the CSV parser.

    package Text::Parser::CSV;
    use Exception::Class (
        'Text::Parser::CSV::Error', 
        'Text::Parser::CSV::TooManyFields' => {
            isa => 'Text::Parser::CSV::Error',
        },
    );
    
    use parent 'Text::Parser';

    sub save_record {
        my ($self, $line) = @_;
        chomp $line;
        my (@fields) = split /,/, $line;
        $self->{__csv_header} = \@fields if not scalar($self->get_records);
        Text::Parser::CSV::TooManyFields->throw(error => "Too many fields on line #" . $self->lines_parsed)
            if scalar(@fields) > scalar(@{$self->{__csv_header}});
        $self->SUPER::save_record(\@fields);
    }

The C<Text::Parser> class will close all filehandles automatically as soon as an exception is thrown from C<save_record>. You can catch the exception in C<main::> as you would normally, by C<use>ing C<L<Try::Tiny>> or other such class.

=head2 Example 2 : Multi-line records

Many text file formats have some way to indicate line-continuation. In BASH and many other interpreted shell languages, a line continuation is indicated with a trailing back-slash (\). In SPICE syntax if a line starts with a C<'+'> character then it is to be treated as a continuation of the previous line.

To illustrate multi-line records we will write a derived class that simply joins the lines in a SPICE file and stores them as records.

    package Text::Parser::LineContinuation::Spice;
    use parent 'Text::Parser'l

    sub save_record {
        my ($self, $line) = @_;
        $line = ($line =~ /^[+]\s*/) ? $self->__combine_with_last_record($line) : $line;
        $self->SUPER::save_record( $line );
    }

    sub __combine_with_last_record {
        my ($self, $line) = @_;
        $line =~ s/^[+]\s*//;
        my $last_rec = $self->pop_record;
        chomp $last_rec;
        return $last_rec . ' ' . $line;
    }

=head3 Making roles instead

Line-continuation is a classic feature which is common to many different formats. If each syntax grammar generates a new class, one could potentially have to re-write code for line-continuation for each syntax or grammar. Instead it would be good to somehow re-use only the ability to join continued lines, but leave the actual syntax recognition to actual class that understands the syntax.

But if we separate this functionality into a class of its own line we did above with C<Text::Parser::LineContinuation::Spice>, then it gives an impression that we can now create an object of C<Text::Parser::LineContinuation::Spice>. But in reality an object of this class would have not have much functionality and is therefore limited.

This is where L<roles|Role::Tiny> are very useful.

=head1 METHODS

=head2 new

Takes no arguments. Returns a blessed reference of the object.

    my $parser = Text::Parser->new();

This C<$parser> variable will be used in examples below.

=head2 read

Takes zero or one argument which could be a string containing the name of the file, or a filehandle reference or a C<GLOB> (e.g. C<\*STDIN>). Throws an exception if filename provided is either non-existent or cannot be read for any reason. Or if the argument supplied is a filehandle reference, and it happens to be opened for write instead of read, then too this method will thrown an exception.

    $parser->read($filename);

    # The above is equivalent to the following
    $parser->filename($filename);
    $parser->read();

    # You can also read from a previously opened file handle directly
    $parser->filehandle(\*STDIN);
    $parser->read();

Returns once all records have been read or if an exception is thrown for any parsing errors, or if reading has been aborted with the C<abort_reading> method. This function will handle all C<open> and C<close> operations on all files even if any exception is thrown, or if the reading has been aborted.

Once the method has successfully completed, you can parse another file. This means that your parser object is not tied to the file you parse. And when you do read a new file or input stream with this C<read> method, you will lose all the records stored from the previous read operation. So this means that if you want to read a different file with the same parser object, (unless you don't care about the records from the last file you read) you should use the C<get_records> method to retrieve all the read records before parsing a new file. So all those calls to C<read> in the example above were parsing three different files, and each successive call overwrote the records from the previous call.

    $parser->read($file1);
    my (@records) = $parser->get_records();

    $parser->read(\*STDIN);
    my (@stdin) = $parser->get_records();

B<Inheritance Recommendation:> When inheriting this class (which is what you should do if you want to write a parser for your favorite text file format), don't override this method. Override C<L<save_record|/save_record>> instead.

B<Note:> Reading from output file handles is a weird thing. Some Operating Systems allow this and some don't. Read the documentation for C<L<filehandle|/filehandle>> for more on this.

=head2 filename

Takes zero or one string argument containing the name of a file. Returns the name of the file that was last opened if any. Returns C<undef> if no file has been opened.

    print "Last read ", $parser->filename, "\n";

=head2 filehandle

Takes zero or one C<GLOB> argument and saves it for future a C<read> call. Returns the filehandle last saved, or C<undef> if none was saved. Remember that after a successful C<read> call, filehandles are lost.

    my $fh = $parser->filehandle();

B<Note:> As such there is a check to ensure one is not supplying a write-only filehandle. For example, if you specify the filehandle of a write-only file or if the file is opened for write and you cannot read from it (here is where some Operating Systems can be different - you can actually read from a file that was opened for writing), then this method will throw an exception. But its behavior is heavily dependent on the Operating System. So don't rely on it catching any issues.

=head2 lines_parsed

Takes no arguments. Returns the number of lines last parsed.

    print $parser->lines_parsed, " lines were parsed\n";

This is also very useful for error message generation.

=head2 save_record

Takes exactly one argument and that is is saved as a record. If more than one argument are passed, everything after the first argument is ignored. And if no arguments are passed, then C<undef> is stored as a record.

In an application that uses a text parser, you will most-likely never call this method directly. It is automatically called within C<read> for each line. In this base class C<Text::Parser>, C<save_record> is simply called with a string containing the raw line of text ; the line of text will not be C<chomp>ed or modified in any way. Derived classes can decide to store records in a different form. A derived class could, for example, store the records in the form of hash references (so that when you use C<get_records>, you'd get an array of hashes), or maybe even another array reference (so when you use C<get_records> to you'd get an array of arrays). See L<Inheritance examples|/"EXAMPLES"> for examples on how C<save_record> could be overridden by derived classes.

=head2 abort_reading

This method will be useful if a derived class wants to stop reading a file after it has read all the desired information. For example:

    package Text::Parser::SomeFile;
    use parent 'Text::Parser';

    sub save_record {
        my ($self, $line) = @_;
        my ($leading, $rest) = split /\s+/, $line, 2;
        return $self->abort_reading() if $leading eq '**ABORT';
        return $self->SUPER::save_record($line);
    }

In this derived class, we have a parser C<Text::Parser::SomeFile> that would save each line as a record, but would abort reading the rest of the file as soon as it reaches a line with C<**ABORT> as the first word. When this parser is given the following file as input:

    somefile.txt:

    Some text is here.
    More text here.
    **ABORT reading
    This text is not read
    This text is not read
    This text is not read
    This text is not read

You can now write a program as follows:

    use Text::Parser::SomeFile;

    my $par = Text::Parser::SomeFile->new();
    $par->read('somefile.txt');
    print $par->get_records(), "\n";

The output will be:

    Some text is here.
    More text here.

=head2 get_records

Takes no arguments. Returns an array containing all the records that were read by the parser.

    foreach my $record ( $parser->get_records ) {
        $i++;
        print "Record: $i: ", $record, "\n";
    }

=head2 last_record

Takes no arguments and returns the last saved record. Leaves the saved records untouched.

    my $last_rec = $parser->last_record;

=head2 pop_record

Takes no arguments and pops the last saved record.

    my $last_rec = $parser->pop_record;
    $uc_last = uc $last_rec;
    $parser->save_record($uc_last);

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website
L<http://rt.cpan.org/Public/Dist/Display.html?Name=Text-Parser> or by email
to L<bug-text-parser at rt.cpan.org|mailto:bug-text-parser at rt.cpan.org>.

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 AUTHOR

Balaji Ramasubramanian <balajiram@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2018 by Balaji Ramasubramanian.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
