From 747d1c90e721d4d2632a4ee9529e820586a29d79 Mon Sep 17 00:00:00 2001
From: franck cuny <franck@lumberjaph.net>
Date: Wed, 10 Feb 2010 14:10:29 +0100
Subject: generate private and protected methods

---
 lib/MooseX/Privacy/Meta/Method/Private.pm   | 26 ++++++++++++++++++++++++++
 lib/MooseX/Privacy/Meta/Method/Protected.pm | 29 +++++++++++++++++++++++++++++
 2 files changed, 55 insertions(+)
 create mode 100644 lib/MooseX/Privacy/Meta/Method/Private.pm
 create mode 100644 lib/MooseX/Privacy/Meta/Method/Protected.pm

diff --git a/lib/MooseX/Privacy/Meta/Method/Private.pm b/lib/MooseX/Privacy/Meta/Method/Private.pm
new file mode 100644
index 0000000..9bcf68d
--- /dev/null
+++ b/lib/MooseX/Privacy/Meta/Method/Private.pm
@@ -0,0 +1,26 @@
+package MooseX::Privacy::Meta::Method::Private;
+
+use Moose;
+extends 'Moose::Meta::Method';
+
+use Carp;
+
+sub new {
+    my $class = shift;
+    my %args  = @_;
+
+    my $method       = delete $args{body};
+    my $private_code = sub {
+        croak "The "
+            . $args{package_name} . "::"
+            . $args{name}
+            . " name method is private"
+            unless ( scalar caller() ) eq $args{package_name};
+
+        goto &{$method};
+    };
+    $args{body} = $private_code;
+    $class->SUPER::wrap(%args);
+}
+
+1;
diff --git a/lib/MooseX/Privacy/Meta/Method/Protected.pm b/lib/MooseX/Privacy/Meta/Method/Protected.pm
new file mode 100644
index 0000000..3d4b88a
--- /dev/null
+++ b/lib/MooseX/Privacy/Meta/Method/Protected.pm
@@ -0,0 +1,29 @@
+package MooseX::Privacy::Meta::Method::Protected;
+
+use Moose;
+extends 'Moose::Meta::Method';
+
+use Carp;
+
+sub new {
+    my $class = shift;
+    my %args  = @_;
+
+    my $method         = delete $args{body};
+    my $protected_code = sub {
+        my $caller = caller();
+        croak "The "
+            . $args{package_name} . "::"
+            . $args{name}
+            . " name method is private"
+            unless $caller eq $args{package_name}
+                || $caller->isa( $args{package_name} );
+
+        goto &{$method};
+    };
+    $args{body} = $protected_code;
+    $class->SUPER::wrap(%args);
+}
+
+1;
+
-- 
cgit 1.4.1