File Coverage

blib/lib/OPM/Parser.pm

Criterion	Covered	Total	%
statement	136	138	98.5
branch	32	34	94.1
condition	11	13	84.6
subroutine	19	20	95.0
pod	4	4	100.0
total	202	209	96.6

package OPM::Parser;

use v5.24;

# ABSTRACT: Parser for the .opm file

use strict;
use warnings;

our $VERSION = '1.06'; # VERSION

use Moo;
use MooX::HandlesVia;
use OPM::Parser::Types qw(:all);

use MIME::Base64 ();
use OPM::Validate;
use Path::Class;
use Try::Tiny;
use XML::LibXML;

# declare attributes
has product      => ( is  => 'rw', isa => Str, );
has name         => ( is  => 'rw', isa => Str, );
has version      => ( is  => 'rw', isa => VersionString, );
has vendor       => ( is  => 'rw', isa => Str, );
has url          => ( is  => 'rw', isa => Str, );
has license      => ( is  => 'rw', isa => Str, );
has description  => ( is  => 'rw', isa => Str, );
has error_string => ( is  => 'rw', isa => Str, );
has tree         => ( is  => 'rw', isa => XMLTree, );

has opm_file => (
    is       => 'ro',
    isa      => Str,
    required => 1,
);

has files => (
    is          => 'rw',
    isa         => ArrayRef[HashRef],
    default     => sub{ [] },
    handles_via => 'Array',
    handles     => {
        add_file => 'push',
    },
);

has framework  => (
    handles_via => 'Array',
    is          => 'rw',
    isa         => ArrayRef[FrameworkVersionString],
    default     => sub { [] },
    handles     => {
        add_framework => 'push',
    },
);

has framework_details => (
    handles_via => 'Array',
    is          => 'rw',
    isa         => ArrayRef[HashRef],
    default     => sub { [] },
    handles     => {
        add_framework_detail => 'push',
    },
);

has dependencies => (
    handles_via => 'Array',
    is          => 'rw',
    isa         => ArrayRef[HashRef[Str]],
    default     => sub { [] },
    handles     => {
        add_dependency => 'push',
    },
);


sub documentation {
    my ($self,%params) = @_;

    my $doc_file;
    my $found_file;

    my $lang = $params{lang} || 'en';
    my $type = $params{type} || '';

    for my $file ( $self->files->@* ) {

        my $filename = $file->{filename};
        next if $filename !~ m{ \A doc/ }x;

        if ( !$doc_file ) {
            $doc_file   = $file;
            $found_file = $filename;
        }

        next if $filename !~ m{ \A doc/$lang/ }x;

        if ( $found_file !~ m{ \A doc/$lang/ }x ) {
            $doc_file   = $file;
            $found_file = $filename;
        }

        next if $type && $filename !~ m{ \A doc/[^/]+/.*\.$type \z }x;

        if ( $type && $found_file !~ m{ \A doc/[^/]+/.*\.$type \z }x ) {
            $doc_file   = $file;
            $found_file = $filename;
        }

        last if $found_file =~ m{ \A doc/$lang/.*\.$type \z }x;
    }

    return $doc_file;
}

sub validate {
    my ($self) = @_;

    $self->error_string( '' );

    if ( !-e $self->opm_file ) {
        $self->error_string( 'File does not exist' );
        return;
    }

    try {
        my $fh      = IO::File->new( $self->opm_file, 'r' );
        my $content = join '', $fh->getlines;
        OPM::Validate->validate( $content );
    }
    catch {
        $self->error_string( 'opm file is invalid: ' . $_ );
    };

    return if $self->error_string;
    return 1;
}

