Acme-Hidek

 view release on metacpan or  search on metacpan

inc/Module/Install/AuthorTests.pm  view on Meta::CPAN

  my $href = shift;
  sub { /\.t$/ and -f $_ and $href->{$File::Find::dir} = 1 }
}

sub _add_author_tests {
  my ($self, $dirs, $recurse) = @_;
  return unless $Module::Install::AUTHOR;

  my @tests = $self->tests ? (split / /, $self->tests) : 't/*.t';

  # XXX: pick a default, later -- rjbs, 2008-02-24
  my @dirs = @$dirs ? @$dirs : Carp::confess "no dirs given to author_tests";
     @dirs = grep { -d } @dirs;

  if ($recurse) {
    require File::Find;
    my %test_dir;
    File::Find::find(_wanted(\%test_dir), @dirs);
    $self->tests( join ' ', @tests, map { "$_/*.t" } sort keys %test_dir );
  } else {
    $self->tests( join ' ', @tests, map { "$_/*.t" } sort @dirs );

inc/Module/Install/Makefile.pm  view on Meta::CPAN

sub prompt {
	shift;

	# Infinite loop protection
	my @c = caller();
	if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
		die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
	}

	# In automated testing or non-interactive session, always use defaults
	if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
		local $ENV{PERL_MM_USE_DEFAULT} = 1;
		goto &ExtUtils::MakeMaker::prompt;
	} else {
		goto &ExtUtils::MakeMaker::prompt;
	}
}

# Store a cleaned up version of the MakeMaker version,
# since we need to behave differently in a variety of

inc/Module/Install/Repository.pm  view on Meta::CPAN

            $git_url =~ s![\w\-]+\@([^:]+):!git://$1/!;
            return $git_url;
        } elsif ($execute->('git svn info') =~ /URL: (.*)$/m) {
            return $1;
        }
    } elsif (-e ".svn") {
        if (`svn info` =~ /URL: (.*)$/m) {
            return $1;
        }
    } elsif (-e "_darcs") {
        # defaultrepo is better, but that is more likely to be ssh, not http
        if (my $query_repo = `darcs query repo`) {
            if ($query_repo =~ m!Default Remote: (http://.+)!) {
                return $1;
            }
        }

        open my $handle, '<', '_darcs/prefs/repos' or return;
        while (<$handle>) {
            chomp;
            return $_ if m!^http://!;
        }
    } elsif (-e ".hg") {
        if ($execute->('hg paths') =~ /default = (.*)$/m) {
            my $mercurial_url = $1;
            $mercurial_url =~ s!^ssh://hg\@(bitbucket\.org/)!https://$1!;
            return $mercurial_url;
        }
    } elsif (-e "$ENV{HOME}/.svk") {
        # Is there an explicit way to check if it's an svk checkout?
        my $svk_info = `svk info` or return;
        SVK_INFO: {
            if ($svk_info =~ /Mirrored From: (.*), Rev\./) {
                return $1;

inc/Module/Install/XSUtil.pm  view on Meta::CPAN

    sub cc_available {
        return defined $cc_available ?
            $cc_available :
            ($cc_available = shift->can_cc())
        ;
    }

    # cf. https://github.com/sjn/toolchain-site/blob/219db464af9b2f19b04fec05547ac10180a469f3/lancaster-consensus.md
    my $want_xs;
    sub want_xs {
        my($self, $default) = @_;
        return $want_xs if defined $want_xs;

        # you're using this module, you must want XS by default
        # unless PERL_ONLY is true.
        $default = !$ENV{PERL_ONLY} if not defined $default;

        foreach my $arg(@ARGV){

            my ($k, $v) = split '=', $arg; # MM-style named args
            if ($k eq 'PUREPERL_ONLY' && defined $v) {
                return $want_xs = !$v;
            }
            elsif($arg eq '--pp'){ # old-style
                return $want_xs = 0;
            }

inc/Module/Install/XSUtil.pm  view on Meta::CPAN

            }
        }

        if ($ENV{PERL_MM_OPT}) {
            my($v) = $ENV{PERL_MM_OPT} =~ /\b PUREPERL_ONLY = (\S+) /xms;
            if (defined $v) {
                return $want_xs = !$v;
            }
        }

        return $want_xs = $default;
    }
}

sub use_ppport{
    my($self, $dppp_version) = @_;
    return if $self->{_ppport_ok}++;

    $self->_xs_initialize();

    my $filename = 'ppport.h';

lib/Acme/Hidek.pm  view on Meta::CPAN

use constant {
    BIRTH_YEAR  => 1970,
    BIRTH_MONTH => 9,
    BIRTH_DAY   => 2,
};

has agef => (
    is      => 'ro',
    isa     => 'Num',
    lazy    => 1,
    default => sub {
        my($self) = @_;
        return +(Time::Piece->localtime - $self->birthdate)->years;
    },
);

has age => (
    is      => 'ro',
    isa     => 'Int',
    lazy    => 1,
    default => sub {
        my($self) = @_;
        return int( $self->agef );
    },
);

has birthdate => (
    is       => 'ro',
    isa      => 'Object',
    lazy     => 1,
    default  => sub { Time::Piece->strptime("1970/9/2", "%Y/%m/%d") },
    init_arg => undef,
);

sub is_birthday {
    my $now = Time::Piece->new;
    return $now->mday == BIRTH_DAY && $now->mon == BIRTH_MONTH;
}

sub ossan40 {
    my @aa = (