[Moose-commits] r7627 - in MooseX-GlobRef-Object/trunk: .
lib/MooseX/GlobRef lib/MooseX/GlobRef/Meta t
t/tlib/MooseX/GlobRef/Meta
dexter at code2.0beta.co.uk
dexter at code2.0beta.co.uk
Thu Feb 12 16:22:26 GMT 2009
Author: dexter
Date: 2009-02-12 08:22:26 -0800 (Thu, 12 Feb 2009)
New Revision: 7627
Added:
MooseX-GlobRef-Object/trunk/t/010_MooseX_GlobRef_Object.t
MooseX-GlobRef-Object/trunk/t/020_MooseX_GlobRef_Meta_Class.t
MooseX-GlobRef-Object/trunk/t/030_MooseX_GlobRef_Meta_Instance.t
Removed:
MooseX-GlobRef-Object/trunk/t/010_extends_object.t
MooseX-GlobRef-Object/trunk/t/020_metaclass.t
MooseX-GlobRef-Object/trunk/t/030_metaclass_instance.t
Modified:
MooseX-GlobRef-Object/trunk/Changes
MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Meta/Class.pm
MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Meta/Instance.pm
MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Object.pm
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassImmutableTest.pm
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassTest.pm
Log:
* Now works "use metaclass 'MooseX::GlobRef::Meta::Class'".
* Use simpler "*$self->{attr}" syntax for accessing attributes stored in hash
slot of glob reference.
* Refactored t/*.t scripts.
Modified: MooseX-GlobRef-Object/trunk/Changes
===================================================================
--- MooseX-GlobRef-Object/trunk/Changes 2009-02-12 16:06:12 UTC (rev 7626)
+++ MooseX-GlobRef-Object/trunk/Changes 2009-02-12 16:22:26 UTC (rev 7627)
@@ -1,4 +1,13 @@
------------------------------------------------------------------------
+0.06 | Piotr Roszatycki <dexter at debian.org> | 2009-02-12
+
+Changes:
+
+* Now works "use metaclass 'MooseX::GlobRef::Meta::Class'".
+* Use simpler "*$self->{attr}" syntax for accessing attributes stored in hash
+ slot of glob reference.
+
+------------------------------------------------------------------------
0.05 | Piotr Roszatycki <dexter at debian.org> | 2009-01-31
* Attributes are stored in hash slot of glob reference. Previously they were
Modified: MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Meta/Class.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Meta/Class.pm 2009-02-12 16:06:12 UTC (rev 7626)
+++ MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Meta/Class.pm 2009-02-12 16:22:26 UTC (rev 7627)
@@ -6,10 +6,38 @@
MooseX::GlobRef::Meta::Class - Metaclass for globref objects
+=head1 SYNOPSIS
+
+ package My::IO;
+
+ use metaclass 'MooseX::GlobRef::Meta::Class';
+
+ use Moose;
+
+ has 'file' => ( is => 'ro', isa => 'Str', required => 1 );
+
+ sub open {
+ my $fh = shift;
+ open $fh, $fh->file or confess "cannot open";
+ return $fh;
+ };
+
+ sub getlines {
+ my $fh = shift;
+ return readline $fh;
+ };
+
+ my $io = My::IO->new( file => '/etc/passwd' );
+ print "::::::::::::::\n";
+ print $io->file, "\n";
+ print "::::::::::::::\n";
+ $io->open;
+ print $io->getlines;
+
=head1 DESCRIPTION
-This metaclass is used by L<MooseX::GlobRef::Object> base class and it has no
-other purposes and functionality.
+This metaclass is used by L<MooseX::GlobRef::Object> base class and it uses
+L<MooseX::GlobRef::Meta::Instance> as instance metaclass.
=cut
@@ -17,17 +45,12 @@
use strict;
use warnings;
-our $VERSION = '0.05';
+our $VERSION = '0.06';
-use parent 'Moose::Meta::Class';
+use MooseX::GlobRef::Meta::Instance;
-1;
-
-
-__END__
-
=head1 INHERITANCE
=over 2
@@ -70,9 +93,28 @@
=back
+=cut
+
+use parent 'Moose::Meta::Class';
+
+
+sub initialize {
+ my $class = shift;
+ my $pkg = shift;
+ $class->SUPER::initialize(
+ $pkg,
+ instance_metaclass => 'MooseX::GlobRef::Meta::Instance',
+ @_,
+ );
+};
+
+
+1;
+
+
=head1 SEE ALSO
-L<MooseX::GlobRef::Object>, L<Moose::Meta::Object>, L<Moose>, L<metaclass>.
+L<MooseX::GlobRef::Object>, L<Moose::Meta::Class>, L<Moose>, L<metaclass>.
=head1 AUTHOR
Modified: MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Meta/Instance.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Meta/Instance.pm 2009-02-12 16:06:12 UTC (rev 7626)
+++ MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Meta/Instance.pm 2009-02-12 16:22:26 UTC (rev 7627)
@@ -39,7 +39,7 @@
=head1 DESCRIPTION
This instance metaclass allows to store Moose object in glob reference of
-file handle. It can be used directly with C<metaclass> pragma or with
+file handle. It can be used directly with L<metaclass> pragma or with
L<MooseX::GlobRef::Object> base class.
Notice, that C<use metaclass> have to be before C<use Moose>.
@@ -50,122 +50,143 @@
use strict;
use warnings;
-our $VERSION = '0.05';
+our $VERSION = '0.06';
-use parent 'Moose::Meta::Instance';
+=head1 INHERITANCE
+=over 2
-sub create_instance {
- my ($self) = @_;
+=item *
- # create anonymous file handle
- select select my $instance;
+extends L<Moose::Meta::Instance>
- # initialize hash slot of file handle
- %{*$instance} = ();
+=over 2
- return bless $instance => $self->associated_metaclass->name;
-};
+=item *
+extends L<Class::MOP::Instance>
-sub get_slot_value {
- my ($self, $instance, $slot_name) = @_;
- return do { \%{*$instance} }->{$slot_name};
-};
+=over 2
+=item *
-sub set_slot_value {
- my ($self, $instance, $slot_name, $value) = @_;
- return do { \%{*$instance} }->{$slot_name} = $value;
-};
+extends L<Class::MOP::Object>
+=back
-sub deinitialize_slot {
- my ( $self, $instance, $slot_name ) = @_;
- return delete do { \%{*$instance} }->{$slot_name};
-};
+=back
+=back
-sub is_slot_initialized {
- my ($self, $instance, $slot_name) = @_;
- return exists do { \%{*$instance} }->{$slot_name};
-};
+=cut
+use parent 'Moose::Meta::Instance';
-sub weaken_slot_value {
- my ($self, $instance, $slot_name) = @_;
- return Scalar::Util::weaken do { \%{*$instance} }->{$slot_name};
-};
-sub inline_create_instance {
- my ($self, $class_variable) = @_;
- return 'select select my $fh; %{*$fh} = (); bless $fh => ' . $class_variable;
-};
+# Use weaken
+use Scalar::Util ();
-sub inline_slot_access {
- my ($self, $instance, $slot_name) = @_;
- return 'do { \%{*{' . $instance . '}} }->{' . $slot_name . '}';
-};
+=head1 METHODS
+=over
-1;
+=item create_instance
+=cut
-__END__
+sub create_instance {
+ my ($self) = @_;
-=head1 INHERITANCE
+ # create anonymous file handle
+ select select my $fh;
-=over 2
+ # initialize hash slot of file handle
+ %{*$fh} = ();
-=item *
+ return bless $fh => $self->associated_metaclass->name;
+};
-extends L<Moose::Meta::Instance>
-=over 2
+=item get_slot_value
-=item *
+=cut
-extends L<Class::MOP::Instance>
+sub get_slot_value {
+ my ($self, $instance, $slot_name) = @_;
+ return *$instance->{$slot_name};
+};
-=over 2
-=item *
+=item set_slot_value
-extends L<Class::MOP::Object>
+=cut
-=back
+sub set_slot_value {
+ my ($self, $instance, $slot_name, $value) = @_;
+ return *$instance->{$slot_name} = $value;
+};
-=back
-=back
+=item deinitialize_slot
-=head1 METHODS
+=cut
-=over
+sub deinitialize_slot {
+ my ( $self, $instance, $slot_name ) = @_;
+ return delete *$instance->{$slot_name};
+};
-=item create_instance
-=item get_slot_value
+=item is_slot_initialized
-=item set_slot_value
+=cut
-=item deinitialize_slot
+sub is_slot_initialized {
+ my ($self, $instance, $slot_name) = @_;
+ return exists *$instance->{$slot_name};
+};
-=item is_slot_initialized
=item weaken_slot_value
+=cut
+
+sub weaken_slot_value {
+ my ($self, $instance, $slot_name) = @_;
+ return Scalar::Util::weaken *$instance->{$slot_name};
+};
+
+
=item inline_create_instance
+=cut
+
+sub inline_create_instance {
+ my ($self, $class_variable) = @_;
+ return 'select select my $fh; %{*$fh} = (); bless $fh => ' . $class_variable;
+};
+
+
=item inline_slot_access
The methods overridden by this class.
=back
+=cut
+
+sub inline_slot_access {
+ my ($self, $instance, $slot_name) = @_;
+ return '*{' . $instance . '}->{' . $slot_name . '}';
+};
+
+
+1;
+
+
=head1 SEE ALSO
L<MooseX::GlobRef::Object>, L<Moose::Meta::Instance>, L<Moose>, L<metaclass>.
Modified: MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Object.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Object.pm 2009-02-12 16:06:12 UTC (rev 7626)
+++ MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Object.pm 2009-02-12 16:22:26 UTC (rev 7627)
@@ -47,7 +47,7 @@
or shorter:
- print do { \%{*$self} }->{key};
+ print *$self->{key};
but the standard accessors should be used instead:
@@ -62,23 +62,14 @@
use strict;
use warnings;
-our $VERSION = '0.05';
+our $VERSION = '0.06';
use metaclass 'MooseX::GlobRef::Meta::Class' => (
- instance_metaclass => 'MooseX::GlobRef::Meta::Instance'
+# instance_metaclass => 'MooseX::GlobRef::Meta::Instance'
);
-use parent 'Moose::Object';
-
-1;
-
-
-__END__
-
-=for readme stop
-
=head1 INHERITANCE
=over 2
@@ -89,6 +80,16 @@
=back
+=cut
+
+use parent 'Moose::Object';
+
+
+1;
+
+
+=for readme stop
+
=head1 SEE ALSO
L<MooseX::GlobRef::Meta::Instance>, L<MooseX::GlobRef::Meta::Class>,
Copied: MooseX-GlobRef-Object/trunk/t/010_MooseX_GlobRef_Object.t (from rev 7618, MooseX-GlobRef-Object/trunk/t/010_extends_object.t)
===================================================================
--- MooseX-GlobRef-Object/trunk/t/010_MooseX_GlobRef_Object.t (rev 0)
+++ MooseX-GlobRef-Object/trunk/t/010_MooseX_GlobRef_Object.t 2009-02-12 16:22:26 UTC (rev 7627)
@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use File::Spec;
+use Cwd;
+
+BEGIN {
+ unshift @INC, map { /(.*)/; $1 } split(/:/, $ENV{PERL5LIB}) if defined $ENV{PERL5LIB} and ${^TAINT};
+
+ my $cwd = ${^TAINT} ? do { local $_=getcwd; /(.*)/; $1 } : '.';
+ unshift @INC, File::Spec->catdir($cwd, 't/tlib');
+};
+
+use Test::Unit::Lite;
+
+local $SIG{__WARN__} = sub { require Carp; Carp::confess("Warning: ", @_) };
+
+my $suite = __FILE__;
+$suite =~ s/.*\d{3}_(.*)\.t/$1/ or die;
+$suite =~ s/_/::/g;
+$suite .= "TestSuite";
+
+Test::Unit::HarnessUnit->new->start($suite);
Property changes on: MooseX-GlobRef-Object/trunk/t/010_MooseX_GlobRef_Object.t
___________________________________________________________________
Name: svn:mergeinfo
+
Deleted: MooseX-GlobRef-Object/trunk/t/010_extends_object.t
===================================================================
--- MooseX-GlobRef-Object/trunk/t/010_extends_object.t 2009-02-12 16:06:12 UTC (rev 7626)
+++ MooseX-GlobRef-Object/trunk/t/010_extends_object.t 2009-02-12 16:22:26 UTC (rev 7627)
@@ -1,20 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use File::Spec;
-use Cwd;
-
-BEGIN {
- unshift @INC, map { /(.*)/; $1 } split(/:/, $ENV{PERL5LIB}) if defined $ENV{PERL5LIB} and ${^TAINT};
-
- my $cwd = ${^TAINT} ? do { local $_=getcwd; /(.*)/; $1 } : '.';
- unshift @INC, File::Spec->catdir($cwd, 't/tlib');
-};
-
-use Test::Unit::Lite;
-
-local $SIG{__WARN__} = sub { require Carp; Carp::confess("Warning: $_[0]") };
-
-Test::Unit::HarnessUnit->new->start('MooseX::GlobRef::ObjectTestSuite');
Copied: MooseX-GlobRef-Object/trunk/t/020_MooseX_GlobRef_Meta_Class.t (from rev 7618, MooseX-GlobRef-Object/trunk/t/020_metaclass.t)
===================================================================
--- MooseX-GlobRef-Object/trunk/t/020_MooseX_GlobRef_Meta_Class.t (rev 0)
+++ MooseX-GlobRef-Object/trunk/t/020_MooseX_GlobRef_Meta_Class.t 2009-02-12 16:22:26 UTC (rev 7627)
@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use File::Spec;
+use Cwd;
+
+BEGIN {
+ unshift @INC, map { /(.*)/; $1 } split(/:/, $ENV{PERL5LIB}) if defined $ENV{PERL5LIB} and ${^TAINT};
+
+ my $cwd = ${^TAINT} ? do { local $_=getcwd; /(.*)/; $1 } : '.';
+ unshift @INC, File::Spec->catdir($cwd, 't/tlib');
+};
+
+use Test::Unit::Lite;
+
+local $SIG{__WARN__} = sub { require Carp; Carp::confess("Warning: ", @_) };
+
+my $suite = __FILE__;
+$suite =~ s/.*\d{3}_(.*)\.t/$1/ or die;
+$suite =~ s/_/::/g;
+$suite .= "TestSuite";
+
+Test::Unit::HarnessUnit->new->start($suite);
Property changes on: MooseX-GlobRef-Object/trunk/t/020_MooseX_GlobRef_Meta_Class.t
___________________________________________________________________
Name: svn:mergeinfo
+
Deleted: MooseX-GlobRef-Object/trunk/t/020_metaclass.t
===================================================================
--- MooseX-GlobRef-Object/trunk/t/020_metaclass.t 2009-02-12 16:06:12 UTC (rev 7626)
+++ MooseX-GlobRef-Object/trunk/t/020_metaclass.t 2009-02-12 16:22:26 UTC (rev 7627)
@@ -1,20 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use File::Spec;
-use Cwd;
-
-BEGIN {
- unshift @INC, map { /(.*)/; $1 } split(/:/, $ENV{PERL5LIB}) if defined $ENV{PERL5LIB} and ${^TAINT};
-
- my $cwd = ${^TAINT} ? do { local $_=getcwd; /(.*)/; $1 } : '.';
- unshift @INC, File::Spec->catdir($cwd, 't/tlib');
-};
-
-use Test::Unit::Lite;
-
-local $SIG{__WARN__} = sub { require Carp; Carp::confess("Warning: $_[0]") };
-
-Test::Unit::HarnessUnit->new->start('MooseX::GlobRef::Meta::ClassTestSuite');
Copied: MooseX-GlobRef-Object/trunk/t/030_MooseX_GlobRef_Meta_Instance.t (from rev 7618, MooseX-GlobRef-Object/trunk/t/030_metaclass_instance.t)
===================================================================
--- MooseX-GlobRef-Object/trunk/t/030_MooseX_GlobRef_Meta_Instance.t (rev 0)
+++ MooseX-GlobRef-Object/trunk/t/030_MooseX_GlobRef_Meta_Instance.t 2009-02-12 16:22:26 UTC (rev 7627)
@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use File::Spec;
+use Cwd;
+
+BEGIN {
+ unshift @INC, map { /(.*)/; $1 } split(/:/, $ENV{PERL5LIB}) if defined $ENV{PERL5LIB} and ${^TAINT};
+
+ my $cwd = ${^TAINT} ? do { local $_=getcwd; /(.*)/; $1 } : '.';
+ unshift @INC, File::Spec->catdir($cwd, 't/tlib');
+};
+
+use Test::Unit::Lite;
+
+local $SIG{__WARN__} = sub { require Carp; Carp::confess("Warning: ", @_) };
+
+my $suite = __FILE__;
+$suite =~ s/.*\d{3}_(.*)\.t/$1/ or die;
+$suite =~ s/_/::/g;
+$suite .= "TestSuite";
+
+Test::Unit::HarnessUnit->new->start($suite);
Property changes on: MooseX-GlobRef-Object/trunk/t/030_MooseX_GlobRef_Meta_Instance.t
___________________________________________________________________
Name: svn:mergeinfo
+
Deleted: MooseX-GlobRef-Object/trunk/t/030_metaclass_instance.t
===================================================================
--- MooseX-GlobRef-Object/trunk/t/030_metaclass_instance.t 2009-02-12 16:06:12 UTC (rev 7626)
+++ MooseX-GlobRef-Object/trunk/t/030_metaclass_instance.t 2009-02-12 16:22:26 UTC (rev 7627)
@@ -1,20 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use File::Spec;
-use Cwd;
-
-BEGIN {
- unshift @INC, map { /(.*)/; $1 } split(/:/, $ENV{PERL5LIB}) if defined $ENV{PERL5LIB} and ${^TAINT};
-
- my $cwd = ${^TAINT} ? do { local $_=getcwd; /(.*)/; $1 } : '.';
- unshift @INC, File::Spec->catdir($cwd, 't/tlib');
-};
-
-use Test::Unit::Lite;
-
-local $SIG{__WARN__} = sub { require Carp; Carp::confess("Warning: $_[0]") };
-
-Test::Unit::HarnessUnit->new->start('MooseX::GlobRef::Meta::InstanceTestSuite');
Modified: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassImmutableTest.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassImmutableTest.pm 2009-02-12 16:06:12 UTC (rev 7626)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassImmutableTest.pm 2009-02-12 16:22:26 UTC (rev 7627)
@@ -11,9 +11,6 @@
{
package MooseX::GlobRef::Meta::ClassImmutableTest::Test1;
- # Use just class metaclass without instance metaclass, so original hashref
- # object will be used.
-
use metaclass 'MooseX::GlobRef::Meta::Class';
use Moose;
@@ -29,7 +26,7 @@
my $obj = MooseX::GlobRef::Meta::ClassImmutableTest::Test1->new;
assert_not_null($obj);
assert_true($obj->isa('MooseX::GlobRef::Meta::ClassImmutableTest::Test1'));
- assert_equals('HASH', reftype($obj));
+ assert_equals('GLOB', reftype($obj));
};
sub test_accessor {
Modified: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassTest.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassTest.pm 2009-02-12 16:06:12 UTC (rev 7626)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassTest.pm 2009-02-12 16:22:26 UTC (rev 7627)
@@ -11,9 +11,6 @@
{
package MooseX::GlobRef::Meta::ClassTest::Test1;
- # Use just class metaclass without instance metaclass, so original hashref
- # object will be used.
-
use metaclass 'MooseX::GlobRef::Meta::Class';
use Moose;
@@ -27,7 +24,7 @@
my $obj = MooseX::GlobRef::Meta::ClassTest::Test1->new;
assert_not_null($obj);
assert_true($obj->isa('MooseX::GlobRef::Meta::ClassTest::Test1'));
- assert_equals('HASH', reftype($obj));
+ assert_equals('GLOB', reftype($obj));
};
sub test_accessor {
More information about the Moose-commits
mailing list