File Coverage

blib/lib/Tie/CharArray.pm

Criterion	Covered	Total	%
statement	39	59	66.1
branch	5	8	62.5
condition	1	6	16.6
subroutine	16	25	64.0
pod	0	2	0.0
total	61	100	61.0

use strict;
require 5.005; # needs 4-arg substr
$Tie::CharArray::VERSION = '1.00';

# POD documentation after __END__ below

package Tie::CharArray;
use base 'Exporter';
use vars '@EXPORT_OK';
@EXPORT_OK = qw( chars codes );


sub chars ($) {
    tie my @chars, 'Tie::CharArray', $_[0];
    return wantarray ? @chars : \@chars;
}
sub codes ($) {
    tie my @codes, 'Tie::CharArray::Ord', $_[0];
    return wantarray ? @codes : \@codes;
}


sub TIEARRAY {
    my $class = shift;
    require Carp and Carp::carp("Too many parameters for tie to $class")
	 if @_ > 1 and $^W;
    my $self = @_ ? \\$_[0] : \\(my $foo = "");
    bless $self, $class;
}

sub FETCH     { return substr $${$_[0]}, $_[1], 1; }
sub FETCHSIZE { return length $${$_[0]}; }

sub STORE     { substr $${$_[0]}, $_[1], 1, $_[2]; }
sub STORESIZE { substr $${$_[0]}, $_[1], length($${$_[0]})-$_[1], ""; }
sub EXISTS    { return $_[1] < length $${$_[0]}; }

sub CLEAR     { $${$_[0]} = ""; }
sub PUSH      { $${$_[0]} .= join "" => @_[1..$#_]; }
sub POP       { return substr $${$_[0]}, -1, 1, ""; }
sub SHIFT     { return substr $${$_[0]}, 0, 1, ""; }
sub UNSHIFT   { $${$_[0]} = join "" => @_[1..$#_], $${$_[0]}; }
sub SPLICE    { return split // => substr $${$_[0]}, $_[1], $_[2], join "" => @_[3..$#_]; }


package Tie::CharArray::Ord;
use base 'Tie::CharArray';

sub FETCH     { return ord substr $${$_[0]}, $_[1], 1; }
sub STORE     { substr $${$_[0]}, $_[1], 1, chr $_[2]; }
sub PUSH      { $${$_[0]} .= pack 'C*' => @_[1..$#_]; }
sub POP       { return ord substr $${$_[0]}, -1, 1, ""; }
sub SHIFT     { return ord substr $${$_[0]}, 0, 1, ""; }
sub UNSHIFT   { $${$_[0]} = (pack 'C*' => @_[1..$#_]) . $${$_[0]}; }
sub SPLICE    { return unpack 'C*' => substr $${$_[0]}, $_[1], $_[2], pack 'C*' => @_[3..$#_]; }


"That's all, folks!"
__END__