view release on metacpan or  search on metacpan

lib/MooseX/Struct.pm  view on Meta::CPAN

package MooseX::Struct;

use warnings;
use strict;

use Moose ();
use Sub::Install;
use Carp;

our $VERSION = '0.06';

sub import {
   my $class = shift;

   strict->import;
   warnings->import;

   if (@_) {
      my ($name, $attributes) = _parse_arg_structure(@_);

      croak 'Can not build structure out of "main"' if $name eq 'main';

      Moose->import({into  => $name});

      _build_struct($name, $attributes);

      Sub::Install::install_sub({
            into  => $name,
            code  => \&immutable,
            as    => 'immutable',
      });
   } else {
      my $caller = caller;

      Moose->import({into  => $caller}) unless $caller eq 'main';

      Sub::Install::install_sub({
            into  => $caller,
            code  => \&immutable,
            as    => 'immutable',
      });
      Sub::Install::install_sub({
            into  => $caller,
            code  => \&struct,
            as    => 'struct',
      });
   }
}

sub _parse_arg_structure {
   my ($name, $attr);

   my $caller = (caller(1))[0];

   # Check POD for cases
   if (@_ == 1) {
      # One arg, assume ( {} )
      ($name,$attr) = ($caller, shift);
   } elsif (@_ == 2 && ref $_[1] eq 'HASH') {
      # 2 args, second hashref, assume ('', {})
      ($name,$attr) = (shift, shift);
   } else {
      # True: Odd number of args, assume ('', ( '' => $ ))
      # False: Even number of args (second one not hashref), ( ( '' => $ ) )
      $name = (@_ % 2) ? shift : $caller;

      my ($attr_name, $attr_spec);

      while (my $attr_name = shift) {
         $attr_spec = shift;
         if (ref $attr_name eq 'ARRAY') {
            $attr->{$_} = $attr_spec foreach @$attr_name;
         } else {
            $attr->{$attr_name} = $attr_spec;
         }