[Moose-commits] r7672 - in MooseX-GlobRef/trunk: . eg lib/MooseX
lib/MooseX/GlobRef lib/MooseX/GlobRef/Role
lib/MooseX/GlobRef/Role/Meta t/tlib/MooseX
dexter at code2.0beta.co.uk
dexter at code2.0beta.co.uk
Sat Feb 14 12:20:23 GMT 2009
Author: dexter
Date: 2009-02-14 04:20:21 -0800 (Sat, 14 Feb 2009)
New Revision: 7672
Added:
MooseX-GlobRef/trunk/eg/extends_io_file.pl
MooseX-GlobRef/trunk/eg/my_io.pl
Removed:
MooseX-GlobRef/trunk/eg/extends_object.pl
MooseX-GlobRef/trunk/eg/use_metaclass.pl
Modified:
MooseX-GlobRef/trunk/MANIFEST
MooseX-GlobRef/trunk/lib/MooseX/GlobRef.pm
MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Object.pm
MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Role/Meta/Instance.pm
MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Role/Object.pm
MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefBaseTest.pm
MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTest.pm
Log:
* New tests.
* POD changes.
Modified: MooseX-GlobRef/trunk/MANIFEST
===================================================================
--- MooseX-GlobRef/trunk/MANIFEST 2009-02-14 04:59:03 UTC (rev 7671)
+++ MooseX-GlobRef/trunk/MANIFEST 2009-02-14 12:20:21 UTC (rev 7672)
@@ -1,7 +1,7 @@
Build.PL
Changes
-eg/extends_object.pl
-eg/use_metaclass.pl
+eg/extends_io_file.pl
+eg/my_io.pl
Incompatibilities
lib/MooseX/GlobRef.pm
lib/MooseX/GlobRef/Object.pm
@@ -16,12 +16,6 @@
t/010_MooseX_GlobRef.t
t/020_MooseX_GlobRef_Object.t
t/test.pl
-t/tlib/MooseX/GlobRef/Meta/ClassImmutableTest.pm
-t/tlib/MooseX/GlobRef/Meta/ClassTest.pm
-t/tlib/MooseX/GlobRef/Meta/ClassTestSuite.pm
-t/tlib/MooseX/GlobRef/Meta/InstanceImmutableTest.pm
-t/tlib/MooseX/GlobRef/Meta/InstanceTest.pm
-t/tlib/MooseX/GlobRef/Meta/InstanceTestSuite.pm
t/tlib/MooseX/GlobRef/ObjectImmutableTest.pm
t/tlib/MooseX/GlobRef/ObjectTest.pm
t/tlib/MooseX/GlobRef/ObjectTestSuite.pm
Added: MooseX-GlobRef/trunk/eg/extends_io_file.pl
===================================================================
--- MooseX-GlobRef/trunk/eg/extends_io_file.pl (rev 0)
+++ MooseX-GlobRef/trunk/eg/extends_io_file.pl 2009-02-14 12:20:21 UTC (rev 7672)
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+
+use lib 'lib', '../lib';
+
+package My::IO::File;
+
+use Moose;
+use MooseX::GlobRef;
+
+extends 'Moose::Object', 'IO::File';
+with 'MooseX::GlobRef::Role::Object';
+
+has 'file' => (
+ is => 'ro',
+ isa => 'Str',
+ required => 1,
+);
+
+has 'mode' => (
+ is => 'ro',
+ isa => 'Str',
+ default => 'r',
+);
+
+sub BUILD {
+ my ($fh) = @_;
+ $fh->open( $fh->file, $fh->mode );
+};
+
+sub slurp {
+ my ($fh) = @_;
+ local $/ = undef;
+ return $fh->getline;
+};
+
+my $io = My::IO::File->new( file => $ARGV[0] || die "Usage: $0 *file*\n" );
+
+print "::::::::::::::\n";
+print $io->file, "\n";
+print "::::::::::::::\n";
+print $io->getlines;
+print "::::::::::::::\n";
+print $io->dump;
Property changes on: MooseX-GlobRef/trunk/eg/extends_io_file.pl
___________________________________________________________________
Name: svn:executable
+ *
Deleted: MooseX-GlobRef/trunk/eg/extends_object.pl
===================================================================
--- MooseX-GlobRef/trunk/eg/extends_object.pl 2009-02-14 04:59:03 UTC (rev 7671)
+++ MooseX-GlobRef/trunk/eg/extends_object.pl 2009-02-14 12:20:21 UTC (rev 7672)
@@ -1,34 +0,0 @@
-#!/usr/bin/perl
-
-use lib 'lib', '../lib';
-
-package My::IO;
-
-use Moose;
-
-extends 'MooseX::GlobRef::Object';
-
-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 => $ARGV[0] || die "Usage: $0 *file*\n" );
-
-print "::::::::::::::\n";
-print $io->file, "\n";
-print "::::::::::::::\n";
-$io->open;
-print $io->getlines;
Copied: MooseX-GlobRef/trunk/eg/my_io.pl (from rev 7664, MooseX-GlobRef/trunk/eg/extends_object.pl)
===================================================================
--- MooseX-GlobRef/trunk/eg/my_io.pl (rev 0)
+++ MooseX-GlobRef/trunk/eg/my_io.pl 2009-02-14 12:20:21 UTC (rev 7672)
@@ -0,0 +1,37 @@
+#!/usr/bin/perl
+
+use lib 'lib', '../lib';
+
+package My::IO;
+
+use Moose;
+use MooseX::GlobRef;
+
+has 'file' => (
+ is => 'ro',
+ isa => 'Str',
+ required => 1,
+);
+
+sub BUILD {
+ my $self = shift;
+ $self->open;
+};
+
+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 => $ARGV[0] || die "Usage: $0 *file*\n" );
+
+print "::::::::::::::\n";
+print $io->file, "\n";
+print "::::::::::::::\n";
+print $io->getlines;
Property changes on: MooseX-GlobRef/trunk/eg/my_io.pl
___________________________________________________________________
Name: svn:executable
+ *
Deleted: MooseX-GlobRef/trunk/eg/use_metaclass.pl
===================================================================
--- MooseX-GlobRef/trunk/eg/use_metaclass.pl 2009-02-14 04:59:03 UTC (rev 7671)
+++ MooseX-GlobRef/trunk/eg/use_metaclass.pl 2009-02-14 12:20:21 UTC (rev 7672)
@@ -1,36 +0,0 @@
-#!/usr/bin/perl
-
-use lib 'lib', '../lib';
-
-package My::IO;
-
-use metaclass 'Moose::Meta::Class' => (
- instance_metaclass => 'MooseX::GlobRef::Meta::Instance'
-);
-
-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 => $ARGV[0] || die "Usage: $0 *file*\n" );
-
-print "::::::::::::::\n";
-print $io->file, "\n";
-print "::::::::::::::\n";
-$io->open;
-print $io->getlines;
Modified: MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Object.pm
===================================================================
--- MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Object.pm 2009-02-14 04:59:03 UTC (rev 7671)
+++ MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Object.pm 2009-02-14 12:20:21 UTC (rev 7672)
@@ -8,37 +8,20 @@
=head1 SYNOPSIS
- package My::IO;
+ package My::IO::File;
use Moose;
- extends 'MooseX::GlobRef::Object';
+ extends 'MooseX::GlobRef::Object', 'IO::File';
- 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 class extends L<Moose::Object> and is provided only for backward
-compatibility. You should use L<MooseX::GlobRef> instead.
+This class extends L<Moose::Object> with L<MooseX::GlobRef::Role::Object>.
+This class is obsoleted by L<MooseX::GlobRef::Role::Object> and left for
+backward compatibility reason. The L<MooseX::GlobRef> package should be used
+instead.
+
=cut
use 5.006;
@@ -92,7 +75,7 @@
=head1 LICENSE
-Copyright (C) 2007, 2008, 2009 by Piotr Roszatycki E<lt>dexter at debian.orgE<gt>.
+Copyright (C) 2007, 2008, 2009 by Piotr Roszatycki E<lt>dexter at cpan.orgE<gt>.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
Modified: MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Role/Meta/Instance.pm
===================================================================
--- MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Role/Meta/Instance.pm 2009-02-14 04:59:03 UTC (rev 7671)
+++ MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Role/Meta/Instance.pm 2009-02-14 12:20:21 UTC (rev 7672)
@@ -8,42 +8,17 @@
=head1 SYNOPSIS
- package My::IO;
-
- use metaclass 'Moose::Meta::Class' => (
- instance_metaclass => 'MooseX::GlobRef::Meta::Instance'
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => $caller,
+ instance_metaclass_roles =>
+ [ 'MooseX::GlobRef::Role::Meta::Instance' ],
);
- 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 instance metaclass allows to store Moose object in glob reference of
-file handle. It can be used directly with L<metaclass> pragma or with
-L<MooseX::GlobRef::Object> base class.
+file handle. It is applied by L<MooseX::GlobRef>.
-Notice, that C<use metaclass> have to be before C<use Moose>.
-
=cut
use 5.006;
@@ -63,7 +38,7 @@
=over
-=item create_instance
+=item create_instance(I<>) : Object
=cut
@@ -80,23 +55,23 @@
};
-=item clone_instance
+=item clone_instance( I<instance> : Object ) : Object
=cut
override 'clone_instance' => sub {
- my ($self, $instance) = @_;
+ my ($self, $instance) = @_;
# create anonymous file handle
select select my $fh;
# initialize hash slot of file handle
- %{*$fh} = ( %{*$fh} );
+ %{*$fh} = ( %{*$instance} );
return bless $fh => $self->_class_name;
};
-=item get_slot_value
+=item get_slot_value( I<instance> : Object, I<slot_name> : Str ) : Any
=cut
@@ -106,7 +81,7 @@
};
-=item set_slot_value
+=item set_slot_value( I<instance> : Object, I<slot_name> : Str, I<value> : Any ) : Any
=cut
@@ -116,7 +91,7 @@
};
-=item deinitialize_slot
+=item deinitialize_slot( I<instance> : Object, I<slot_name> : Str ) : Any
=cut
@@ -126,7 +101,7 @@
};
-=item is_slot_initialized
+=item is_slot_initialized( I<instance> : Object, I<slot_name> : Str ) : Bool
=cut
@@ -136,7 +111,7 @@
};
-=item weaken_slot_value
+=item weaken_slot_value( I<instance> : Object, I<slot_name> : Str )
=cut
@@ -146,7 +121,7 @@
};
-=item inline_create_instance
+=item inline_create_instance( I<class_variable> : Str ) : Str
=cut
@@ -156,7 +131,7 @@
};
-=item inline_slot_access
+=item inline_slot_access( I<instance_variable> : Str, I<slot_name> : Str ) : Str
The methods overridden by this class.
@@ -165,8 +140,8 @@
=cut
override 'inline_slot_access' => sub {
- my ($self, $instance, $slot_name) = @_;
- return '*{' . $instance . '}->{' . $slot_name . '}';
+ my ($self, $instance_variable, $slot_name) = @_;
+ return '*{' . $instance_variable . '}->{' . $slot_name . '}';
};
@@ -185,7 +160,7 @@
=head1 LICENSE
-Copyright (C) 2007, 2008, 2009 by Piotr Roszatycki E<lt>dexter at debian.orgE<gt>.
+Copyright (C) 2007, 2008, 2009 by Piotr Roszatycki E<lt>dexter at cpan.orgE<gt>.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
Modified: MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Role/Object.pm
===================================================================
--- MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Role/Object.pm 2009-02-14 04:59:03 UTC (rev 7671)
+++ MooseX-GlobRef/trunk/lib/MooseX/GlobRef/Role/Object.pm 2009-02-14 12:20:21 UTC (rev 7672)
@@ -4,21 +4,51 @@
=head1 NAME
-MooseX::GlobRef::Role::Object - A role for MooseX::GlobRef
+MooseX::GlobRef::Role::Object - An object role for MooseX::GlobRef
=head1 SYNOPSIS
- Moose::Util::MetaRole::apply_base_class_roles
- ( for_class => $caller,
- roles =>
- [ 'MooseX::StrictConstructor::Role::Object' ],
- );
+ Moose::Util::MetaRole::apply_base_class_roles(
+ for_class => $caller,
+ roles => [ 'MooseX::GlobRef::Role::Object' ],
+ );
+ package My::IO::File;
+
+ use Moose;
+
+ extends 'Moose::Object', 'IO::File';
+ with 'MooseX::GlobRef::Role::Object';
+
+ has 'file' => ( is => 'ro', isa => 'Str', required => 1 );
+ has 'mode' => ( is => 'ro', isa => 'Str', default => 'r' );
+
+ sub BUILD {
+ my ($fh) = @_;
+ $fh->open( $fh->file, $fh->mode );
+ };
+
+ sub slurp {
+ my ($fh) = @_;
+ local $/ = undef;
+ return $fh->getline;
+ };
+
+ my $io = My::IO::File->new( file => '/etc/passwd' );
+ print "::::::::::::::\n";
+ print $io->file, "\n";
+ print "::::::::::::::\n";
+ print $io->slurp;
+
=head1 DESCRIPTION
This is a role for L<Moose::Object> which is applied by L<MooseX::GlobRef>.
It allows to store Moose object in glob reference of file handle.
+The L<MooseX::GlobRef> package should be used instead for Moose classes but
+the C<MooseX::GlobRef::Role::Object> can be helpful if you want to extend
+non-Moose classes like L<IO::File> or L<File::Temp>.
+
=cut
use 5.006;
@@ -34,8 +64,11 @@
=over
-=item dump
+=item dump( I<maxdepth> : Int = 1 ) : Array|Str
+Dumps the object itself and also a hash slot of glob reference of this object.
+It returns an array or string depended on context.
+
See L<Moose::Object>.
=back
@@ -43,10 +76,11 @@
=cut
override 'dump' => sub {
- my ($self) = @_;
+ my ($self, $maxdepth) = @_;
require Data::Dumper;
- local $Data::Dumper::Maxdepth = shift || 1;
- return super, Data::Dumper::Dumper( \%{*$self} );
+ local $Data::Dumper::Maxdepth = $maxdepth || 1;
+ my @dump = (super, Data::Dumper::Dumper( \%{*$self} ));
+ return wantarray ? @dump : join('', @dump);
};
@@ -69,7 +103,7 @@
=head1 LICENSE
-Copyright (C) 2007, 2008, 2009 by Piotr Roszatycki E<lt>dexter at debian.orgE<gt>.
+Copyright (C) 2007, 2008, 2009 by Piotr Roszatycki E<lt>dexter at cpan.orgE<gt>.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
Modified: MooseX-GlobRef/trunk/lib/MooseX/GlobRef.pm
===================================================================
--- MooseX-GlobRef/trunk/lib/MooseX/GlobRef.pm 2009-02-14 04:59:03 UTC (rev 7671)
+++ MooseX-GlobRef/trunk/lib/MooseX/GlobRef.pm 2009-02-14 12:20:21 UTC (rev 7672)
@@ -122,7 +122,7 @@
=head1 LICENSE
-Copyright (C) 2007, 2008, 2009 by Piotr Roszatycki E<lt>dexter at debian.orgE<gt>.
+Copyright (C) 2007, 2008, 2009 by Piotr Roszatycki E<lt>dexter at cpan.orgE<gt>.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
Modified: MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefBaseTest.pm
===================================================================
--- MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefBaseTest.pm 2009-02-14 04:59:03 UTC (rev 7671)
+++ MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefBaseTest.pm 2009-02-14 12:20:21 UTC (rev 7672)
@@ -45,14 +45,22 @@
my $obj = $mi->create_instance;
assert_not_null($obj);
assert_isa($test_class, $obj);
+ assert_true(! $mi->is_slot_initialized($obj, 'field'));
assert_null($mi->get_slot_value($obj, 'field'));
- assert_true(! $mi->is_slot_initialized($obj, 'field'));
assert_equals(1, $mi->set_slot_value($obj, 'field', 1));
+ assert_true($mi->is_slot_initialized($obj, 'field'));
assert_equals(1, $mi->get_slot_value($obj, 'field'));
- assert_true($mi->is_slot_initialized($obj, 'field'));
assert_true($mi->deinitialize_slot($obj, 'field'));
assert_null($mi->get_slot_value($obj, 'field'));
assert_true(! $mi->is_slot_initialized($obj, 'field'));
+ assert_equals(1, $mi->set_slot_value($obj, 'field', 1));
+ assert_equals(1, $mi->get_slot_value($obj, 'field'));
+
+ my $cloned = $mi->clone_instance( $obj );
+ assert_not_null($cloned);
+ assert_str_not_equals($obj, $cloned);
+ assert_true($mi->is_slot_initialized($cloned, 'field'));
+ assert_equals(1, $mi->get_slot_value($cloned, 'field'));
};
sub test_slot_moc_inline {
@@ -118,6 +126,8 @@
my @dump = $obj->dump;
assert_equals( 2, scalar @dump );
assert_matches( qr/$test_class.*VALUE/s, join '', @dump );
+ my $dump = $obj->dump;
+ assert_matches( qr/$test_class.*VALUE/s, $dump );
};
1;
Modified: MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTest.pm
===================================================================
--- MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTest.pm 2009-02-14 04:59:03 UTC (rev 7671)
+++ MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTest.pm 2009-02-14 12:20:21 UTC (rev 7672)
@@ -8,7 +8,7 @@
package MooseX::GlobRefTest::TestClass;
use Moose;
-
+
use MooseX::GlobRef;
has field => (
More information about the Moose-commits
mailing list