Commits

Toby Inkster committed a7c1382 Draft

ready for release

Comments (0)

Files changed (11)

examples/assert.pl

+use perl5-tobyink;
+
+assert(1 > 2);

lib/perl5/tobyink.pm

 use strict 1;
 no warnings 1;
 
+use constant {
+	true   => !!1,
+	false  => !1,
+};
+
+use constant {
+	read_only  => 'ro',
+	read_write => 'rw',
+};
+
 use IO::Handle 0;
+use Encode 0;
 
 # perl5-hack
 sub imports { +__PACKAGE__ }
 BEGIN
 {
 	$perl5::tobyink::AUTHORITY = 'cpan:TOBYINK';
-	$perl5::tobyink::VERSION   = '1';
-	
-	@perl5::tobyink::EXPORT = qw(trim ltrim rtrim normalize);
+	$perl5::tobyink::VERSION   = '0.001';
 }
 
 {
 {
 	strict->unimport;
 	warnings->unimport;
-
+	
 	# stolen from common::sense...
-	# use warnings qw(FATAL closed threads internal debugging pack
-	#                 portable prototype inplace io pipe unpack malloc
-	#                 deprecated glob digit printf layer
-	#                 reserved taint closure semicolon);
-	${^WARNING_BITS} ^= ${^WARNING_BITS} ^ "\x3c\x3f\x33\x00\x0f\xf0\x0f\xc0\xf0\xfc\x33\x00";
-	
-	# use strict qw(subs vars);
-	$^H |= 0x000600;
+	warnings->import(qw(FATAL closed threads internal debugging pack
+	                 portable prototype inplace io pipe unpack malloc
+	                 deprecated glob digit printf layer
+	                 reserved taint closure semicolon));
+	strict->import(qw(subs vars));
 
 	# use feature ':5.10';
 	$^H{feature_switch} =
 	$^H{feature_state}  = 1;
 	
 	my $caller = caller;
-	no strict 'refs';
-	foreach my $e (@perl5::tobyink::EXPORT)
+	foreach my $e (qw(trim ltrim rtrim normalize true false))
 	{
+		no strict 'refs';
 		*{"$caller\::$e"} = \&{$e};
 	}
+
+	if (grep(/^-(class|antlers)$/, @_))
+	{
+		foreach my $e (qw(read_only read_write))
+		{
+			no strict 'refs';
+			*{"$caller\::$e"} = \&{$e};
+		}
+	}
+	
+	if (grep(/^-class$/, @_))
+	{
+		require perl5::tobyink::OO;
+		@_ = $caller;
+		goto \&perl5::tobyink::OO::import;
+	}
 }
 
 use Object::Tap 0 -package => 'UNIVERSAL';
 ###
 use Syntax::Collector 0.003 -collect => q/
 use Carp 0 qw(carp croak confess);
+use Devel::Assert 0 qw(0);
 use List::Util 0 qw(first max min reduce shuffle);
 use List::MoreUtils 0 qw(uniq);
+use Method::Signatures::Simple 1.00 method_keyword => 'method', function_keyword => 'function';
 use Path::Class 0 qw(file dir);
 use POSIX 0 qw(floor ceil);
 use Scalar::Util 0 qw(blessed isweak looks_like_number refaddr reftype weaken);
-use Syntax::Feature::Function 0 options => { -as => 'function' };
 use Syntax::Feature::Maybe 0;
 use Syntax::Feature::Perform 0;
 use Syntax::Feature::Ql 0;
 use Syntax::Feature::Qwa 0;
+use Try::Tiny 0;
+use autodie 0;
+no indirect 0 ':fatal';
+use mro 0 'c3';
+use namespace::sweep 0;
+use true 0.14;
 use utf8::all 0;
 /;
 
 {
 	package
-	Class::Path::Dir;
-	use overload '@{}' => 'children';
+	Class::Path::Dir; use overload '@{}', 'children';
 }
 
 __FILE__
 
 =head1 NAME
 
-perl5::tobyink - an lightweight collection of syntax extensions
+perl5::tobyink - a lightweight collection of syntax extensions
 
 =head1 SYNOPSIS
 
- use perl5-tobyink;
+ use perl5::tobyink;
 
 =head1 DESCRIPTION
 
-C<< use perl5-tobyink >> is roughly equivalent to:
+C<< use perl5::tobyink >> is roughly equivalent to:
 
  use 5.010;
+ use autodie;
+ use common::sense;
+ use constant { false => !1, true => !!1 };
+ use mro qw(c3);
+ use namespace::sweep;
+ use syntax qw(maybe perform ql qwa);
+ use true;
+ use utf8::all;
+ 
+ no indirect qw(:fatal);
+ 
+ require Encode;
+ require IO::Handle;
+ 
  use Carp qw(carp croak confess);
- use IO::Handle;
- use List::Util 0 qw(first max min reduce shuffle);
- use List::MoreUtils 0 qw(uniq);
- use Object::Tap 0 -package => 'UNIVERSAL';
+ use Devel::Assert qw(0);
+ use List::Util qw(first max min reduce shuffle);
+ use List::MoreUtils qw(uniq);
+ use Method::Signatures::Simple 1.00 method_keyword => 'method', function_keyword => 'function';
+ use Object::Tap -package => 'UNIVERSAL';
  use Path::Class qw(file dir);
  use POSIX qw(floor ceil);
  use Scalar::Util qw(blessed isweak looks_like_number refaddr reftype weaken);
- use common::sense;
- use syntax 'function' => { -as => 'function' };
- use syntax qw(maybe perform ql qwa);
- use utf8::all;
+ use Try::Tiny 0;
+ 
  *trim      = \&perl5::tobyink::trim;
  *ltrim     = \&perl5::tobyink::ltrim;
  *rtrim     = \&perl5::tobyink::rtrim;
  *normalize = \&perl5::tobyink::normalize;
 
+=head2 Object Oriented Programming
+
+Calling with the parameter "-class", will also act as C<< use Any::Mo >>,
+and thus will set up a C<new> method for your package, provide C<has>,
+C<extends> and other antlery sugar. 
+
+ {
+     package Person;
+     use perl5::tobyink -class;
+     has name => (is => read_only, isa => 'Str');
+     has age  => (is => read_only, isa => 'Num');
+ }
+
+With the "-class" parameter, additional constants read_only and read_write
+are exported too.
+
+If you'd rather use Moose or Mouse or whatever, then don't pass "-class" and
+use Moose/Mouse/whatever manually. The read_only/read_write constants can
+be exported using the "-antlers" parameter.
+
+ {
+     package Person;
+     use perl5::tobyink -antlers;
+     use Any::Moose;
+     has name => (is => read_only, isa => 'Str');
+     has age  => (is => read_only, isa => 'Num');
+ } 
+
+=head2 Assertions
+
+You can include assertions in your code a la:
+
+ method set_name ($new)
+ {
+     assert(length $new > 0);
+     $self->{name} = $new;
+ }
+
+By default assertions are not checked at all; they are short-circuited
+entirely. To have them checked, you need to C<< use Devel::Assert -all >>.
+One easy way is to run your script like this:
+
+ perl -MDevel::Assert=-all yourscript.pl
+
 =head1 BUGS
 
 Please report any bugs to
 
 =head1 SEE ALSO
 
-L<perl5>, L<common::sense>, L<Modern::Perl>.
+L<Any::Mo>,
+L<autodie>,
+L<Carp>,
+L<common::sense>,
+L<Encode>,
+L<Devel::Assert>,
+L<indirect>,
+L<IO::Handle>,
+L<List::Util>,
+L<List::MoreUtils>,
+L<Method::Signatures::Simple>,
+L<mro>,
+L<namespace::sweep>,
+L<Object::Tap>,
+L<Path::Class>,
+L<POSIX>,
+L<Scalar::Util>,
+L<Syntax::Feature::Maybe>,
+L<Syntax::Feature::Perform>,
+L<Syntax::Feature::Ql>,
+L<Syntax::Feature::Qwa>,
+L<true>
+L<Try::Tiny>,
+L<utf8::all>.
 
 =head1 AUTHOR
 

lib/perl5/tobyink/OO.pm

+package perl5::tobyink::OO;
+
+use 5.006;
+use strict qw/vars subs/;
+no warnings;
+
+our $Mo        = __PACKAGE__.'::Mo';
+our $AUTHORITY = 'cpan:TOBYINK';
+our $VERSION   = '0.001';
+our $PREFERRED = undef;
+
+use Scalar::Util;
+use Carp;
+
+sub import {
+	my $prefer = (shift)->decide;
+	
+	if ($prefer eq 'Mo') {
+		*{(caller(0))[0].'::blessed'} = \&Scalar::Util::blessed;
+		*{(caller(0))[0].'::confess'} = \&Carp::confess;
+	}
+	
+	@_ = ($prefer eq $Mo)
+		? ($Mo, qw/build builder default is isa required/)
+		: ($prefer);
+	
+	my $import = $prefer->can('import');
+	goto $import;
+}
+
+sub decide {
+	return $PREFERRED if $PREFERRED;
+	my ($self) = @_;
+	
+	$PREFERRED ||= $Any::Moose::PREFERRED
+		if $INC{'Any/Moose.pm'} && Any::Moose->any_moose;
+	
+	$PREFERRED ||= do {
+		local $_ = $ENV{PERL_ANY_MO};
+		if (/^MOOSE$/i)    { $self->make_moose_available; 'Moose' }
+		elsif (/^MOUSE$/i) { $self->make_mouse_available; 'Mouse' }
+		elsif (/^MO$/i)    { $self->make_mo_available;    $Mo }
+		elsif (/^${Mo}$/i) { $self->make_mo_available;    $Mo }
+		elsif (/./)        { warn "PERL_ANY_MO should be Moose/Mouse/Mo!"; undef }
+	};
+	
+	$PREFERRED ||= 'Moose' if $self->moose_is_available;
+	$PREFERRED ||= 'Mouse' if $self->mouse_is_available;
+	$self->make_mo_available and $PREFERRED ||= $Mo;
+	return $PREFERRED;
+}
+
+# Moose
+sub moose_is_available {
+	defined $INC{'Moose.pm'}
+		and UNIVERSAL::can('Moose', 'can')
+		and Moose->can('import');
+}
+sub make_moose_available {
+	return if (shift)->moose_is_available;
+	require Moose; 1
+}
+
+# Mouse
+sub mouse_is_available {
+	defined $INC{'Mouse.pm'}
+		and UNIVERSAL::can('Mouse', 'can')
+		and Mouse->can('import');
+}
+sub make_mouse_available {
+	return if (shift)->mouse_is_available;
+	require Mouse; 1
+}
+
+# Mo
+my $AMM_available;
+sub mo_is_available {
+	return 1 if $AMM_available;
+	return;
+}
+sub make_mo_available {
+	return if (shift)->mo_is_available;
+	no strict;
+	my $AMM = do { local $/ = <DATA> }
+		or die "Could not load AMM from DATA";
+	eval $AMM
+		or die "Could not evaluate AMM: $@";
+	$AMM_available = 1;
+}
+
+__PACKAGE__
+__DATA__
+package perl5::tobyink::OO::Mo;
+$VERSION='0.31';
+no warnings;my$M='perl5::tobyink::OO::'.'Mo'.'::';*{$M.Object::new}=sub{bless{@_[1..$#_]},$_[0]};*{$M.import}=sub{my($P,%e,%o)=caller.'::';shift;&{$M.$_.::e}($P,\%e,\%o,\@_)for@_;return if$e{M};%e=(extends,sub{eval"no $_[0]()";@{$P.ISA}=$_[0]},has,sub{my$n=shift;my$m=sub{$#_?$_[0]{$n}=$_[1]:$_[0]{$n}};$m=$o{$_}->($m,$n,@_)for sort keys%o;*{$P.$n}=$m},%e,);*{$P.$_}=$e{$_}for keys%e;@{$P.ISA}=$M.Object};
+;package perl5::tobyink::OO::Mo::build;my$M='perl5::tobyink::OO::'."Mo::";
+$VERSION=0.31;
+*{$M.'build::e'}=sub{my($P,$e)=@_;$e->{new}=sub{$c=shift;my$s=bless{@_},$c;my@B;do{@B=($c.::BUILD,@B)}while($c)=@{$c.::ISA};exists&$_&&&$_($s)for@B;$s}};
+;package perl5::tobyink::OO::Mo::builder;my$M='perl5::tobyink::OO::'."Mo::";
+$VERSION=0.31;
+*{$M.'builder::e'}=sub{my($P,$e,$o)=@_;$o->{builder}=sub{my($m,$n,%a)=@_;my$b=$a{builder}or return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$_[0]->$b:$m->(@_)}}};
+;package perl5::tobyink::OO::Mo::default;my$M='perl5::tobyink::OO::'."Mo::";
+$VERSION=0.31;
+*{$M.'default::e'}=sub{my($P,$e,$o)=@_;$o->{default}=sub{my($m,$n,%a)=@_;$a{default}or return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$a{default}->(@_):$m->(@_)}}};
+;package perl5::tobyink::OO::Mo::is;$M='perl5::tobyink::OO::'."Mo::";
+$VERSION=0.31;
+*{$M.'is::e'}=sub{my($P,$e,$o)=@_;$o->{is}=sub{my($m,$n,%a)=@_;$a{is}or return$m;sub{$#_&&$a{is}eq 'ro'&&caller ne 'Mo::coerce'?die$n.' is ro':$m->(@_)}}};
+;package perl5::tobyink::OO::Mo::isa;$M='perl5::tobyink::OO::'."Mo::";
+$VERSION=0.31;
+$Z=CODE;sub O(_){UNIVERSAL::can(@_,isa)}sub S(&){pop}sub Z{1}sub R(){ref}sub N(){!defined}sub Y(){!N&&!R}our%TC=(Any,\&Z,Item,\&Z,Bool,S{N||0 eq$_||1 eq$_||''eq$_},Undef,\&N,Defined,S{!N},Value,\&Y,Str,\&Y,Num,S{Y&&/^([+-]?\d+|[+-]?(?=\d|\.\d)\d*(\.\d*)?(e([+-]?\d+))?|(Inf(inity)?|NaN))$/i},Int,S{/^\d+$/},Ref,\&R,FileHandle,\&R,Object,S{R&&O},(map{$_.Name,S{Y&&/^\S+$/}}qw/Class Role/),map{my$J=/R/?$_:uc$_;$_.Ref,S{R eq$J}}qw(Scalar Array Hash Code Glob Regexp));sub check{my$v=pop;return eval{$_[0]->($v);1}if ref$_[0]eq$Z;@_=split/\|/,shift;while(@_){(my$t=shift)=~s/^\s+|\s+$//g;if($t=~/^Maybe\[(.+)\]$/){@_=(Undef,$1,@_);next}$t=$1 if$t=~/^(.+)\[/;if(my$k=$TC{$t}){local$_=$v;&$k&&return 1}elsif($t=~/::/){O($v)&&$v->isa($t)&&return 1}else{return 1}}0}sub av{(my$t,$_)=@_;ref($t)eq$Z?$t->($_):${die"not $t\n"if!check@_}}*{$M.isa::e}=S{my($P,$e,$o)=@_;my$C=*{$P.new}{$Z}||*{$M.Object::new}{$Z};*{$P.new}=S{my%a=@_[1..$#_];av(($cx{$P.$_}||next),$a{$_})for keys%a;goto$C};$o->{isa}=S{my($m,$n,%a)=@_;my$V=$cx{$P.$n}=$a{isa}or return$m;S{av$V,$_[1]if$#_;$m->(@_)}}}
+;package perl5::tobyink::OO::Mo::required;my$M='perl5::tobyink::OO::'."Mo::";
+$VERSION=0.31;
+*{$M.'required::e'}=sub{my($P,$e,$o)=@_;$o->{required}=sub{my($m,$n,%a)=@_;if($a{required}){my$C=*{$P."new"}{CODE}||*{$M.Object::new}{CODE};no warnings 'redefine';*{$P."new"}=sub{my$s=$C->(@_);my%a=@_[1..$#_];die$n." required"if!$a{$n};$s}}$m}};
+;
+# This file acts as the project's changelog.
+
+@prefix :        <http://usefulinc.com/ns/doap#> .
+@prefix dcs:     <http://ontologi.es/doap-changeset#> .
+@prefix dc:      <http://purl.org/dc/terms/> .
+@prefix dist:    <http://purl.org/NET/cpan-uri/dist/perl5-tobyink/> .
+@prefix rdfs:    <http://www.w3.org/2000/01/rdf-schema#> .
+@prefix xsd:     <http://www.w3.org/2001/XMLSchema#> .
+
+dist:project :release dist:v_0-001 .
+dist:v_0-001
+	a               :Version ;
+	dc:issued       "2012-05-29"^^xsd:date ;
+	:revision       "0.001"^^xsd:string ;
+	:file-release   <http://backpan.cpan.org/authors/id/T/TO/TOBYINK/perl5-tobyink-0.001.tar.gz> ;
+	rdfs:label      "Initial release" .
+
+# This file contains general metadata about the project.
+
+@prefix :        <http://usefulinc.com/ns/doap#> .
+@prefix dc:      <http://purl.org/dc/terms/> .
+@prefix foaf:    <http://xmlns.com/foaf/0.1/> .
+@prefix rdfs:    <http://www.w3.org/2000/01/rdf-schema#> .
+@prefix xsd:     <http://www.w3.org/2001/XMLSchema#> .
+
+<http://purl.org/NET/cpan-uri/dist/perl5-tobyink/project>
+	a               :Project ;
+	:programming-language "Perl" ;
+	:name           "perl5-tobyink" ;
+	:shortdesc      "a lightweight collection of syntax extensions" ;
+	:homepage       <https://metacpan.org/release/perl5-tobyink> ;
+	:download-page  <https://metacpan.org/release/perl5-tobyink> ;
+	:bug-database   <http://rt.cpan.org/Dist/Display.html?Queue=perl5-tobyink> ;
+	:repository     [ a :HgRepository ; :browse <https://bitbucket.org/tobyink/p5-perl5-tobyink> ] ;
+	:created        "2012-03-01"^^xsd:date ;
+	:license        <http://dev.perl.org/licenses/> ;
+	:developer      [ a foaf:Person ; foaf:name "Toby Inkster" ; foaf:mbox <mailto:tobyink@cpan.org> ] .
+
+<http://dev.perl.org/licenses/>
+	dc:title        "the same terms as the perl 5 programming language system itself" .
+

meta/makefile.ttl

+# This file provides instructions for packaging.
+
+@prefix : <http://purl.org/NET/cpan-uri/terms#> .
+
+<http://purl.org/NET/cpan-uri/dist/perl5-tobyink/project>
+	:perl_version_from _:main ;
+	:version_from _:main ;
+	:readme_from _:main ;
+	:test_requires "Test::More 0.61"  ;
+	:requires
+		"autodie 0",
+		"Carp 0",
+		"constant",
+		"Devel::Assert 0",
+		"Encode 0",
+		"indirect 0",
+		"IO::Handle 0",
+		"List::MoreUtils 0",
+		"List::Util 0",
+		"Method::Signatures::Simple 1.00",
+		"mro 0",
+		"namespace::sweep 0",
+		"Object::Tap 0",
+		"Path::Class 0",
+		"POSIX 0",
+		"Scalar::Util 0",
+		"strict 1",
+		"Syntax::Collector 0.003",
+		"Syntax::Feature::Maybe 0",
+		"Syntax::Feature::Perform 0",
+		"Syntax::Feature::Ql 0",
+		"Syntax::Feature::Qwa 0",
+		"true 0.14",
+		"Try::Tiny 0",
+		"utf8::all 0",
+		"warnings 1".
+
+_:main <http://www.semanticdesktop.org/ontologies/2007/03/22/nfo#fileName> "lib/perl5/tobyink.pm" .
+
+use Test::More tests => 1;
+BEGIN { use_ok('perl5::tobyink') };
+
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
+

xt/02pod_coverage.t

+use Test::More;
+use Test::Pod::Coverage;
+
+my @modules = qw(perl5::tobyink);
+pod_coverage_ok($_, "$_ is covered")
+	foreach @modules;
+done_testing(scalar @modules);
+

xt/03meta_uptodate.t

+use Test::More tests => 1;
+use Test::RDF::DOAP::Version;
+doap_version_ok('perl5-tobyink', 'perl5::tobyink');
+
+use Test::EOL;
+all_perl_files_ok();