view release on metacpan or  search on metacpan

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

sub age_of_perl
{
	my $class = shift;
	return $class->age_of_perl_in_seconds(shift)
		/ 31_556_736 # 365.24 * 24 * 60 * 60
}

sub age_of_perl_in_seconds
{
	my ($class, $v) = @_;
	$v ||= $];
		
	my $pl_date = do
	{
		$class->_perlhist;
	
		my $date = $perlhist{$v};
		unless ($date)
		{
			for (sort keys %perlhist)
			{
				next if $_ lt $v;  # XXX: need smarter version matching!
				$date = $perlhist{$_} and last;
			}
		}
		return unless $date;
		$class->_parse_date($date);
	};
	
	return time() - $pl_date;
}

sub _parse_date
{
	my ($class, $date) = @_;
	my ($y, $m, $d) = split '-', $date;
	
	$m = {
		Jan => 0x00,
		Feb => 0x01,
		Mar => 0x02,
		Apr => 0x03,
		May => 0x04,
		Jun => 0x05,
		Jul => 0x06,
		Aug => 0x07,
		Sep => 0x08,
		Oct => 0x09,
		Nov => 0x0A,
		Dec => 0x0B,
	}->{$m};
	
	return mktime(0, 0, 0, $d, $m, $y - 1900);
}

sub _perlhist
{
	unless (%perlhist)
	{
		my $prev_date;
		while ( <DATA> )
		{
			if (/([1-5]\.[A-Za-z0-9\._]+)\s+(\d{4}-[\?\w]{3}-[\?\d]{2})/)
			{
				my $vers = $1;
				my $date = $2;
				my @vers = ($vers);
				
				if ($vers =~ /^(\d)\.(\d{3})\.\.(\d*)/)
				{
					@vers = ();
					for (my $i = $2; $i >= $3; $i++)
					{
						push @vers, sprintf "%d.%03d", $1, $i;
					}
				}
				
				if ($date =~ /\?/)
				{
					$date = $prev_date;
				}
				else
				{
					$prev_date = $date;
				}
				
				$perlhist{$_} = $date for @vers;
			}
		}
	}
}

sub perl_can
{
	my $self = shift;
	$self->can(
		age     => floor($self->age_of_perl(shift)),
		puberty => 1,
	);
}

sub import
{
	my $class = shift;
	
	if (grep { $_ eq '-check' } @_)
	{
		require Carp;
		Carp::croak("Perl $] failed age of consent check, died")
			unless $class->new->perl_can;
	}
}

1;

=head1 NAME

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

=head1 DESCRIPTION

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

	use Acme::Perl::Consensual -check;

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

While this distribution is believed to work in any version of Perl 5, it has
only been tested so far in Perl 5.8+. In older versions of Perl, Makefile.PL
may not run, but the library can be manually installed by copying
C<< lib/Acme/Perl/Consensual.pm >> to an appropriate location.

=head1 BUGS

Please report any bugs to
L<http://rt.cpan.org/Dist/Display.html?Queue=Acme-Perl-Consensual>.

=head1 SEE ALSO

L<Sex>, L<XXX>.

=head1 AUTHOR

Toby Inkster E<lt>tobyink@cpan.orgE<gt>, but MSCHWERN deserves at least a
little of the blame.

=head1 COPYRIGHT AND LICENCE

This software is copyright (c) 2012-2013 by Toby Inkster.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=head1 DISCLAIMER OF WARRANTIES

THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

=cut

# Data below reproduced from `perldoc -T -t perlhist`

__DATA__
 Larry   0              Classified.     Don't ask.
 
 Larry   1.000          1987-Dec-18
 
          1.001..10     1988-Jan-30
          1.011..14     1988-Feb-02
 Schwern  1.0.15        2002-Dec-18     Modernization
 Richard  1.0_16        2003-Dec-18
 
 Larry   2.000          1988-Jun-05
 
          2.001         1988-Jun-28
 
 Larry   3.000          1989-Oct-18
 
          3.001         1989-Oct-26
          3.002..4      1989-Nov-11
          3.005         1989-Nov-18
          3.006..8      1989-Dec-22
          3.009..13     1990-Mar-02
          3.014         1990-Mar-13
          3.015         1990-Mar-14
          3.016..18     1990-Mar-28
          3.019..27     1990-Aug-10     User subs.
          3.028         1990-Aug-14
          3.029..36     1990-Oct-17
          3.037         1990-Oct-20
          3.040         1990-Nov-10
          3.041         1990-Nov-13
          3.042..43     1991-Jan-??
          3.044         1991-Jan-12
 
 Larry   4.000          1991-Mar-21
 
          4.001..3      1991-Apr-12
          4.004..9      1991-Jun-07
          4.010         1991-Jun-10
          4.011..18     1991-Nov-05
          4.019         1991-Nov-11     Stable.
          4.020..33     1992-Jun-08
          4.034         1992-Jun-11
          4.035         1992-Jun-23
 Larry    4.036         1993-Feb-05     Very stable.
 
          5.000alpha1   1993-Jul-31
          5.000alpha2   1993-Aug-16
          5.000alpha3   1993-Oct-10
          5.000alpha4   1993-???-??
          5.000alpha5   1993-???-??
          5.000alpha6   1994-Mar-18
          5.000alpha7   1994-Mar-25
 Andy     5.000alpha8   1994-Apr-04
 Larry    5.000alpha9   1994-May-05     ext appears.
          5.000alpha10  1994-Jun-11
          5.000alpha11  1994-Jul-01
 Andy     5.000a11a     1994-Jul-07     To fit 14.
          5.000a11b     1994-Jul-14
          5.000a11c     1994-Jul-19
          5.000a11d     1994-Jul-22
 Larry    5.000alpha12  1994-Aug-04