File Coverage

blib/lib/Image/ButtonMaker.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Image::ButtonMaker;

our $VERSION  = '0.1.4';

use strict;
use utf8;
use Image::ButtonMaker::ButtonClass;
use Image::ButtonMaker::ClassContainer;
use Image::ButtonMaker::Lexicon;
use locale;

my @default = (
               image_dirs   => undef,
               font_dirs    => undef,
               target_dir   => undef,
               lang_id      => undef,

               classes     => undef,      ## Class container
               buttons     => undef,      ## Button hash
               lexicon     => undef,      ## Lexicon object
               );

sub new {
    my $invocant = shift;
    my $class = ref($invocant) || $invocant;

    my $object = {@default, @_};
    $object->{image_dirs}   = [];
    $object->{font_dirs}    = [];


    $object->{classes}      = Image::ButtonMaker::ClassContainer->new();
    $object->{buttons}      = [];

    bless $object, $class;
}

#### Replace path specific properties
sub replace_properties {
    my $self = shift;
    my $butref = shift;
    my $lexicon = $self->{lexicon};
    my $lang_id = $self->{lang_id};

    my %buthash = (@$butref);
    my $properties = $buthash{properties};

    my $noLex = $properties->{NoLexicon} ? 1:0;

    foreach my $key (keys(%$properties)) {
        my $value = $properties->{$key};

        #### Lexicon lookup
        if(!$noLex && ($key eq 'Text')) {
            if($lexicon && length($lang_id)) {
                my $replace = $lexicon->lookup($lang_id, $value);
                if(length($replace)) {
                    $properties->{$key} = $replace;
                } else {
                    print STDERR "WARNING: lexicon lookup($lang_id, $value) returned nothing\n";
                }
            }
        }

        #### Path replacements ################################
        elsif($key eq 'TextFont') {
            my $filename = $self->find_font_file($value);
            print STDERR "WARNING: could not find file for font: $value"
              unless(defined $filename);
            $properties->{$key} = $filename;
        }
        elsif($key eq 'CanvasTemplateImg') {
            $properties->{$key} = $self->find_image_file($value);
        }
        elsif($key eq 'IconName') {
            $properties->{$key} = $self->find_image_file($value);
        }
    }
}


### Instance Specific Methods ########################################
sub read_classfile {
    my $self      = shift;
    while(my $classfile = shift) {
        my $classcontainer = $self->{classes};

        my $classList  = do $classfile;
        die "Error reading classfile $classfile: $@" if($@);
        die "Error reading classfile $classfile: $!" if($!);

        foreach my $class (@$classList) {
            $self->replace_properties($class);
            my $class_obj = Image::ButtonMaker::ButtonClass->new(@$class);
            die "CLASSERROR ($Image::ButtonMaker::ButtonClass::error) $Image::ButtonMaker::ButtonClass::errorstr"
              unless($class_obj);
            $classcontainer->add_class($class_obj);
        }

        die "Could not read classfile $classfile because:\n $@" if($@);
    }

    return 1;
}


sub read_buttonfile {
    my $self       = shift;
    my $buttonfile = shift;

    my $classcontainer  = $self->{classes};
    my $buttoncontainer = $self->{buttons};

    my $buttonList  = do $buttonfile;
    die "Error reading buttonfile $buttonfile: $@" if($@);
    die "Error reading buttonfile $buttonfile: $!" if($!);

    foreach my $button (@$buttonList) {
        $self->replace_properties($button);
        my $button_obj = Image::ButtonMaker::Button->new(@$button,
                                                   classcontainer => $classcontainer);
        die "BUTTERR $Image::ButtonMaker::Button::errorstr" unless($button_obj);

        push @$buttoncontainer, $button_obj;
    }
    return 1;
}


sub clear_buttonlist {
    my $self = shift;
    $self->{buttons} = [];
    return;
}


sub clear_classcontainer {
    my $self = shift;
    $self->{classes} = Image::ButtonMaker::ClassContainer->new;
    return;
}


sub add_image_dir {
    my $self = shift;
    my $dir  = shift;
    die "add_image_dir: Dir $dir not found" unless(-d $dir);

    my $imagedirs = $self->{image_dirs};
    push @$imagedirs, $dir;

    return;
}


sub get_image_dirs {
    my $self = shift;
    return (@{$self->{image_dirs}});
}


sub add_font_dir {
    my $self = shift;
    my $dir  = shift;
    die "add_font_dir: Dir $dir not found" unless(-d $dir);

    my $fontdirs = $self->{font_dirs};
    push @$fontdirs, $dir;

    return;
}


sub get_font_dirs {
    my $self = shift;
    return (@{$self->{font_dirs}});
}


sub set_target_dir {
    my $self = shift;
    $self->{target_dir} = shift;
    return;
}

sub get_target_dir {
    my $self = shift;
    return $self->{target_dir};
}


sub set_lang_id {
    my $self = shift;
    $self->{lang_id} = shift;
    return;
}

sub get_lang_id {
    my $self = shift;
    return $self->{lang_id};
}


sub generate {
    my $self = shift;
    my $buttonlist = $self->{buttons};
    my $target_dir = $self->{target_dir};

    foreach my $but (@$buttonlist) {
        my $img = $but->write($target_dir);
        die "BUTERR: $Image::ButtonMaker::Button::errorstr"
            unless($img);
        #print "BUTFILENAME :",$but->lookup_filename, "\n"
    }
    return;
}

sub find_font_file {
    my $self = shift;
    my $file = shift;
    my $dirs = $self->{font_dirs};

    foreach my $d (@$dirs) {
        return "$d/$file" if(-f "$d/$file");
    }

    return undef;
}

sub find_image_file {
    my $self = shift;
    my $file = shift;
    my $dirs = $self->{image_dirs};
    foreach my $d (@$dirs) {
        return "$d/$file" if(-f "$d/$file");
    }

    return undef;
}

############################################################
## Private-ish methods

sub reset_error {
    my $self = shift;

    $self->{error} = 0;
    $self->{errstr} = '';
    return;
}


sub set_error {
    my $self = shift;

    $self->{error}  = shift;
    $self->{errstr} = shift;
    return;
}

sub is_error {
    my $self = shift;
    return ($self->{error} != 0);
}

#### Package Methods #######################################
sub find_file_in_dirs {
    my $file = shift;
    my $dirs = shift;

    foreach my $d (@$dirs) {
        my $f = "$d/$file";
        return $f if(-f $f);
    }
    return undef;
}

1;
__END__