view release on metacpan or  search on metacpan

lib/Alien/BWIPP.pm  view on Meta::CPAN

package Alien::BWIPP;
use 5.010;
use utf8;
use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars %LAST_PAREN_MATCH);
use File::ShareDir qw(dist_file);
use IO::File qw();
use Moose::Meta::Class qw();
use Moose qw(has);
use MooseX::ClassAttribute qw(class_has);
use Storable qw(dclone);

our $VERSION = '0.007';

has 'barcode_source_handle' => (
    is      => 'rw',
    isa     => 'IO::File',
    default => sub {
        return IO::File->new(dist_file('Alien-BWIPP', 'barcode.ps'), 'r');
    },
);

has '_chunks' => (is => 'ro', isa => 'HashRef', lazy_build => 1,);

has '_encoders' => (
    is      => 'ro',
    isa     => 'ArrayRef',
    lazy_build => 1,
);

class_has 'encoders_meta_classes' => (is => 'rw', isa => 'ArrayRef[Moose::Meta::Class]',);

sub _build__chunks {
    my ($self) = @_;
    my %chunks;
    {
        while (defined(my $line = $self->barcode_source_handle->getline)) {
            state $block_type = 'HEADER';
            state $block_name;

            if ($line =~ /\A% Barcode Writer in Pure PostScript - Version/) {
                $block_name = 'LICENCE';
            }

            if ($line =~ /\A %[ ]--BEGIN[ ](?<type>(?:RENDERER|ENCODER|RESOURCE))[ ](?<name>\w+)--/msx) {
                $block_type = $LAST_PAREN_MATCH{type} if $LAST_PAREN_MATCH{type};
                $block_name = $LAST_PAREN_MATCH{name} if $LAST_PAREN_MATCH{name};
            }
            elsif ($line =~ /\A % [ ] --
                             (?<feature_name>\w+) :? [ ]?
                             (?<feature_value>.*?)
                             (?:--)? \n \z/msx) {
                unless ($LAST_PAREN_MATCH{feature_name} =~ /^(?:BEGIN|END)$/) {
                    $chunks{$block_type}{$block_name}{$LAST_PAREN_MATCH{feature_name}}
                      = $LAST_PAREN_MATCH{feature_value};
                }
            }
            else {
                $chunks{$block_type}{$block_name}{post_script_source_code} .= $line if $block_name;
            }
        }
    }
    return \%chunks;
}

sub _build__encoders {
    my ($self) = @_;
    return [keys %{$self->_chunks->{ENCODER}}];
}

sub create_classes {
    my ($self) = @_;
    my @meta_classes;
    my %chunks = %{$self->_chunks};
    for my $encoder (@{$self->_encoders}) {
        my $prepended = $chunks{HEADER}{LICENCE}{post_script_source_code};
        for my $dependency_type (qw(REQUIRES SUGGESTS)) {
            if (exists $chunks{ENCODER}{$encoder}{$dependency_type}) {
                for my $dependency (split q{ }, $chunks{ENCODER}{$encoder}{$dependency_type}) {
                    for my $resource_type (qw(RENDERER ENCODER RESOURCE)) {
                        if (exists $chunks{$resource_type}{$dependency}{post_script_source_code}) {
                            $prepended .= $chunks{$resource_type}{$dependency}{post_script_source_code};
                        }