File Coverage

blib/lib/Lego/From/PNG/Brick.pm

Criterion	Covered	Total	%
statement	16	72	22.2
branch	0	16	0.0
condition	0	18	0.0
subroutine	6	16	37.5
pod	10	10	100.0
total	32	132	24.2

package Lego::From::PNG::Brick;

use strict;
use warnings;

BEGIN {
    $Lego::From::PNG::Brick::VERSION = '0.03';
}

use Lego::From::PNG::Const qw(:all);

use Data::Debug;

sub new {
    my $class = shift;
    my %args = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;

    my $hash = {};

    $hash->{$_} = $args{$_} for(qw(color depth length height meta));

    die "Invalid color" if ! scalar( grep { $_ eq $hash->{'color'} } LEGO_COLORS );

    # Default any undefined dimensions to 1
    $hash->{'depth'}  ||= 1;
    $hash->{'length'} ||= 1;
    $hash->{'height'} ||= 1;

    # Default meta to an empty hashref if it is undefined or an invalid ref
    $hash->{'meta'} = (! $hash->{'meta'} || ref($hash->{'meta'}) ne 'HASH') ? {} : $hash->{'meta'};

    my $self = bless ($hash, ref ($class) || $class);

    return $self;
}

sub id { &identifier }
sub identifier {
    my $self = shift;

    return $self->{'id'} ||= $self->color.'_'.join('x',$self->depth,$self->length,$self->height);
}

sub color  {
    my $self = shift;
    my $val  = shift;

    if(defined $val) {
        die "Invalid color" if ! scalar( grep { $_ eq $val } LEGO_COLORS );

        $self->{'color'} = $val;

        delete $self->{'id'};         # Clear out id
        delete $self->{'color_info'}; # Clear out color info on color change
    }

    return $self->{'color'};
}

sub depth {
    my $self = shift;
    my $val  = shift;

    if(defined $val) {
        $self->{'depth'} = $val * 1;

        delete $self->{'id'}; # Clear out id
    }

    return $self->{'depth'};
}

sub length {
    my $self = shift;
    my $val  = shift;

    if(defined $val) {
        $self->{'length'} = $val * 1;

        delete $self->{'id'}; # Clear out id
    }

    return $self->{'length'};
}

sub height {
    my $self = shift;
    my $val  = shift;

    if(defined $val) {
        $self->{'height'} = $val * 1;

        delete $self->{'id'}; # Clear out id
    }

    return $self->{'height'};
}

sub meta { shift->{'meta'} }

sub color_info {
    my $self = shift;

    return $self->{'color_info'} ||= do {
        my $color = $self->color;

        my ($on_key, $cn_key, $hex_key, $r_key, $g_key, $b_key) = (
            $color . '_OFFICIAL_NAME',
            $color . '_COMMON_NAME',
            $color . '_HEX_COLOR',
            $color . '_RGB_COLOR_RED',
            $color . '_RGB_COLOR_GREEN',
            $color . '_RGB_COLOR_BLUE',
        );

        no strict 'refs';

        +{
            'cid'           => $color,
            'official_name' => Lego::From::PNG::Const->$on_key,
            'common_name'   => Lego::From::PNG::Const->$cn_key,
            'hex_color'     => Lego::From::PNG::Const->$hex_key,
            'rgb_color'     => [
                Lego::From::PNG::Const->$r_key,
                Lego::From::PNG::Const->$g_key,
                Lego::From::PNG::Const->$b_key,
            ],
        };
    };
}

sub flatten {
    my $self = shift;

    $self->identifier; # Make sure it's generated

    my %hash;
    my @keys = qw(id color depth length height meta);

    @hash{ @keys } = @{ $self }{ @keys };

    return \%hash;
}

=pod

=head1 NAME

Lego::From::PNG::Brick - A simple representation of a lego brick

=head1 SYNOPSIS

  use Lego::From::PNG::Brick;

  my ($color, $depth, $length, $height) = ('BLACK', 1, 2, 1);

  # depth x length x height
  my $object = Lego::From::PNG::Brick->new(
      color  => $color,
      depth  => $depth,
      length => $length,
      height => $height,
      meta   => {} # Anything else we want to track
  );

  # Get at the data with accessors

=head1 DESCRIPTION

Representation of a Lego Brick plus additional meta data about that brick

=head1 USAGE

=head2 new

 Usage     : ->new()
 Purpose   : Returns Lego::From::PNG::Brick object

 Returns   : Lego::From::PNG::Brick object
 Argument  :
                color  -> must be a valid color from L
                depth  -> brick depth, defaults to 1
                length -> brick length, defaults to 1
                height -> brick height, defaults to 1
                meta   -> a hashref of additional meta data for the instanciated brick
 Throws    : Dies if the color is invalid

 Comment   : Clobbers meta if it's not a valid hashref
 See Also  :

=head2 id

See identifier

=head2 identifier

 Usage     : ->identifier()
 Purpose   : Returns brick id, which is based on color, depth, length and width

 Returns   : the indentifier. Format: _xx
 Argument  :
 Throws    :

 Comment   : Identifiers aren't necessarily unique, more than one brick could have the same identifier and different meta for instance
 See Also  :


=head2 color

 Usage     : ->color() or ->color($new_color)
 Purpose   : Returns lego color for the brick, optionally a new color may be set

 Returns   : lego color value for this brick
 Argument  : Optional. Pass a scalar with a new valid color value to change the bricks color
 Throws    :

 Comment   :
 See Also  :

=head2 depth

 Usage     : ->depth() or ->depth($new_number)
 Purpose   : Returns depth for the brick, optionally a new depth may be set

 Returns   : depth value for this brick
 Argument  : Optional. Pass a scalar with a new valid depth value to change the bricks depth
 Throws    :

 Comment   :
 See Also  :

=head2 length

 Usage     : ->length() or ->length($new_number)
 Purpose   : Returns length for the brick, optionally a new length may be set

 Returns   : length value for this brick
 Argument  : Optional. Pass a scalar with a new valid length value to change the bricks length
 Throws    :

 Comment   :
 See Also  :

=head2 height

 Usage     : ->height() or ->height($new_number)
 Purpose   : Returns height for the brick, optionally a new height may be set

 Returns   : height value for this brick
 Argument  : Optional. Pass a scalar with a new valid height value to change the bricks height
 Throws    :

 Comment   :
 See Also  :

=head2 meta

 Usage     : ->meta()
 Purpose   : Returns brick meta data

 Returns   : brick meta data
 Argument  :
 Throws    :

 Comment   :
 See Also  :

=head2 color_info

 Usage     : ->color_info()
 Purpose   : Returns hash of color info related to bricks current color

 Returns   : hash of color info
 Argument  :
 Throws    :

 Comment   :
 See Also  :

=head2 flatten

 Usage     : ->flatten()
 Purpose   : Returns an unblessed version of the data

 Returns   : hashref of brick data
 Argument  :
 Throws    :

 Comment   :
 See Also  :

=head1 BUGS

=head1 SUPPORT

=head1 AUTHOR

    Travis Chase
    CPAN ID: GAUDEON
    [e-mail]
    https://github.com/gaudeon/Lego-From-Png

=head1 COPYRIGHT

This program is free software licensed under the...

    The MIT License

The full text of the license can be found in the
LICENSE file included with this module.

=head1 SEE ALSO

perl(1).

=cut

1;