[Moose-commits] r7432 - in MooseX-ExtendsNonMoose/trunk: eg lib/MooseX lib/MooseX/ExtendsNonMoose

[dexter at code2.0beta.co.uk]

Author: dexter
Date: 2009-01-30 09:15:40 -0800 (Fri, 30 Jan 2009)
New Revision: 7432

Added:
   MooseX-ExtendsNonMoose/trunk/eg/file_temp_jpg.pl
   MooseX-ExtendsNonMoose/trunk/lib/MooseX/ExtendsNonMoose.pm
   MooseX-ExtendsNonMoose/trunk/lib/MooseX/ExtendsNonMoose/Object.pm
Log:
* POD.

Added: MooseX-ExtendsNonMoose/trunk/eg/file_temp_jpg.pl
===================================================================
--- MooseX-ExtendsNonMoose/trunk/eg/file_temp_jpg.pl	                        (rev 0)
+++ MooseX-ExtendsNonMoose/trunk/eg/file_temp_jpg.pl	2009-01-30 17:15:40 UTC (rev 7432)
@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+
+use lib 'lib', '../lib';
+
+
+package File::Temp::JPEG;
+
+use Moose;
+use MooseX::ExtendsNonMoose;
+
+extends 'File::Temp', 'MooseX::GlobRef::Object';
+extends_non_moose;
+
+has 'SUFFIX' => (is => 'ro', isa => 'Str');
+has 'UNLINK' => (is => 'ro', isa => 'Bool');
+
+sub new_with_suffix {
+    my $class = shift;
+    return $class->new( SUFFIX => '.jpg', @_ );
+};
+
+
+package main;
+
+my $jpg = File::Temp::JPEG->new_with_suffix;
+print "Temporary file: $jpg\n";


Property changes on: MooseX-ExtendsNonMoose/trunk/eg/file_temp_jpg.pl
___________________________________________________________________
Name: svn:mime-type
   + text/plain

Added: MooseX-ExtendsNonMoose/trunk/lib/MooseX/ExtendsNonMoose/Object.pm
===================================================================
--- MooseX-ExtendsNonMoose/trunk/lib/MooseX/ExtendsNonMoose/Object.pm	                        (rev 0)
+++ MooseX-ExtendsNonMoose/trunk/lib/MooseX/ExtendsNonMoose/Object.pm	2009-01-30 17:15:40 UTC (rev 7432)
@@ -0,0 +1,43 @@
+#!/usr/bin/perl -c
+
+package MooseX::ExtendsNonMoose::Object;
+
+=head1 NAME
+
+MooseX::ExtendsNonMoose::Object - Base class for non-Moose based
+
+=head1 SYNOPSIS
+
+  package My::File::Temp;
+
+  use Moose;
+  use MooseX::ExtendsNonMoose;
+
+  extends 'File::Temp';
+  extends_non_moose;
+
+  has 'UNLINK' => (is => 'ro', isa => 'Bool');
+
+
+  package main;
+
+  my $tmp = My::File::Temp->( UNLINK => 'Bad String' );
+
+=head1 DESCRIPTION
+
+This extension adds new keyword C<extends_non_moose> which replaces
+standard L<Moose::Object> constructor C<new> with the one which
+works well with non-Moose based classes and adds the
+L<MooseX::ExtendsNonMoose::Object> as a base class.
+
+=back
+
+=for readme stop
+
+=cut
+
+use Moose;
+
+extends 'Moose::Object';
+
+1;


Property changes on: MooseX-ExtendsNonMoose/trunk/lib/MooseX/ExtendsNonMoose/Object.pm
___________________________________________________________________
Name: svn:mime-type
   + text/plain

Added: MooseX-ExtendsNonMoose/trunk/lib/MooseX/ExtendsNonMoose.pm
===================================================================
--- MooseX-ExtendsNonMoose/trunk/lib/MooseX/ExtendsNonMoose.pm	                        (rev 0)
+++ MooseX-ExtendsNonMoose/trunk/lib/MooseX/ExtendsNonMoose.pm	2009-01-30 17:15:40 UTC (rev 7432)
@@ -0,0 +1,109 @@
+#!/usr/bin/perl -c
+
+package MooseX::ExtendsNonMoose;
+
+=head1 NAME
+
+MooseX::ExtendsNonMoose - Extends non-Moose class
+
+=head1 SYNOPSIS
+
+  package File::Temp::JPEG;
+
+  use Moose;
+  use MooseX::ExtendsNonMoose;
+
+  extends 'File::Temp';
+  extends_non_moose;
+
+  has 'SUFFIX' => (is => 'ro', isa => 'Str');
+  has 'UNLINK' => (is => 'ro', isa => 'Bool');
+
+  sub new_with_suffix {
+      my $class = shift;
+      return $class->new( SUFFIX => '.jpg', @_ );
+  };
+
+
+  package main;
+
+  my $jpg = File::Temp::JPEG->new_with_suffix;
+  print "Temporary file: $jpg\n";
+
+=head1 DESCRIPTION
+
+This extension adds new keyword C<extends_non_moose> which replaces
+standard L<Moose::Object> constructor C<new> with the one which
+works well with non-Moose based classes and adds the
+L<MooseX::ExtendsNonMoose::Object> as a base class.
+
+=back
+
+=for readme stop
+
+=cut
+
+use 5.008;
+use strict;
+use warnings;
+
+our $VERSION = '0.0001';
+
+use Moose ();
+
+use Moose::Exporter;
+
+use MooseX::ExtendsNonMoose::Object;
+
+use constant base_class => 'MooseX::ExtendsNonMoose::Object';
+
+
+Moose::Exporter->setup_import_methods(
+    with_caller => [ 'extends_non_moose' ],
+    also        => 'Moose',
+);
+
+
+sub extends_non_moose {
+    my $for_class = shift;
+    my @constructors = @_ ? @_ : ('new'); 
+
+    # my $meta = Moose::Meta::Class->initialize($for_class);
+    my $meta = $for_class->meta;
+
+    $meta->superclasses($meta->superclasses, base_class);
+
+
+    foreach my $constructor (@constructors) {
+        # explicit constructor for non-Moose based object
+        $for_class->meta->add_method( $constructor => sub {
+            my $class = shift;
+
+            my $super_constructor = $for_class->meta->find_next_method_by_name($constructor)->body
+                or Moose->throw_error("Can't locate object method ($constructor) via package ($for_class)");
+
+            my @args = $class->can('SUPERBUILDARGS') ? $class->SUPERBUILDARGS(@_) : (@_);    
+
+            my $self = $class->meta->new_object(
+                # pass in the constructed object
+                # using the special key __INSTANCE__
+                __INSTANCE__ => $super_constructor->($class, @args),
+                @_, # pass in the normal args
+            );
+
+            my $params = $class->BUILDARGS(@_);
+            $self->BUILDALL($params);
+
+            return $self;
+        } );
+    };
+};
+
+
+sub init_meta {
+    shift;
+    Moose->init_meta( @_, base_class => base_class );
+};
+
+
+1;


Property changes on: MooseX-ExtendsNonMoose/trunk/lib/MooseX/ExtendsNonMoose.pm
___________________________________________________________________
Name: svn:mime-type
   + text/plain