view release on metacpan or  search on metacpan

lib/Astro/XSPEC/Model/Parse.pm  view on Meta::CPAN

# --8<--8<--8<--8<--
#
# Copyright (C) 2010 Smithsonian Astrophysical Observatory
#
# This file is part of Astro::XSPEC::Model::Parse
#
# Astro::XSPEC::Model::Parse is free software: you can redistribute it
# and/or modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation, either version 3 of
# the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
# -->8-->8-->8-->8--

use strict;
use warnings;
package Astro::XSPEC::Model::Parse;
BEGIN {
  $Astro::XSPEC::Model::Parse::VERSION = '0.01';
}

use Carp;

use IO::File;
use Text::ParseWords;
use Params::Validate qw[ :all ];

my %model_handler = (
    start => { type => CODEREF, optional => 1 },
    end   => { type => CODEREF, optional => 1 },
    );

sub new
{

    my $class = shift;

    my %par = validate( @_,
                        {
                            model => { type => HASHREF,
                                       callbacks => { 'handler' =>
                                                          sub {
                                                              pop @_;
                                                              validate( @_, \%model_handler )
                                                      }
                                       },
                                       default => {},
                            },
                            par   => { type => CODEREF, optional => 1 },
                            args  => { type => HASHREF, optional => 1 },
                            norm  => { type => SCALAR, default => 0 }, }
        );

    return bless {@_}, $class;
}

sub _handle_model {

    my ( $self, $event, $args ) = @_;

    return 1 unless defined $self->{model}->{$event};

    my $ret = eval { $self->{model}->{$event}->( $event, $args, $self->{args} ) };

    die( "error in model handler for event $event: $@\n" )
        unless defined $ret;

    return $ret;
}

sub _handle_par {

    my ( $self, $args ) = @_;

    return 1 unless defined $self->{par};

    my $ret = eval { $self->{par}->( $args, $self->{args} ) };

    die( "error in parameter handler: $@\n" )
        unless defined $ret;

    return $ret;
}

sub parse_file {

    my ( $self, $file ) = @_;

    my $fh = IO::File->new( $file )
      or croak( "$file: error opening file\n" );

    my @stanza;

    while (my $rec = $fh->getline)
    {
        chomp $rec;

        my $blank = $rec =~ /^\s*$/;

        if ( $blank )
        {