blob: 81ac6ef69a50b1967eea1e72ddf7b48484ae19d9 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
use strict;
use warnings;
package env::gentoo::perl_experimental;
# FILENAME: perl_experimental.pm
# CREATED: 02/08/11 16:31:56 by Kent Fredric (kentnl) <kentfredric@gmail.com>
# ABSTRACT: Generic data relevant to the perl-experimental overlay
use Moose;
has '_filename' => (
is => 'rw',
lazy_build => 1,
builder => '_build__filename',
);
has 'root' => (
is => 'rw',
builder => '_build_root',
required => 1,
);
sub _build__filename {
require Path::Class::File;
return Path::Class::File->new(__FILE__)->absolute;
}
sub _build_root {
my ($self) = shift;
my $gentoo_dir = $self->_filename->parent;
my $env_dir = $gentoo_dir->parent;
my $lib_dir = $env_dir->parent;
my $src_dir = $lib_dir->parent;
my $root = $src_dir->parent;
return $root;
}
use colorcarp { redconfess => [ 31, 47, 'confess' ] };
sub check_script {
my ( $self, $scriptname ) = @_;
require Path::Class::File;
my $expected = $self->root->file( $scriptname )->absolute ;
my $got = Path::Class::File->new( $0 )->absolute;
return 1 if ( $expected eq $got );
redconfess("The expected name for the running script \"$got\" was supposed to be \"$expected\". This likely indicates a fatal problem");
}
sub metadata_dir {
my ( $self, @extra ) = @_;
return $self->root->subdir('metadata') if not @extra;
my $d = $self->root->subdir('metadata', @extra );
$d->mkpath;
return $d;
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
|