Acme-Perl-Consensual

 view release on metacpan or  search on metacpan

README  view on Meta::CPAN

NAME
    Acme::Perl::Consensual - check that your version of Perl is old enough
    to consent

DESCRIPTION
    This module checks that your version of Perl is old enough to consent to
    sexual activity. It could be considered a counterpart for Modern::Perl.

  Constructor
    "new(locale => $locale)"
        Creates a new Acme::Perl::Consensual object which can act as an age
        of consent checker for a particular locale.

        The locale string should be an ISO 3166 alpha2 country code such as
        "US" for the United States, "GB" for the United Kingdom or "DE" for
        Germany. It may optionally include a hyphen followed by a
        subdivision designator, such as "US-TX" for Texas, United States,
        "AU-NSW" for New South Wales, Australia or "GB-WLS" for Wales,
        United Kingdom.

        If the locale is omitted, the module will attempt to extract the
        locale from the LC_LEGAL or LC_ALL environment variable.

  Methods
    "locale"
        Returns the locale provided to the constructor, or detected from
        environment variables, lower-cased.

    "can(%details)"
        Given a person's details (or a piece of software's details), returns
        true if they are legally able to consent. For example:

                my $can_consent = $acme->can(age => 26, married => 1);

        Currently recognised details are 'age' (in years), 'married' (0 for
        no, 1 for yes) and 'puberty' (0 for no, 1 for yes).

README  view on Meta::CPAN

    is a shorthand for:

            BEGIN {
                    require Acme::Perl::Consensual;
                    Acme::Perl::Consensual->new()->perl_can()
                            or die "Perl $] failed age of consent check, died";
            }

    That is, it's the opposite of "use Modern::Perl". It requires your
    version of Perl to be past the age of consent in your locale.

CAVEATS
    Most jurisdictions have legal subtleties that this module cannot take
    into account. Use of this module does not constitute a legal defence.

    Even if you obtain consent from Perl, there are practical limits to what
    you could actually do with it, sexually.

INSTALL
    While this distribution is believed to work in any version of Perl 5, it

lib/Acme/Perl/Consensual.pm  view on Meta::CPAN

	)),
	"mx-mex" => { age => 15 },
	"mx-nay" => { puberty => 1 },
);

my %perlhist;

sub new
{
	my ($class, %args) = @_;
	$args{locale} = $ENV{LC_ALL} || $ENV{LC_LEGAL} || 'en_XX.UTF-8'
		unless exists $args{locale};
	$args{locale} = $1
		if $args{locale} =~ /^.._(.+?)(\.|$)/;
	bless \%args => $class;
}

sub locale
{
	lc shift->{locale};
}

sub can
{
	if (@_ == 2 and not ref $_[1])
	{
		shift->SUPER::can(@_);
	}
	else
	{
		shift->_can_consent(@_);
	}
}

sub _can_consent
{
	my $self     = ref $_[0] ? shift : shift->new;
	
	my $provides = ref $_[0] ? shift : +{@_};
	my $requires = $requirements{ $self->locale };
	
	# If locale includes a region, fallback to country.
	if ($self->locale =~ /^([a-z]{2})-/)
	{
		$requires ||= $requirements{ $1 };
	}
	
	return undef unless defined $requires;
	
	for (keys %$requires)
	{
		return undef unless defined $provides->{$_};
		return !1 unless $provides->{$_} >= $requires->{$_};

lib/Acme/Perl/Consensual.pm  view on Meta::CPAN

=head1 DESCRIPTION

This module checks that your version of Perl is old enough to consent to
sexual activity. It could be considered a counterpart for L<Modern::Perl>.

=head2 Constructor

=over

=item C<< new(locale => $locale) >>

Creates a new Acme::Perl::Consensual object which can act as an age of consent
checker for a particular locale.

The locale string should be an ISO 3166 alpha2 country code such as "US" for
the United States, "GB" for the United Kingdom or "DE" for Germany. It may
optionally include a hyphen followed by a subdivision designator, such as
"US-TX" for Texas, United States, "AU-NSW" for New South Wales, Australia or
"GB-WLS" for Wales, United Kingdom.

If the locale is omitted, the module will attempt to extract the locale
from the LC_LEGAL or LC_ALL environment variable.

=back

=head2 Methods

=over

=item C<< locale >>

Returns the locale provided to the constructor, or detected from environment
variables, lower-cased.

=item C<< can(%details) >>

Given a person's details (or a piece of software's details), returns true if
they are legally able to consent. For example:

	my $can_consent = $acme->can(age => 26, married => 1);

Currently recognised details are 'age' (in years), 'married' (0 for no, 1 for

lib/Acme/Perl/Consensual.pm  view on Meta::CPAN

is a shorthand for:

	BEGIN {
		require Acme::Perl::Consensual;
		Acme::Perl::Consensual->new()->perl_can()
			or die "Perl $] failed age of consent check, died";
	}

That is, it's the opposite of C<< use Modern::Perl >>. It requires your
version of Perl to be past the age of consent in your locale.

=head1 CAVEATS

Most jurisdictions have legal subtleties that this module cannot take into
account. Use of this module does not constitute a legal defence.

Even if you obtain consent from Perl, there are practical limits to what you
could actually do with it, sexually.

=head1 INSTALL

t/02-check-req.t  view on Meta::CPAN

use Test::More tests => 10;
use Acme::Perl::Consensual;

my $gb = Acme::Perl::Consensual->new(locale => 'gb');

ok(not $gb->can(age =>  6));
ok(    $gb->can(age => 16));
ok(    $gb->can(age => 26));
ok(    $gb->can(age => 26, married => 0));
ok(    $gb->can(age => 26, married => 1));

my $bo = Acme::Perl::Consensual->new(locale => 'tn_BO.UTF-8');
ok(not defined $bo->can(age => 16));
ok(not defined $bo->can(age => 26));
ok(            $bo->can(age => 12, puberty => 1));
ok(not         $bo->can(age => 12, puberty => 0));

ok($bo->can('locale'));

t/04-perlcan.t  view on Meta::CPAN

use Acme::Perl::Consensual;

my $year = [localtime(time)]->[5] + 1900;
unless ($year==2012 or $year==2013)
{
	plan skip_all => "This test won't work in the future.";
}

plan tests => 11;

my $gb = Acme::Perl::Consensual->new(locale => 'gb');  # UK
my $jp = Acme::Perl::Consensual->new(locale => 'jp');  # Japan
my $id = Acme::Perl::Consensual->new(locale => 'id');  # Indonesia

ok not $gb->perl_can('5.14.0');
ok not $gb->perl_can('5.005');
ok     $gb->perl_can('5.001');

ok not $jp->perl_can('5.14.0');
ok     $jp->perl_can('5.005');
ok     $jp->perl_can('5.001');

ok not $id->perl_can('5.14.0');