sub parse {
    my ($self, %params) = @_;

    $self->error_string( '' );

    if ( !-e $self->opm_file ) {
        $self->error_string( 'File does not exist' );
        return;
    }

    my $tree;
    try {
        my $parser = XML::LibXML->new;
        $tree      = $parser->parse_file( $self->opm_file );

        $self->tree( $tree );
    }
    catch {
        $self->error_string( 'Could not parse .opm: ' . $_ );
        return;
    };

    return if $self->error_string;

    my $is_valid = $self->validate;
    if ( !$params{ignore_validation} && !$is_valid ) {
        return;
    }

    my $root = $tree->getDocumentElement;

    # collect basic data
    $self->vendor(    $root->findvalue( 'Vendor' ) );
    $self->name(      $root->findvalue( 'Name' ) );
    $self->license(   $root->findvalue( 'License' ) );
    $self->version(   $root->findvalue( 'Version' ) );
    $self->url(       $root->findvalue( 'URL' ) );

    my $root_name = $root->nodeName;
    $root_name    =~ s{_package}{};

    $self->product( $root_name );

    # retrieve framework information
    my @frameworks = $root->findnodes( 'Framework' );

    FILE:
    for my $framework ( @frameworks ) {
        my $framework_version = $framework->textContent;

        my %details = ( Content => $framework_version );
        my $maximum = $framework->findvalue( '@Maximum' );
        my $minimum = $framework->findvalue( '@Minimum' );

        $details{Maximum} = $maximum if $maximum;
        $details{Minimum} = $minimum if $minimum;

        # push framework info to attribute
        $self->add_framework( $framework_version );
        $self->add_framework_detail( \%details );
    }

    # retrieve file information
    my @files = $root->findnodes( 'Filelist/File' );

    FILE:
    for my $file ( @files ) {
        my $name = $file->findvalue( '@Location' );

        #next FILE if $name !~ m{ \. (?:pl|pm|pod|t) \z }xms;
        my $encode         = $file->findvalue( '@Encode' );
        next FILE if $encode ne 'Base64';

        my $content_base64 = $file->textContent;
        my $content        = MIME::Base64::decode( $content_base64 );

        # push file info to attribute
        $self->add_file({
            filename => $name,
            content  => $content,
        });
    }

    # get description - english if available, any other language otherwise
    my @descriptions = $root->findnodes( 'Description' );
    my $description_string;

    DESCRIPTION:
    for my $description ( @descriptions ) {
        $description_string = $description->textContent;
        my $language        = $description->findvalue( '@Lang' );

        last DESCRIPTION if $language eq 'en';
    }

    $self->description( $description_string );

    # get Addon and CPAN dependencies
    my @addon_deps = $root->findnodes( 'PackageRequired' );
    my @cpan_deps  = $root->findnodes( 'ModuleRequired' );

    my %types     = (
        PackageRequired => 'Addon',
        ModuleRequired  => 'CPAN',
    );

    for my $dep ( @addon_deps, @cpan_deps ) {
        my $node_type = $dep->nodeName;
        my $version   = $dep->findvalue( '@Version' );
        my $dep_name  = $dep->textContent;
        my $dep_type  = $types{$node_type};

        $self->add_dependency({
            type    => $dep_type,
            version => $version,
            name    => $dep_name,
        });
    }

    return 1;
}

sub as_sopm {
    my ($self) = @_;

    my $tree = $self->tree->cloneNode(1);
    my $root = $tree->getDocumentElement;

    my @build_host = $root->findnodes( 'BuildHost' );
    my @build_date = $root->findnodes( 'BuildDate' );

    $root->removeChild( $_ ) for @build_host;
    $root->removeChild( $_ ) for @build_date;

    #$build_host->unbindNode() if $build_host;
    #$build_date->unbindNode() if $build_date;

    my @files = $root->findnodes( 'Filelist/File' );
    for my $file ( @files ) {
        my ($encode) = $file->findnodes( '@Encode' );
        $encode->unbindNode() if $encode;

        $file->removeChildNodes();
    }

    return $tree->toString;
}


sub _get_xsd {

    return q~





























































































































































































































































































































































































































~;
}

1;

__END__