bump version to 1.05

fix RT#24839 - new( \%hash )
updated meta files

git-svn-id: https://dagolden.googlecode.com/svn/Class-InsideOut/trunk@938 dfce27d5-b31c-0410-bb09-030b4413eeba

Changes

@@ -1,5 +1,8 @@
 Revision history for Perl module Class::InsideOut
 
+1.05 Sun Feb 11 16:29:16 EST 2007
+    - fixed optional new method with hash reference (RT#24839)
+
 1.04 Thu Jan 18 21:47:19 EST 2007
     - added 'readonly' accessor-creator
 

META.yml

@@ -1,6 +1,6 @@
 ---
 name: Class-InsideOut
-version: 1.0301
+version: 1.05
 author:
   - 'David A. Golden <dagolden@cpan.org>'
 abstract: 'a safe, simple inside-out object construction kit'
@@ -18,13 +18,13 @@ requires:
 provides:
   Class::InsideOut:
     file: lib/Class/InsideOut.pm
-    version: 1.0301
+    version: 1.05
   Class::InsideOut::Manual::About:
     file: lib/Class/InsideOut/Manual/About.pm
-    version: 1.0301
+    version: 1.05
   Class::InsideOut::Manual::Advanced:
     file: lib/Class/InsideOut/Manual/Advanced.pm
-    version: 1.0301
+    version: 1.05
 generated_by: Module::Build version 0.2805
 meta-spec:
   url: http://module-build.sourceforge.net/META-spec-v1.2.html

README

@@ -2,15 +2,16 @@ NAME
     Class::InsideOut - a safe, simple inside-out object construction kit
 
 VERSION
-    This documentation refers to version 1.0301
+    This documentation refers to version 1.05
 
 SYNOPSIS
       package My::Class;
 
-      use Class::InsideOut qw( public private register id );
+      use Class::InsideOut qw( public readonly private register id );
 
-      public     name => my %name;       # accessor: name()
-      private    age  => my %age;        # no accessor
+      public     name => my %name;    # accessor: name()
+      readonly   ssn  => my %ssn;     # read-only accessor: ssn()
+      private    age  => my %age;     # no accessor
 
       sub new { register( shift ) }
 
@@ -72,7 +73,7 @@ USAGE
     As a shortcut, "Class::InsideOut" supports two tags for importing sets
     of functions:
 
-    *   ":std" provides "id", "private", "public" and "register"
+    *   ":std" provides "id", "private", "public", "readonly" and "register"
 
     *   ":all" imports all functions (including an optional constructor)
 
@@ -81,19 +82,21 @@ USAGE
     which this is a good idea.
 
   Object properties and accessors
-    Object properties are declared with the "public" and "private"
-    functions. They must be passed a label and the lexical hash that will be
-    used to store object properties:
+    Object properties are declared with the "public", "readonly" and
+    "private" functions. They must be passed a label and the lexical hash
+    that will be used to store object properties:
 
-      public name => my %name;
-      private age => my %age;
+      public   name => my %name;
+      readonly ssn  => my %ssn;
+      private  age  => my %age;
 
     Properties for an object are accessed through an index into the lexical
     hash based on the memory address of the object. This memory address
     *must* be obtained via "Scalar::Util::refaddr". The alias "id" may be
     imported for brevity.
 
       $name{ refaddr $self } = "James";
+      $ssn { id      $self } = 123456789;
       $age { id      $self } = 32;
 
     Tip: since "refaddr" and "id" are function calls, it may be efficient to
@@ -109,6 +112,17 @@ USAGE
       $person = My::Class->new;
       $person->name( "Larry" );
 
+    Object properties declared with "readonly" will have a read-only
+    accessor created. The accessor will die if passed an argument to set the
+    property value. The property may be set directly in the hash from within
+    the class package as usual.
+
+      # Inside the class
+      $ssn { id $person } = 987654321;
+
+      # Inside or outside the class
+      $person->ssn( 123456789 );      # dies
+
     Property accessors may also be hand-written by declaring the property
     "private" and writing whatever style of accessor is desired. For
     example:
@@ -150,7 +164,10 @@ USAGE
       register( $class ); # same as register( bless \(my $s), $class )
 
     As a convenience, "Class::InsideOut" provides an optional "new"
-    constructor for simple objects.
+    constructor for simple objects. This constructor automatically
+    initializes the object from key/value pairs passed to the constructor
+    for all keys matching the name of a property (including otherwise
+    "private" or "readonly" properties).
 
     A more advanced technique for object construction uses another object,
     usually a superclass object, as the object reference. See "black-box
@@ -263,6 +280,15 @@ FUNCTIONS
     'public'. It will override default options or options passed as an
     argument.
 
+  "readonly"
+      readonly ssn => my %ssn;
+      readonly fingerprint => my %fingerprint, { %options };
+
+    This is an alias to "property" that sets the privacy option to 'public'
+    and adds a "set_hook" option that dies if an attempt is made to use the
+    accessor to change the property. It will override default options or
+    options passed as an argument.
+
   "register"
       register( bless( $object, $class ) ); # register the object 
       register( $reference, $class );       # automatic bless 
@@ -342,7 +368,7 @@ AUTHOR
     http://dagolden.com/
 
 COPYRIGHT AND LICENSE
-    Copyright (c) 2006 by David A. Golden
+    Copyright (c) 2006, 2007 by David A. Golden
 
     This program is free software; you can redistribute it and/or modify it
     under the same terms as Perl itself.

lib/Class/InsideOut.pm

@@ -1,6 +1,6 @@
 package Class::InsideOut;
 
-$VERSION     = "1.04";
+$VERSION     = "1.05";
 @ISA         = qw ( Exporter );
 @EXPORT      = qw ( ); # nothing by default
 @EXPORT_OK   = qw ( new id options private property public readonly register );
@@ -97,7 +97,8 @@ sub new {
 
     # initialization
     croak "Arguments to new must be a hash or hash reference"
-        if ( @_ == 1 && ref($_[0]) && reftype($_[0]) ne 'HASH' ) || ( @_ % 2 );
+        if ( @_ == 1 && ! ( ref $_[0] && reftype($_[0]) eq 'HASH' ) ) 
+        || ( @_ > 1 && @_ % 2 );
 
     my %args = (@_ == 1) ? %{$_[0]} : @_;
 

lib/Class/InsideOut.pod

@@ -8,7 +8,7 @@ Class::InsideOut - a safe, simple inside-out object construction kit
 
 =head1 VERSION
 
-This documentation refers to version 1.04
+This documentation refers to version 1.05
 
 =head1 SYNOPSIS
 

lib/Class/InsideOut/Manual/About.pm

@@ -1,7 +1,7 @@
 package Class::InsideOut::Manual::About;
 # Not really a .pm file, but holds wikidoc which will be
 # turned into .pod by the Build.PL
-$VERSION = "1.04";
+$VERSION = "1.05";
 use strict; # make CPANTS happy
 1;
 __END__

lib/Class/InsideOut/Manual/About.pod

@@ -9,7 +9,7 @@ inside-out technique
 
 =head1 VERSION
 
-This documentation refers to version 1.04
+This documentation refers to version 1.05
 
 =head1 DESCRIPTION
 

lib/Class/InsideOut/Manual/Advanced.pm

@@ -1,7 +1,7 @@
 package Class::InsideOut::Manual::Advanced;
 # Not really a .pm file, but holds wikidoc which will be
 # turned into .pod by the Build.PL
-$VERSION = "1.04";
+$VERSION = "1.05";
 use strict; # make CPANTS happy
 1;
 __END__

lib/Class/InsideOut/Manual/Advanced.pod

@@ -8,7 +8,7 @@ Class::InsideOut::Manual::Advanced - guide to advanced usage
 
 =head1 VERSION
 
-This documentation refers to version 1.04
+This documentation refers to version 1.05
 
 =head1 DESCRIPTION
 

t/21_optional_new.t

@@ -1,38 +1,53 @@
 use strict;
 use Test::More;
 
-$|++; # keep stdout and stderr in order on Win32
+select STDERR; $|++;
+select STDOUT; $|++;
+
+#--------------------------------------------------------------------------#
+
+my $class = "t::Object::WithNew::Inherited";
+my %properties = (
+    name => "Larry",
+    age  => 42,
+);
 
 #--------------------------------------------------------------------------#
 
 my @cases = (
     {
-        label   => q{$class->new( qw/foo/ ) croaks},
-        args    => q{ qw/foo/ },
+        label   => q{new()},
+        args    => [],
+    },
+    {
+        label   => q{new( %hash )},
+        args    => [ %properties ],
+    },
+    {
+        label   => q{new( \%hash )},
+        args    => [\%properties ],
+    },
+);
+
+my @error_cases = (
+    {
+        label   => q{new( qw/foo/ ) croaks},
+        args    => [ qw/foo/ ],
         error   => q{must be a hash or hash reference},
     },
     {
-        label   => q{$class->new( qw/foo bar bam/ ) croaks},
-        args    => q{ qw/foo bar bam/ },
+        label   => q{new( qw/foo bar bam/ ) croaks},
+        args    => [ qw/foo bar bam/ ],
         error   => q{must be a hash or hash reference},
     },
     {
-        label   => q{$class->new( [ qw/foo bar/ ] ) croaks},
-        args    => q{ [ qw/foo bar/ ] },
+        label   => q{new( [ qw/foo bar/ ] ) croaks},
+        args    => [ [qw/foo bar/] ],
         error   => q{must be a hash or hash reference},
     },
 );
 
-plan tests => 10 + @cases; 
-
-#--------------------------------------------------------------------------#
-
-my $class = "t::Object::WithNew::Inherited";
-my %properties = (
-    name => "Larry",
-    age  => 42,
-);
-my $o;
+plan tests => 2 + 2 + 5 * (@cases - 1) + @error_cases; 
 
 #--------------------------------------------------------------------------#
 # test initialization
@@ -42,54 +57,30 @@ require_ok( $class );
 
 can_ok( $class, 'new' );
 
-ok( ($o = $class->new( %properties )) && $o->isa($class),
-    "new( \%hash )"
-);
-
-is( $o->name(), "Larry",
-    "name property initialized correctly"
-);
-
-is( $o->reveal_age, 42,
-    "age property initialized correctly"
-);
-
-is( $o->t::Object::WithNew::reveal_age(), 42,
-    "superclass age property initialized correctly"
-);
-
-#--------------------------------------------------------------------------#
-# hash ref initializer
-#--------------------------------------------------------------------------#
-
-eval { $o = $class->new( \%properties ) };
-ok( $o->isa($class), 
-    'new( $hash_ref )' 
-);
-
-is( $o->name(), "Larry",
-    "name property initialized correctly"
-);
-
-#--------------------------------------------------------------------------#
-# hash based object initializer
-#--------------------------------------------------------------------------#
-
-eval { $o = $class->new( bless {%properties}, "Foo" ) };
-ok( $o->isa($class), 
-    'new( $hash_obj )' 
-);
-
-is( $o->name(), "Larry",
-    "name property initialized correctly"
-);
+for my $case ( @cases ) {
+    my $o;
+    ok( $o = $class->new( @{$case->{args}} ),
+        $case->{label}
+    );
+    isa_ok( $o, $class );
+    next unless scalar @{ $case->{args} };
+    is( $o->name(), "Larry",
+        "name property initialized correctly"
+    );
+    is( $o->reveal_age, 42,
+        "age property initialized correctly"
+    );
+    is( $o->t::Object::WithNew::reveal_age(), 42,
+        "superclass age property initialized correctly"
+    );
+}
 
 #--------------------------------------------------------------------------#
 # error tests
 #--------------------------------------------------------------------------#
 
-for my $case ( @cases ) {
-    eval( "$class->new( " . $case->{args} . ")" );
+for my $case ( @error_cases ) {
+    eval { $class->new( @{ $case->{args} } ) };
     like( $@, "/$case->{error}/i", "$case->{label}");
 }