From: Guillermo Roditi <groditi@gmail.com>
Date: Thu, 24 May 2007 20:58:35 +0000 (+0000)
Subject: use the correct repo layout
X-Git-Tag: 0.00100~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c5a105b3850f1901287595ca26c20b9a8144aabf;p=gitmo%2FMooseX-Emulate-Class-Accessor-Fast.git

use the correct repo layout
---

c5a105b3850f1901287595ca26c20b9a8144aabf
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..c6c9559
--- /dev/null
+++ b/Changes
@@ -0,0 +1,2 @@
+0.0001    May 24, 2007
+          Initial Release!
\ No newline at end of file
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..5019cd6
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,21 @@
+inc/Module/AutoInstall.pm
+inc/Module/Install.pm
+inc/Module/Install/AutoInstall.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Include.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+lib/MooseX/Adopt/Class/Accessor/Fast.pm
+lib/MooseX/Emulate/Class/Accessor/Fast.pm
+Makefile.PL
+MANIFEST			This list of files
+META.yml
+README
+t/accessors.t
+t/adopt.t
+t/getset.t
+t/lib/TestAdoptCAF.pm
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..d6132c9
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,17 @@
+#! /usr/bin/perl -w
+
+# Load the Module::Install bundled in ./inc/
+use inc::Module::Install;
+
+# Define metadata
+name 'MooseX-Emulate-Class-Accessor-Fast';
+abstract 'Emnulate Class::Accessor::Fast using attributes';
+all_from 'lib/MooseX/Emulate/Class/Accessor/Fast.pm';
+
+# Specific dependencies
+requires 'Moose';
+
+build_requires 'Test::More' => 0;
+
+auto_install;
+WriteAll;
diff --git a/README b/README
new file mode 100644
index 0000000..77c8b2a
--- /dev/null
+++ b/README
@@ -0,0 +1,38 @@
+MooseX-Emulate-Class-Accessor-Fast
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+    perl Makefile.PL
+    make
+    make test
+    make install
+
+
+SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the perldoc command.
+
+    perldoc MooseX::Emulate::Class::Accessor::Fast
+
+You can also look for information at:
+
+    Search CPAN
+        http://search.cpan.org/dist/MooseX-Emulate-Class-Accessor-Fast
+
+    CPAN Request Tracker:
+        http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-Emulate-Class-Accessor-Fast
+
+    AnnoCPAN, annotated CPAN documentation:
+        http://annocpan.org/dist/MooseX-Emulate-Class-Accessor-Fast
+
+    CPAN Ratings:
+        http://cpanratings.perl.org/d/MooseX-Emulate-Class-Accessor-Fast
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2007 Guillermo Roditi
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
diff --git a/lib/MooseX/Adopt/Class/Accessor/Fast.pm b/lib/MooseX/Adopt/Class/Accessor/Fast.pm
new file mode 100644
index 0000000..32c96af
--- /dev/null
+++ b/lib/MooseX/Adopt/Class/Accessor/Fast.pm
@@ -0,0 +1,48 @@
+package MooseX::Adopt::Class::Accessor::Fast;
+
+our $VERSION = 0.0001;
+
+$INC{'Class/Accessor/Fast.pm'} = __FILE__;
+
+package Class::Accessor::Fast;
+
+use base qw/MooseX::Emulate::Class::Accessor::Fast/;
+
+1;
+
+=head1 NAME
+
+MooseX::Adopt::Class::Accessor::Fast -
+  Hijack Class::Accessor::Fast in %INC;
+
+=head1 SYNOPSYS
+
+    use MooseX::Adopt::Class::Accessor::Fast;
+    use CAF::Using::Module;
+    #that's it! JustWorks
+
+=head1 DESCRIPTION
+
+This module attempts to hijack L<Class::Accessor::Fast> in %INC and replace it
+with L<MooseX::Emulate::Class::Accessor::Fast>. Make sure it is loaded before the
+classes you have that use <Class::Accessor::Fast>. It is meant as a tool to help
+you migrate your project from L<Class::Accessor::Fast>, to
+ L<MooseX::Emulate::Class::Accessor::Fast> and ultimately, to L<Moose>.
+
+=head1 SEE ALSO
+
+L<Moose>, L<Class::Accessor::Fast>, L<MooseX::Emulate::Class::Accessor::Fast>
+
+=head1 AUTHOR
+
+Matt S Trout
+
+With Contributions from:
+Guillermo Roditi (groditi) <groditi@cpan.org>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
diff --git a/lib/MooseX/Emulate/Class/Accessor/Fast.pm b/lib/MooseX/Emulate/Class/Accessor/Fast.pm
new file mode 100644
index 0000000..14509de
--- /dev/null
+++ b/lib/MooseX/Emulate/Class/Accessor/Fast.pm
@@ -0,0 +1,220 @@
+package MooseX::Emulate::Class::Accessor::Fast;
+
+use Moose;
+
+our $VERSION = 0.0001;
+
+=head1 NAME
+
+MooseX::Emulate::Class::Accessor::Fast -
+  Emulate Class::Accessor::Fast behavior using Moose attributes
+
+=head1 SYNOPSYS
+
+    package MyClass;
+
+    use base 'MooseX::Emulate::Class::Accessor::Fast';
+    #or
+    use Moose;
+    extends 'MooseX::Emulate::Class::Accessor::Fast';
+
+    #fields with readers and writers
+    __PACKAGE__->mk_accessors(qw/field1 field2/);
+    #fields with readers only
+    __PACKAGE__->mk_accessors(qw/field3 field4/);
+    #fields with writers only
+    __PACKAGE__->mk_accessors(qw/field5 field6/);
+
+
+=head1 DESCRIPTION
+
+This module attempts to emulate the behavior of L<Class::Accessor::Fast> as
+accurately as possible using the Moose attribute system. The public API of
+C<Class::Accessor::Fast> is wholly supported, but the private methods are not.
+If you are only using the public methods (as you should) migration should be a
+matter of switching your C<use base> line.
+
+While I have attempted to emulate the behavior of Class::Accessor::Fast as closely
+as possible bugs may still be lurking in edge-cases.
+
+=head1 BEHAVIOR
+
+Simple documentation is provided here for your convenience, but for more thorough
+documentation please see L<Class::Accessor::Fast> and L<Class::Accessor>.
+
+=head2 A note about introspection
+
+Please note that, at this time, the C<is> flag attribute is not being set. To
+determine the C<reader> and C<writer> methods using introspection in later versions
+of L<Class::MOP> ( > 0.38) please use the C<get_read_method> and C<get_write_method>
+methods in L<Class::MOP::Attribute>. Example
+
+    # with Class::MOP <= 0.38
+    my $attr = $self->meta->find_attribute_by_name($field_name);
+    my $reader_method = $attr->reader || $attr->accessor;
+    my $writer_method = $attr->writer || $attr->accessor;
+
+    # with Class::MOP > 0.38
+    my $attr = $self->meta->find_attribute_by_name($field_name);
+    my $reader_method = $attr->get_read_method;
+    my $writer_method = $attr->get_write_method;
+
+=head1 METHODS
+
+=head2 mk_accessors @field_names
+
+Create read-write accessors. An attribute named C<$field_name> will be created.
+The name of the c<reader> and C<writer> methods will be determined by the return
+value of C<accessor_name_for> and C<mutator_name_for>, which by default return the
+name passed unchanged. If the accessor and mutator names are equal the C<accessor>
+attribute will be passes to Moose, otherwise the C<reader> and C<writer> attributes
+will be passed. Please see L<Class::MOP::Attribute> for more information.
+
+=cut
+
+sub mk_accessors{
+  my $self = shift;
+  my $meta = $self->meta;
+  for my $attr_name (@_){
+    my $reader = $self->accessor_name_for($attr_name);
+    my $writer = $self->mutator_name_for( $attr_name);
+    #dont overwrite existing methods
+    my @opts = $reader eq $writer ?
+      ( $self->can($reader) ? () : (accessor => $reader) ) :
+        (
+         ( $self->can($reader) ? () : (reader => $reader) ),
+         ( $self->can($writer) ? () : (writer => $writer) ),
+        );
+    $meta->add_attribute($attr_name, @opts);
+
+    $meta->add_method("_${attr_name}_accessor", $self->can($reader) )
+      if($reader eq $attr_name && !$self->can("_${attr_name}_accessor") );
+  }
+}
+
+=head2 mk_ro_accessors @field_names
+
+Create read-only accessors.
+
+=cut
+
+sub mk_ro_accessors{
+  my $self = shift;
+  my $meta = $self->meta;
+  for my $attr_name (@_){
+    my $reader = $self->accessor_name_for($attr_name);
+    $meta->add_attribute($attr_name,
+                         $self->can($reader) ? () : (reader => $reader) );
+    $meta->add_method("_${attr_name}_accessor", $meta->find_method_by_name($reader))
+      if($reader eq $attr_name && !$self->can("_${attr_name}_accessor") );
+  }
+}
+
+=head2 mk_ro_accessors @field_names
+
+Create write-only accessors.
+
+=cut
+
+#this is retarded.. but we need it for compatibility or whatever.
+sub mk_wo_accessors{
+  my $self = shift;
+  my $meta = $self->meta;
+  for my $attr_name (@_){
+    my $writer = $self->mutator_name_for($attr_name);
+    $meta->add_attribute($attr_name, $self->can($writer) ? () : (writer => $writer) );
+    $meta->add_method("_${attr_name}_accessor", $meta->find_method_by_name($writer))
+      if($writer eq $attr_name && !$self->can("_${attr_name}_accessor") );
+  }
+}
+
+=head2 follow_best_practices
+
+Preface readers with 'get_' and writers with 'set_'.
+See original L<Class::Accessor> documentation for more information.
+
+=cut
+
+sub follow_best_practice{
+  my $self = shift;
+  my $meta = $self->meta;
+
+  $meta->remove_method('mutator_name_for');
+  $meta->remove_method('accessor_name_for');
+  $meta->add_method('mutator_name_for',  sub{ return "set_".$_[1] });
+  $meta->add_method('accessor_name_for', sub{ return "get_".$_[1] });
+}
+
+=head2 mutator_name_for
+
+=head2 accessor_name_for
+
+See original L<Class::Accessor> documentation for more information.
+
+=cut
+
+sub mutator_name_for{  return $_[1] }
+sub accessor_name_for{ return $_[1] }
+
+=head2 set
+
+See original L<Class::Accessor> documentation for more information.
+
+=cut
+
+sub set{
+  my $self = shift;
+  my $k = shift;
+  confess "Wrong number of arguments received" unless scalar @_;
+
+  #my $writer = $self->mutator_name_for( $k );
+  confess "No such attribute  '$k'"
+    unless ( my $attr = $self->meta->find_attribute_by_name($k) );
+  my $writer = $attr->writer || $attr->accessor;
+  $self->$writer(@_ > 1 ? [@_] : @_);
+}
+
+=head2 get
+
+See original L<Class::Accessor> documentation for more information.
+
+=cut
+
+sub get{
+  my $self = shift;
+  confess "Wrong number of arguments received" unless scalar @_;
+
+  my @values;
+  #while( my $attr = $self->meta->find_attribute_by_name( shift(@_) ){
+  for( @_ ){
+    confess "No such attribute  '$_'"
+      unless ( my $attr = $self->meta->find_attribute_by_name($_) );
+    my $reader = $attr->reader || $attr->accessor;
+    @_ > 1 ? push(@values, $self->$reader) : return $self->$reader;
+  }
+
+  return @values;
+}
+
+1;
+
+=head2 meta
+
+See L<Moose::Meta::Class>.
+
+=cut
+
+=head1 SEE ALSO
+
+L<Moose>, L<Moose::Meta::Attribute>, L<Class::Accessor>, L<Class::Accessor::Fast>,
+L<Class::MOP::Attribute>, L<MooseX::Adopt::Class::Accessor::Fast>
+
+=head1 AUTHOR
+
+Guillermo Roditi (groditi) <groditi@cpan.org>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
diff --git a/t/accessors.t b/t/accessors.t
new file mode 100644
index 0000000..5341d75
--- /dev/null
+++ b/t/accessors.t
@@ -0,0 +1,54 @@
+#!perl
+use strict;
+use Test::More tests => 32;
+
+#1
+require_ok("MooseX::Adopt::Class::Accessor::Fast");
+
+my $class = "Testing::Class::Accessor::Fast";
+
+{
+  no strict 'refs';
+  @{"${class}::ISA"} = ('Class::Accessor::Fast');
+  *{"${class}::car"} = sub { shift->_car_accessor(@_); };
+  *{"${class}::mar"} = sub { return "Overloaded"; };
+
+  $class->mk_accessors(qw( foo bar yar car mar ));
+  $class->mk_ro_accessors(qw(static unchanged));
+  $class->mk_wo_accessors(qw(sekret double_sekret));
+  $class->follow_best_practice;
+  $class->mk_accessors(qw( best));
+}
+
+my %attrs = map{$_->name => $_} $class->meta->compute_all_applicable_attributes;
+
+#2
+is(keys %attrs, 10, 'Correct number of attributes');
+
+#3-12
+ok(exists $attrs{$_}, "Attribute ${_} created")
+  for qw( foo bar yar car mar static unchanged sekret double_sekret best );
+
+#13-21
+ok($class->can("_${_}_accessor"), "Attribute ${_} created")
+  for qw( foo bar yar car mar static unchanged sekret double_sekret );
+
+#22-24
+is( $attrs{$_}->accessor, $_, "Accessor ${_} created" )
+  for qw( foo bar yar);
+
+#25,26
+ok( !$attrs{$_}->has_accessor, "Accessor ${_} not created" )
+  for qw( car mar);
+
+#27,28
+is( $attrs{$_}->reader, $_, "Reader ${_} created")
+  for qw( static unchanged );
+
+#29,30
+is( $attrs{$_}->writer, $_, "Writer ${_} created")
+  for qw(sekret double_sekret);
+
+#31,32
+is( $attrs{'best'}->reader, 'get_best', "Reader get_best created");
+is( $attrs{'best'}->writer, 'set_best', "Writer set_best created");
diff --git a/t/adopt.t b/t/adopt.t
new file mode 100644
index 0000000..6cd2831
--- /dev/null
+++ b/t/adopt.t
@@ -0,0 +1,13 @@
+#!perl
+use strict;
+use lib 't/lib';
+use Test::More tests => 6;
+
+#1,2
+require_ok("MooseX::Adopt::Class::Accessor::Fast");
+use_ok('TestAdoptCAF');
+
+#3-6
+ok(TestAdoptCAF->can('meta'), 'Adopt seems to work');
+ok(TestAdoptCAF->meta->find_attribute_by_name($_), "attribute $_ created")
+  for qw(foo bar baz);
diff --git a/t/getset.t b/t/getset.t
new file mode 100644
index 0000000..d3ad761
--- /dev/null
+++ b/t/getset.t
@@ -0,0 +1,14 @@
+#!perl
+use strict;
+use Test::More tests => 3;
+
+require_ok("MooseX::Adopt::Class::Accessor::Fast");
+
+@Foo::ISA = qw(Class::Accessor::Fast);
+Foo->mk_accessors(qw( foo ));
+
+my $test = Foo->new({ foo => 49 });
+
+is( $test->get('foo'), 49, "get initial foo");
+$test->set('foo', 42);
+is($test->get('foo'), 42, "get new foo");
diff --git a/t/lib/TestAdoptCAF.pm b/t/lib/TestAdoptCAF.pm
new file mode 100644
index 0000000..0022be4
--- /dev/null
+++ b/t/lib/TestAdoptCAF.pm
@@ -0,0 +1,9 @@
+package TestAdoptCAF;
+
+use base qw/Class::Accessor::Fast/;
+
+__PACKAGE__->mk_accessors('foo');
+__PACKAGE__->mk_ro_accessors('bar');
+__PACKAGE__->mk_wo_accessors('baz');
+
+1;