File Coverage

blib/lib/Tie/Hash/Attribute.pm

Criterion	Covered	Total	%
statement	62	64	96.8
branch	22	28	78.5
condition			n/a
subroutine	16	17	94.1
pod			n/a
total	100	109	91.7

package Tie::Hash::Attribute;
use 5.006;
use strict;
use warnings FATAL => 'all';
our $VERSION = '1.06';
our @ISA = 'Tie::Hash';

our $ATTR_SORT = 0;

sub STORE       { $_[0]{$_[1]}=$_[2] }
sub SCALAR      { _mk_str($_[0]) }
sub EXISTS      { exists $_[0]{$_[1]} }
sub FIRSTKEY    { each %{$_[0]} }
sub NEXTKEY     { each %{$_[0]} }
sub DELETE      { delete $_[0]{$_[1]} }
sub CLEAR       { %{$_[0]} = () }

sub TIEHASH {
    my $class = shift;
    my %args  = @_;
    $ATTR_SORT = 1 if defined $args{sorted};
    return bless {}, $class;
}

sub FETCH {
    my $self = shift;
    my $arg  = shift;
    return $self->{$arg} unless substr($arg,0,1) eq '-';
    $arg =~ s/^-//;
    return _mk_str( $self->{$arg} );
}

sub _mk_str {
    my $hash = shift;
    my $str = '';
    my %seen;
    my @keys = $ATTR_SORT ? sort keys %$hash : keys %$hash;
    for my $key (@keys) {
        next if $seen{lc$key}++;
        my $val = $hash->{$key};
        $val  = _stringify( $val )  if ref $val eq 'HASH';
        $val  = _rotate( $val )     if ref $val eq 'ARRAY';
        next unless defined $val;
        $str .= sprintf ' %s="%s"', _key( $key ), _val( $val );
    }
    return $str;
}

sub _key {
    my $key = shift;
    return '' unless defined $key;
    $key =~ s/\s//g;
    $key =~ s/["'>=\/]//g;
    return $key;
}

sub _val {
    my $val = shift;
    $val = '' if $val =~ /^\s+$/;
    $val =~ s/"//g;
    return $val;
}

sub _rotate {
    my $ref  = shift;
    my $next = shift @$ref;
    push @$ref, $next;
    return $next;
}

sub _stringify {
    my $hash = shift;

    my @keys = $ATTR_SORT ? sort keys %$hash : keys %$hash;
    my @vals = map { my $val;

        if (ref $hash->{$_} eq 'ARRAY') {
            $val = _rotate( $hash->{$_} );
        } elsif (ref $hash->{$_} eq 'HASH') {
            ($val) = $ATTR_SORT ? sort keys %{ $hash->{$_} } : keys %{ $hash->{$_} };
        } else {
            $val = $hash->{$_};
        }

        join( ': ', $_, $val);

    } @keys;

    return join( '; ', @vals ) . (@vals > 1 ? ';' : '');
}

1;

__END__