From 20a81bb56670d1b795195fac215b9e84ce8a738d Mon Sep 17 00:00:00 2001
From: Torsten Raudssus <torsten@raudss.us>
Date: Thu, 13 Dec 2012 05:32:27 +0100
Subject: [PATCH] Yeah, this is pervert...

---
 dist.ini          |  4 ++++
 lib/GID.pm        | 40 +++++++++++++++++++++++++++++++--
 lib/GID/Class.pm  | 57 +++++++++++++++++++++++++++++++++++++++++++++++
 lib/GID/Object.pm |  6 +++++
 t/gid_class.t     | 38 +++++++++++++++++++++++++++++++
 t/load.t          |  8 +++++++
 6 files changed, 151 insertions(+), 2 deletions(-)
 create mode 100644 lib/GID/Class.pm
 create mode 100644 lib/GID/Object.pm
 create mode 100644 t/gid_class.t
 create mode 100644 t/load.t

diff --git a/dist.ini b/dist.ini
index 6cdd169..129a6e6 100644
--- a/dist.ini
+++ b/dist.ini
@@ -7,6 +7,10 @@ copyright_year   = 2012
 [@Author::GETTY]
 
 [Prereqs]
+IO::All = 0
+Path::Class = 0
+Moo = 0
+MooX = 0
 
 [Prereqs / TestRequires]
 Test::More = 0.98
diff --git a/lib/GID.pm b/lib/GID.pm
index 205f687..e0362b6 100644
--- a/lib/GID.pm
+++ b/lib/GID.pm
@@ -1,5 +1,41 @@
-use strict;
-use warnings;
 package GID;
 
+use Import::Into;
+use Package::Stash;
+
+use Path::Class ();
+use Carp ();
+use File::ShareDir ();
+use File::Copy::Recursive ();
+use File::Remove ();
+use List::MoreUtils ();
+use Scalar::Util ();
+
+sub import { 
+	my $target = scalar caller;
+
+	Path::Class->import::into($target,qw( file dir ));
+	Carp->import::into($target,qw( confess croak carp ));
+	File::ShareDir->import::into($target,qw( dist_dir class_dir ));
+	File::Copy::Recursive->import::into($target,qw( dircopy ));
+	File::Remove->import::into($target,qw( remove ));
+	List::MoreUtils->import::into($target,qw(
+		any all none notall firstidx first_index lastidx last_index
+		insert_after insert_after_string apply indexes after_incl
+		before_incl firstval first_value lastval last_value each_array
+		each_arrayref pairwise natatime mesh zip uniq distinct minmax part
+	));
+	Scalar::Util->import::into($target,qw(
+		blessed dualvar isweak readonly
+		refaddr reftype tainted weaken isvstring looks_like_number
+		set_prototype
+	));
+	my $stash = Package::Stash->new($target);
+
+	$stash->add_symbol('&env',sub {
+		my $key = join('_',@_);
+		return defined $ENV{$key} ? $ENV{$key} : "";
+	});
+}
+
 1;
diff --git a/lib/GID/Class.pm b/lib/GID/Class.pm
new file mode 100644
index 0000000..b13a6d3
--- /dev/null
+++ b/lib/GID/Class.pm
@@ -0,0 +1,57 @@
+package GID::Class;
+# ABSTRACT: Making your classes in GID
+
+use Package::Stash;
+use Import::Into;
+use Scalar::Util qw( blessed );
+
+use GID ();
+use Moo ();
+use MooX ();
+
+sub import {
+	shift;
+	my $target = scalar caller;
+
+	GID->import::into($target,@_);
+
+	my $stash = Package::Stash->new($target);
+	my @gid_methods = $stash->list_all_symbols('CODE');
+
+	MooX->import::into($target,qw(
+		ClassStash
+		HasEnv
+		Options
+	));
+
+	$target->can('extends')->('GID::Object');
+
+	$target->class_stash->around_method('has',sub {
+		my $has = shift;
+		my $attribute_arg = shift;
+		my @attribute_args = @_;
+		my @attributes = ref $attribute_arg eq 'ARRAY' ? @{$attribute_arg} : ($attribute_arg);
+		for (@attributes) {
+			my $attribute = $_;
+			if (grep { $attribute eq $_ } @gid_methods) {
+				my $gid_method = $target->class_stash->get_method($attribute);
+				$target->class_stash->remove_method($attribute);
+				$has->($attribute,@attribute_args);
+				$target->class_stash->around_method($attribute,sub {
+					my $attribute_method = shift;
+					my @args = @_;
+					if (blessed $args[0]) {
+						return $attribute_method->(@args);
+					} else {
+						return $gid_method->(@args);
+					}
+				});
+			} else {
+				$has->($attribute,@attribute_args);
+			}
+		}
+	});
+
+}
+
+1;
\ No newline at end of file
diff --git a/lib/GID/Object.pm b/lib/GID/Object.pm
new file mode 100644
index 0000000..a27bf54
--- /dev/null
+++ b/lib/GID/Object.pm
@@ -0,0 +1,6 @@
+package GID::Object;
+# ABSTRACT: Base class for GID::Class objects
+
+use Moo;
+
+1;
\ No newline at end of file
diff --git a/t/gid_class.t b/t/gid_class.t
new file mode 100644
index 0000000..eb1e213
--- /dev/null
+++ b/t/gid_class.t
@@ -0,0 +1,38 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+{
+	package GIDTest::Class;
+	use GID::Class;
+
+	has last_index => ( is => 'rw' );
+
+	sub test_last_index {
+		return last_index { $_ eq 1 } ( 1,1,1,1 );
+	}
+}
+
+{
+	package GIDTest::Class2;
+	use GID::Class;
+	extends 'GIDTest::Class';
+}
+
+my $t = GIDTest::Class->new( last_index => 1 );
+
+is($t->last_index,1,'last_index is set proper via constructor');
+isa_ok($t,'GID::Object');
+isa_ok($t,'Moo::Object');
+$t->last_index(2);
+is($t->last_index,2,'last_index is changed proper');
+is($t->test_last_index,3,'gid last_index still works fine');
+
+my $t2 = GIDTest::Class->new;
+
+isa_ok($t2,'GIDTest::Class');
+isa_ok($t2,'GID::Object');
+isa_ok($t2,'Moo::Object');
+
+done_testing;
diff --git a/t/load.t b/t/load.t
new file mode 100644
index 0000000..3b5ffed
--- /dev/null
+++ b/t/load.t
@@ -0,0 +1,8 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::LoadAllModules;
+
+BEGIN {
+	all_uses_ok( search_path => 'GID' );
+}