File Coverage

blib/lib/Data/Object/AutoWrap.pm

Criterion	Covered	Total	%
statement	55	56	98.2
branch	20	24	83.3
condition	3	3	100.0
subroutine	12	13	92.3
pod			n/a
total	90	96	93.7

package Data::Object::AutoWrap;

use warnings;
use strict;
use Carp qw( confess croak );

# use Data::Object::AutoWrap::Hash;

$Carp::CarpLevel = 1;

=head1 NAME

Data::Object::AutoWrap - Autogenerate accessors for R/O object data

=head1 VERSION

This document describes Data::Object::AutoWrap version 0.02

=cut

our $VERSION = '0.02';

=head1 SYNOPSIS

    package MyData;

    # Our data is in $self->{data}
    use Data::Object::AutoWrap qw( data );

    sub new {
        my ( $class, $data ) = @_;
        bless { data => $data }, $class;
    }

    # ... and then later, elsewhere ...

    my $d = MyData->new( { foo => 1, bar => [ 1, 2, 3 ] } );
    print $d->foo;         # prints "1"
    print $d->bar( 2 );    # prints "3"

=head1 DESCRIPTION

This is an experimental module designed to simplify the implementation
of read-only objects with value semantics.

Objects created using C are bound to a Perl
data structure. The automatically provide read only accessor methods for
the elements of that structure.

=head2 Declaring an autowrapped class

As in the example above an autowrapped class is created by adding the line

    use Data::Object::AutoWrap qw( fieldname );

We assume (for now) that the class is hash based and that this hash
contains a key called C. The corresponding value is the data
structure that will be exposed as the module's interface. The 'root'
level of this data structure must itself be a hash - we need the key
names so we can generate corresponding methods. Below the root of the
data structure any type may be used.

If the C is omitted the entire contents of the object's hash
will be exposed.

=head2 Accessors

For each key in the value hash a corresponding read-only accessor is
made available. In order for these accessors to be callable the key
names must also be valid Perl method names - it's OK to have a key
called '*(&!*(&£' but it's rather tricky to call the
corresponding accessor.

The generated accessors are AUTOLOADed. As a result the bound data
structure may be a different shape for each instance of the containing
class: the accessors are virtual - they don't actually exist in the
module's symbol table.

In the following examples we'll assume that we have a
C based class called C that gets the
data structure to bind to as the argument to its constructor. The code
fragment in the synopsis is a suitable implementation of such a class.

=head3 Scalar Accessors

Any scalars in the hash get an accessor that takes no arguments and
returns the corresponding value:

    my $sc = MyData->new({ flimp_count => 1 });
    my $fc = $sc->flimp_count; # gets 1

An error is raised if arguments are passed to the accessor.

=head3 Hash Accessors

Any nested hashes in the data structure get accessors that return
recursively wrapped hashes. That means that this will work:

    my $hc = MyData->new(
        {
            person => {
                name => 'Andy',
                job  => 'Perl baiter',
            },
        }
    );

    print $hc->person->job;    # prints "Perl baiter"

=head3 Array accessors

The accessor for array values accepts an optional subscript:

    my $ac = MyData->new( { list => [ 12, 27, 36, 43, ] } );
    my $third = $ac->list( 3 );    # gets 36

Called in a list context with no arguments the accessor for an array
returns that array:

    my @list = $ac->list;   # gets the whole list

=head3 Accessors for other types

Anything that's not an array or a hash gets the scalar accessor - so
things like globs will also be accessible.

=head3 Accessor parameters

Array and hash accessors can accept more than one parameter. For example
if you have an array of arrays you can subscript into it like this:

    my $gc = MyData->new(
        {
            grid => [
                [ 0,  1,  2,  3  ],
                [ 4,  5,  6,  7  ],
                [ 8,  9,  10, 11 ],
                [ 12, 13, 14, 15 ],
            ],
        }
    );

    my $dot = $gc->grid( 3, 4 );    # gets 11

In general any parameters specify a path through the data structure:

    my $hc = MyData->new(
        {
            deep => {
                smash      => 'pumpkins',
                eviscerate => [ 'a', 'b', 'c' ],
                lament => { fine => 'camels' }
            }
        }
    );

    print $hc->deep( 'smash' );                 # 'pumpkins'
    print $hc->deep( 'eviscerate', 1 );         # 'b'
    print $hc->deep( 'lament',     'fine' );    # 'camels'
    print $hc->deep->lament->fine;              # also 'camels'
    print $hc->deep( 'lament' )->fine;          # 'camels' again
    print $hc->deep->lament( 'fine' );          # more 'camels'

=head1 CAVEATS

This is experimental code. Don't be using it in, for example, a life
support system, ATM or space shuttle.

=head2 AUTOLOAD

C injects an C handler into the
package from which it is used. It doesn't care about any existing
C or any that might be provided by a superclass. Given that
it's designed for the implementation of simple, value like objects this
shouldn't be a problem - but you've been warned.

=head2 Performance

It's slow. Slow as mollasses in an igloo. Last time I checked the
autogenerated accessors are something like fifteen times slower than the
simplest hand wrought accessor.

This can probably be improved.

=cut

sub _make_value_handler {
  my ( $class, $value ) = @_;
  if ( 'HASH' eq ref $value ) {
    # Delay loading so we're compiled before wrapper
    # attempts to use us.
    eval 'require Data::Object::AutoWrap::Hash';
    die $@ if $@;
    return sub {
      my $self = shift;
      if ( @_ ) {
        my $key = shift;
        return $class->_make_value_handler( $value->{$key} )
         ->( $self, @_ );
      }
      else {
        return Data::Object::AutoWrap::Hash->new( $value );
      }
    };
  }
  elsif ( 'ARRAY' eq ref $value ) {
    return sub {
      my $self = shift;
      # Special case for ARRAY refs because we can't turn an array
      # ref into an object with an accessor; array items are
      # always accessed by subscripting into the parent object.
      return map {
        'ARRAY' eq ref $_
         ? $_
         : $class->_make_value_handler( $_ )->( $self )
       } @$value
       if wantarray && @_ == 0;
      croak "Array accessor needs an index in scalar context"
       unless @_;
      my $idx = shift;
      return $class->_make_value_handler( $value->[$idx] )
       ->( $self, @_ );
    };
  }
  else {
    return sub {
      my $self = shift;
      croak "Scalar accessor takes no argument"
       if @_;
      return $value;
    };
  }
}

sub import {
  my $class = shift;
  my $pkg   = caller;

  my $get_data;
  if ( @_ ) {
    my $field = shift;
    # TODO: Allow a closure here so objects can be promises
    $get_data = sub { shift->{$field} };
  }
  else {
    $get_data = sub { shift };
  }

  no strict 'refs';
  *{"${pkg}::can"} = sub {
    my ( $self, $method ) = @_;
    my $data = $get_data->( $self );
    return
     exists $data->{$method}
     ? $class->_make_value_handler( $data->{$method} )
     : $pkg->SUPER::can( $method );
  };

  our $AUTOLOAD;
  *{"${pkg}::AUTOLOAD"} = sub {
    my $self = shift;
    ( my $field = $AUTOLOAD ) =~ s/.*://;
    return if $field eq 'DESTROY';
    if ( my $code = $self->can( $field ) ) {
      return $self->$code( @_ );
    }

    confess "Undefined subroutine &$AUTOLOAD called";
  };
}

1;

__END__