Commits

Toby Inkster committed 1a3630b

s/object_id/OBJECT_ID/; add various methods; add alternative constructor

Comments (0)

Files changed (3)

lib/MooX/Struct.pm

 	$MooX::Struct::VERSION   = '0.004';
 }
 
-use Moo         1.000000;
-use Object::ID  0         qw( object_id );
+use Moo          1.000000;
+use Object::ID   0         qw( object_id );
+use Scalar::Does 0         qw( does );
 
 use overload
 	q[""]      => 'TO_STRING',
 	sub TO_ARRAY    {  [ map {;       $_[0]->$_ } $_[0]->FIELDS ] };
 	sub TO_HASH     { +{ map {; $_ => $_[0]->$_ } $_[0]->FIELDS } };
 	sub TO_STRING   { join q[ ], @{ $_[0]->TO_ARRAY } };
-	sub CLONE       { ref($_[0])->new($_[0]->TO_HASH) };
+	sub CLONE       { my $s = shift; ref($s)->new(%{$s->TO_HASH}, @_) };
 };
 
+sub BUILDARGS
+{
+	my $class = shift;
+	if (
+		@_ == 1                 and
+		does($_[0], 'ARRAY')    and
+		not does($_[0], 'HASH')
+	)
+	{
+		my @fields = $class->FIELDS;
+		my @values = @{ $_[0] };
+		Carp::confess("too many values passed to constructor (expected @fields); stopped")
+			unless @fields >= @values;
+		no warnings;
+		return +{
+			map {
+				$fields[$_] => $values[$_];
+			} 0 .. $#values
+		}
+	}
+	return $class->SUPER::BUILDARGS(@_);
+}
+
 BEGIN {
 	package MooX::Struct::Processor;
 	
+	sub _uniq { my %seen; grep { not $seen{$_}++ } @_ };
+	
 	use Moo                  1.000000;
 	use Carp                 0         qw( confess      );
 	use Data::OptList        0         qw(              );
 	use Sub::Install         0         qw( install_sub  );
-	use Scalar::Does         0         qw( does blessed );
+	use Scalar::Does         0         qw( does blessed looks_like_number );
 	use namespace::clean               qw(              );
 	use B::Hooks::EndOfScope           qw( on_scope_end );
-
+	
 	has flags => (
 		is       => 'ro',
 		isa      => sub { die "flags must be HASH" unless does $_[0], 'HASH' },
 		$ENV{PERL_MOOX_STRUCT_TRACE}
 		or shift->flags->{trace};
 	}
-
+	
 	has trace_handle => (
 		is       => 'lazy',
 	);
 		require IO::Handle;
 		\*STDERR;
 	}
-
+	
 	my $counter = 0;
 	sub create_class
 	{
 					unless does($_[0], 'HASH');
 			};
 		}
+		elsif ($name =~ /^\+(.+)/)
+		{
+			$name = $1;
+			$spec{isa} ||= sub {
+				die "wrong type for '$name' (not number)"
+					unless looks_like_number($_[0]);
+			};
+			$spec{default} ||= sub { 0 } unless $spec{required};
+		}
 		elsif ($name =~ /^\$(.+)/)
 		{
 			$name = $1;
 				$self->trace_handle->printf("$code\n");
 			}
 		}
-
+		
 		Moo
 			->_constructor_maker_for($klass)
 			->register_attribute_specs($name, $spec);
 			
 		Moo
 			->_maybe_reset_handlemoose($klass);
-
+		
 		return $name;
 	}
 	
 	sub make_sub
 	{
 		my ($self, $subname, $proto) = @_;
-		return sub ()
+		return sub (;$)
 		{
 			1 if $] < 5.014; # bizarre, but necessary!
 			if (ref $proto)  # inflate!
 			{
 				my $klass  = $self->create_class;
-				my @fields = map {
+				my @fields = _uniq map {
 					$self->process_argument($klass, @$_)
 				} @{ Data::OptList::mkopt($proto) };
 				$self->process_method($klass, FIELDS => sub { @fields });
 				$self->process_method($klass, TYPE   => sub { $subname });
 				$proto = $klass;
 			}
+			return $proto->new(@_) if @_;
 			return $proto;
 		}
 	}
  ;
  
  my $origin = Point3D->new( x => 0, y => 0, z => 0 );
+ 
+ # or...
+ my $origin = Point3D[ 0, 0, 0 ];
 
 =head1 DESCRIPTION
 
 hashref respectively. (Blessed arrayrefs and hashrefs are accepted; as are
 objects which overload C<< @{} >> and C<< %{} >>.) The prefix sigil C<< $ >>
 specifies that the attribute value must not be an unblessed arrayref or hashref.
-The postfix sigil C<< ! >> specifies that the attribute is required.
+The prefix sigil C<< + >> indicates the attribute is a number, and provides
+a default value of 0, unless the attribute is required. The postfix sigil
+C<< ! >> specifies that the attribute is required.
 
  use MooX::Struct
     Person  => [qw( $name! @children )];
 
 Flags C<< -trace >> and C<< -deparse >> may be of use debugging.
 
+=head2 Instantiating Structs
+
+There are two supported methods of instatiating structs. You can use a
+traditional class-like constructor with named parameters:
+
+ my $point = Point->new( x => 1, y => 2 );
+
+Or you can use the abbreviated syntax with positional parameters:
+
+ my $point = Point[ 1, 2 ];
+
+If you know about Moo and peek around in the source code for this module,
+then I'm sure you can figure out additional ways to instantiate them, but
+the above are the only supported two.
+
+When inheritance has been used, it might not always be clear what order
+the positional parameters come in (though see the documentation for the
+C<FIELDS> below), so the traditional class-like style may be preferred.
+
 =head2 Methods
 
 Structs are objects and thus have methods. The following methods are defined:
 Returns a list of fields associated with the object. For the C<Point3D> struct
 in the SYNPOSIS, this would be <c>'x', 'y', 'z'</c>.
 
+The order the fields are returned in is equal to the order they must be supplied
+for the positional constructor.
+
 =item C<TYPE>
 
 Returns the type name of the struct, e.g. <c>'Point3D'</c>.
 
 Creates a shallow clone of the object. 
 
+=item C<BUILDARGS>
+
+Moo internal fu.
+
 =back
 
 With the exception of C<FIELDS> and C<TYPE>, any of these can be overridden

t/07overloading.t

 
 is_deeply( [ @$point2 ], [qw(3 4 5)], "Point3D casts to array properly" );
 
+my $clone = CLONE $point2;
+is("$clone", "3 4 5", "cloning is awesome");
+
 done_testing;

t/08alt-constructor.t

+use Test::More;
+use MooX::Struct
+	Point   => [ qw( +x +y ) ],
+	Point3D => [ -extends => [qw(Point)], qw( +z ) ],
+;
+
+my $point1 = Point[3, 4];
+my $point2 = Point3D[3, 4, 5];
+my $point3 = Point3D[3, 4];
+
+is("$point1", "3 4");
+is("$point2", "3 4 5");
+is("$point3", "3 4 0");
+
+done_testing();