Skip to content

Commit

Permalink
Yeah, this is pervert...
Browse files Browse the repository at this point in the history
  • Loading branch information
Getty committed Dec 13, 2012
1 parent eb67dd1 commit 20a81bb
Show file tree
Hide file tree
Showing 6 changed files with 151 additions and 2 deletions.
4 changes: 4 additions & 0 deletions dist.ini
Expand Up @@ -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
Expand Down
40 changes: 38 additions & 2 deletions 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;
57 changes: 57 additions & 0 deletions 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;
6 changes: 6 additions & 0 deletions lib/GID/Object.pm
@@ -0,0 +1,6 @@
package GID::Object;
# ABSTRACT: Base class for GID::Class objects

use Moo;

1;
38 changes: 38 additions & 0 deletions 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;
8 changes: 8 additions & 0 deletions 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' );
}

0 comments on commit 20a81bb

Please sign in to comment.