Commit 5af009b7b23dc1147845b1cda82e5f6bd49c521e - libmoosex-has-sugar-perl

+1

-0

Build.PL less more

12	12	"Kent\ Fredric\ \<kentnl\ at\ cpan\.org\>",
13	13	],
14	14	requires => {
	15	"MooseX::Types::Moose" => '0',
15	16	"namespace::autoclean" => '0',
16	17	"Test::Exception" => '0',
17	18	"Sub::Exporter" => '0',

+3

-0

Changes less more

0	0	Revision history for MooseX-Has-Sugar
	1
	2	0.0404 2009-07-06 03:34:10 UTC
	3	Added Saccharin, experimental sugars.
1	4
2	5	0.0403 2009-06-30 13:56:07 UTC
3	6	Using Dist::Zilla's handy author-tests feature

+8

-1

MANIFEST less more

7	7	README
8	8	lib/MooseX/Has/Sugar.pm
9	9	lib/MooseX/Has/Sugar/Minimal.pm
	10	lib/MooseX/Has/Sugar/Saccharin.pm
10	11	t/00-load.t
11	12	t/04_values.t
12	13	t/04_values/AMinimal.pm

21	22	t/06_attr_required/TestPackage.pm
22	23	t/07_attr_lazy_build.t
23	24	t/07_attr_lazy_build/TestPackage.pm
	25	t/08_saccharin.t
	26	t/08_saccharin/TestPackage.pm
	27	t/09_saccharin.t
	28	t/09_saccharin/TestPackage.pm
	29	t/author-01.whitespace.t
24	30	t/author-boilerplate.t
25		t/author-pod.t⏎
	31	t/author-pod.t
	32	t/lib/TestClean.pm⏎

+2

-1

META.json less more

6	6	"url" : "http://module-build.sourceforge.net/META-spec-v1.4.html"
7	7	},
8	8	"generated_by" : "Dist::Zilla::Plugin::MetaJSON version 1.091610",
9		"version" : "0.0403",
	9	"version" : "0.0404",
10	10	"name" : "MooseX-Has-Sugar",
11	11	"author" : [
12	12	"Kent Fredric <kentnl at cpan.org>"
13	13	],
14	14	"license" : "perl",
15	15	"requires" : {
	16	"MooseX::Types::Moose" : "0",
16	17	"namespace::autoclean" : "0",
17	18	"Test::Exception" : "0",
18	19	"Sub::Exporter" : "0",

+2

-1

META.yml less more

11	11	Carp: 0
12	12	Find::Lib: 0
13	13	Moose: 0.84
	14	MooseX::Types::Moose: 0
14	15	Sub::Exporter: 0
15	16	Test::Exception: 0
16	17	Test::More: 0

18	19	namespace::autoclean: 0
19	20	resources:
20	21	repository: git://github.com/kentfredric/MooseX-Has-Sugar.git
21		version: 0.0403
	22	version: 0.0404

+2

-1

Makefile.PL less more

8	8	NAME => 'MooseX::Has::Sugar',
9	9	AUTHOR => 'Kent\ Fredric\ \<kentnl\ at\ cpan\.org\>',
10	10	ABSTRACT => 'Sugar\ Syntax\ for\ moose\ \'has\'\ fields',
11		VERSION => '0.0403',
	11	VERSION => '0.0404',
12	12	EXE_FILES => [ qw() ],
13	13	(eval { ExtUtils::MakeMaker->VERSION(6.21) } ? (LICENSE => 'perl') : ()),
14	14	PREREQ_PM => {
	15	"MooseX::Types::Moose" => '0',
15	16	"namespace::autoclean" => '0',
16	17	"Test::Exception" => '0',
17	18	"Sub::Exporter" => '0',

+1

-1

README less more

1	1	MooseX::Has::Sugar - Sugar Syntax for moose 'has' fields
2	2
3	3	VERSION
4		version 0.0403
	4	version 0.0404
5	5
6	6	SYNOPSIS
7	7	Moose "has" syntax is generally fine, but sometimes one gets bothered

+7

-9

lib/MooseX/Has/Sugar/Minimal.pm less more

0	0	package MooseX::Has::Sugar::Minimal;
1		our $VERSION = '0.0403';
	1	our $VERSION = '0.0404';
2	2
3	3
4	4	# ABSTRACT: Less Sugary Syntax for moose 'has' fields

43	43
44	44	=head1 VERSION
45	45
46		version 0.0403
	46	version 0.0404
47	47
48	48	=head1 SYNOPSIS
49	49

74	74
75	75	=item bare
76	76
77		=back
	77	=back
78	78
79	79	=head1 EXPORT GROUPS
80	80

88	88
89	89	Exports C<ro> and C<rw> and C<bare>
90	90
91		=back
	91	=back
92	92
93	93	=head1 CONFLICTS
94	94

130	130
131	131	returns C<('bare')>
132	132
133		=back
	133	=back
134	134
135	135	=head1 BUGS
136	136

168	168
169	169	L<http://search.cpan.org/dist/MooseX-Has-Sugar/>
170	170
171		=back
	171	=back
172	172
173	173	=head1 ACKNOWLEDGEMENTS
174
175
176	174
177	175	=head1 AUTHOR
178	176

185	183	This is free software; you can redistribute it and/or modify it under
186	184	the same terms as the Perl 5 programming language system itself.
187	185
188		=cut
	186	=cut
189	187
190	188
191	189

+255

-0

lib/MooseX/Has/Sugar/Saccharin.pm less more

	0	package MooseX::Has::Sugar::Saccharin;
	1	our $VERSION = '0.0404';
	2
	3
	4	# ABSTRACT: Experimental sweetness
	5
	6	use warnings;
	7	use strict;
	8
	9
	10	use Carp ();
	11	use Sub::Exporter ();
	12
	13	Sub::Exporter::setup_exporter(
	14	{
	15	exports => [
	16	'ro', 'rw', 'required', 'lazy', 'lazy_build', 'coerce', 'weak_ref', 'auto_deref',
	17	'bare', 'default', 'init_arg', 'predicate', 'clearer', 'builder', 'trigger',
	18	],
	19	groups => { default => ['-all'], }
	20	}
	21	);
	22
	23
	24	sub bare($) {
	25	return ( 'is', 'bare', 'isa', shift, );
	26	}
	27
	28
	29	sub ro($) {
	30	return ( 'is', 'ro', 'isa', shift, );
	31	}
	32
	33
	34	sub rw($) {
	35	return ( 'is', 'rw', 'isa', shift, );
	36	}
	37
	38
	39	sub required(@) {
	40	return ( 'required', 1, @_ );
	41	}
	42
	43
	44	sub lazy(@) {
	45	return ( 'lazy', 1, @_ );
	46	}
	47
	48
	49	sub lazy_build(@) {
	50	return ( 'lazy_build', 1, @_ );
	51	}
	52
	53
	54	sub weak_ref(@) {
	55	return ( 'weak_ref', 1, @_ );
	56	}
	57
	58
	59	sub coerce(@) {
	60	return ( 'coerce', 1, @_ );
	61	}
	62
	63
	64	sub auto_deref(@) {
	65	return ( 'auto_deref', 1, @_ );
	66	}
	67
	68
	69	sub builder($) {
	70	return ( 'builder', shift );
	71	}
	72
	73
	74	sub predicate($) {
	75	return ( 'predicate', shift );
	76	}
	77
	78
	79	sub clearer($) {
	80	return ( 'clearer', shift );
	81	}
	82
	83
	84	sub init_arg($) {
	85	return ( 'init_arg', shift );
	86	}
	87
	88
	89	sub default(&) {
	90	my $code = shift;
	91	return (
	92	'default',
	93	sub {
	94	my $self = $_[0];
	95	local $_ = $self;
	96	return $code->();
	97	}
	98	);
	99	}
	100
	101
	102	sub trigger(&) {
	103	my $code = shift;
	104	return (
	105	'trigger',
	106	sub {
	107	my $self = $_[0];
	108	local $_ = $self;
	109	return $code->();
	110	}
	111	);
	112	}
	113	1;
	114
	115
	116	__END__
	117
	118	=pod
	119
	120	=head1 NAME
	121
	122	MooseX::Has::Sugar::Saccharin - Experimental sweetness
	123
	124	=head1 VERSION
	125
	126	version 0.0404
	127
	128	=head1 SYNOPSIS
	129
	130	This is a highly experimental sugaring module. No Guarantees of stability.
	131
	132	has name => rw Str, default { 1 };
	133	has suffix => required rw Str;
	134	has 'suffix', required rw Str;
	135
	136	Your choice.
	137
	138	=head1 FUNCTIONS
	139
	140	=head2 bare $Type
	141
	142	bare Str
	143
	144	equivalent to this
	145
	146	is => 'bare', isa => Str
	147
	148	=head2 ro $Type
	149
	150	ro Str
	151
	152	equivalent to this
	153
	154	is => 'ro', isa => Str,
	155
	156	=head2 rw $Type
	157
	158	rw Str
	159
	160	equivalent to this
	161
	162	is => 'rw', isa => Str
	163
	164	=head2 required @rest
	165
	166	this
	167
	168	required rw Str
	169
	170	is equivalent to this
	171
	172	required => 1, is => 'rw', isa => Str,
	173
	174	this
	175
	176	rw Str, required
	177
	178	is equivalent to this
	179
	180	is => 'rw', isa => Str , required => 1
	181
	182	=head2 lazy @rest
	183
	184	like C<( lazy => 1 , @rest )>
	185
	186	=head2 lazy_build @rest
	187
	188	like C<( lazy_build => 1, @rest )>
	189
	190	=head2 weak_ref @rest
	191
	192	like C<( weak_ref => 1, @rest )>
	193
	194	=head2 coerce @rest
	195
	196	like C<( coerce => 1, @rest )>
	197
	198	=head2 auto_deref @rest
	199
	200	like C<( auto_deref => 1, @rest )>
	201
	202	=head2 builder $buildername
	203
	204	ie:
	205
	206	required rw Str, builder '_build_foo'
	207
	208	is like
	209
	210	builder => '_build_foo'
	211
	212	=head2 predicate $predicatename
	213
	214	see builder
	215
	216	=head2 clearer $clearername
	217
	218	see builder
	219
	220	=head2 init_arg $argname
	221
	222	see builder
	223
	224	=head2 default { $code }
	225
	226	Examples:
	227
	228	default { 1 }
	229	default { { } }
	230	default { [ ] }
	231	default { $_->otherfield }
	232
	233	$_ is localised as the same value as $_[0] for convenience ( usually $self )
	234
	235	=head2 trigger { $code }
	236
	237	Works exactly like default.
	238
	239	=head1 ACKNOWLEDGEMENTS
	240
	241	=head1 AUTHOR
	242
	243	Kent Fredric <kentnl at cpan.org>
	244
	245	=head1 COPYRIGHT AND LICENSE
	246
	247	This software is copyright (c) 2009 by Kent Fredric.
	248
	249	This is free software; you can redistribute it and/or modify it under
	250	the same terms as the Perl 5 programming language system itself.
	251
	252	=cut
	253
	254

+9

-11

lib/MooseX/Has/Sugar.pm less more

0	0	package MooseX::Has::Sugar;
1		our $VERSION = '0.0403';
	1	our $VERSION = '0.0404';
2	2
3	3
4	4	# ABSTRACT: Sugar Syntax for moose 'has' fields

79	79
80	80	=head1 VERSION
81	81
82		version 0.0403
	82	version 0.0404
83	83
84	84	=head1 SYNOPSIS
85	85

215	215
216	216	=item auto_deref
217	217
218		=back
	218	=back
219	219
220	220	=head1 EXPORT GROUPS
221	221

258	258
259	259	This is a shorthand for qw( :isattrs :attrs )
260	260
261		=back
	261	=back
262	262
263	263	=head1 FUNCTIONS
264	264

303	303
304	304	returns C<('auto_deref',1)>
305	305
306		=back
	306	=back
307	307
308	308	=head1 BUGS
309	309

340	340
341	341	L<http://search.cpan.org/dist/MooseX-Has-Sugar/>
342	342
343		=back
	343	=back
344	344
345	345	=head1 ACKNOWLEDGEMENTS
346
347
348	346
349	347	=head1 AUTHOR
350	348

357	355	This is free software; you can redistribute it and/or modify it under
358	356	the same terms as the Perl 5 programming language system itself.
359	357
360		=cut
361
362
	358	=cut
	359
	360

+1

-1

t/04_values/AMinimal.pm less more

0	0	package AMinimal;
1		our $VERSION = '0.0403';
	1	our $VERSION = '0.0404';
2	2
3	3
4	4	# $Id:$

+1

-1

t/04_values/BDeclare.pm less more

0	0	package BDeclare;
1		our $VERSION = '0.0403';
	1	our $VERSION = '0.0404';
2	2
3	3
4	4	# $Id:$

+1

-1

t/04_values/CDeclareRo.pm less more

0	0	package CDeclareRo;
1		our $VERSION = '0.0403';
	1	our $VERSION = '0.0404';
2	2
3	3
4	4	# $Id:$

+1

-1

t/04_values/DEverything.pm less more

0	0	package DEverything;
1		our $VERSION = '0.0403';
	1	our $VERSION = '0.0404';
2	2
3	3
4	4	# $Id:$

+1

-1

t/04_values/EMixed.pm less more

0	0	package EMixed;
1		our $VERSION = '0.0403';
	1	our $VERSION = '0.0404';
2	2
3	3
4	4	# $Id:$

+1

-1

t/04_values/TestCant.pm less more

0	0	package TestCant;
1		our $VERSION = '0.0403';
	1	our $VERSION = '0.0404';
2	2
3	3
4	4	# $Id:$

+1

-1

t/05_is/TestPackage.pm less more

0	0	package TestPackage;
1		our $VERSION = '0.0403';
	1	our $VERSION = '0.0404';
2	2
3	3
4	4	# $Id:$

+1

-1

t/06_attr_required/TestPackage.pm less more

0	0	package TestPackage;
1		our $VERSION = '0.0403';
	1	our $VERSION = '0.0404';
2	2
3	3
4	4	# $Id:$

+1

-1

t/07_attr_lazy_build/TestPackage.pm less more

0	0	package TestPackage;
1		our $VERSION = '0.0403';
	1	our $VERSION = '0.0404';
2	2
3	3
4	4	# $Id:$

+29

-0

t/08_saccharin/TestPackage.pm less more

	0	package TestPackage;
	1	our $VERSION = '0.0404';
	2
	3
	4	# $Id:$
	5	use strict;
	6	use warnings;
	7	use Moose;
	8	use namespace::autoclean;
	9
	10	use MooseX::Has::Sugar::Saccharin;
	11	use MooseX::Types::Moose (':all');
	12
	13	has roattr => lazy_build ro Str;
	14
	15	has rwattr => lazy_build rw Str;
	16
	17	sub _build_rwattr {
	18	return 'y';
	19	}
	20
	21	sub _build_roattr {
	22	return 'y';
	23	}
	24
	25	__PACKAGE__->meta->make_immutable;
	26
	27	1;
	28

+29

-0

t/08_saccharin.t less more

	0
	1	use strict;
	2	use warnings;
	3
	4	use Test::More tests => 7; # last test to print
	5	use Test::Exception;
	6	use Find::Lib './08_saccharin';
	7
	8	use TestPackage;
	9
	10	sub cr {
	11	return TestPackage->new();
	12	}
	13
	14	pass("Syntax Compiles");
	15
	16	lives_ok( sub { cr() }, 'Construction still works' );
	17
	18	my $i = cr();
	19
	20	is( $i->roattr, 'y', 'Builders Still Trigger 1' );
	21	is( $i->rwattr, 'y', 'Builders Still Trigger 2' );
	22
	23	dies_ok( sub { $i->roattr('x') }, "RO works still" );
	24
	25	lives_ok( sub { $i->rwattr('x') }, 'RW works still' );
	26
	27	is( $i->rwattr(), 'x', "RW Works as expected" );
	28

+41

-0

t/09_saccharin/TestPackage.pm less more

	0	package TestPackage;
	1	our $VERSION = '0.0404';
	2
	3
	4	# $Id:$
	5	use strict;
	6	use warnings;
	7	use Moose;
	8	use MooseX::Types::Moose (':all');
	9	use MooseX::Has::Sugar::Saccharin;
	10	use namespace::autoclean;
	11
	12	sub Alpha {
	13	return {
	14	orig => { 'isa' => Str, 'required' => 1, 'is' => 'rw' },
	15	mx => { required rw Str },
	16	};
	17	}
	18
	19	sub Beta {
	20	return {
	21	orig => { 'isa' => Str, 'required' => 1, 'is' => 'rw' },
	22	mx => { rw Str, required },
	23	};
	24	}
	25
	26	sub Gamma {
	27	return {
	28	orig => {
	29	'isa' => Str,
	30	'is' => 'rw',
	31	default => sub {
	32	return 1;
	33	}
	34	},
	35	mx => { rw Str, default { 1 } },
	36	};
	37	}
	38
	39	1;
	40

+11

-0

t/09_saccharin.t less more

	0	use strict;
	1	use warnings;
	2
	3	use Test::More tests => 3; # last test to print
	4	use Find::Lib './09_saccharin';
	5	use TestPackage;
	6
	7	is_deeply( TestPackage->Alpha->{orig}, TestPackage->Alpha->{mx}, 'Basic Use Case', );
	8	is_deeply( TestPackage->Beta->{orig}, TestPackage->Beta->{mx}, 'Order Invert', );
	9	is_deeply( TestPackage->Gamma->{orig}->{default}->(), TestPackage->Gamma->{mx}->{default}->(), 'Subs', );
	10

+36

-0

t/author-01.whitespace.t less more

	0
	1	BEGIN {
	2	unless ($ENV{AUTHOR_TESTING}) {
	3	require Test::More;
	4	Test::More::plan(skip_all => 'these tests are for testing by the author');
	5	}
	6	}
	7
	8	#
	9	# This test checks all files in the dist of interest for excess whitespace,
	10	# or bad whitespace
	11	#
	12
	13	use strict;
	14	use warnings;
	15
	16	use File::Find::Rule;
	17	use File::Find::Rule::Perl;
	18	use Path::Class qw( file dir );
	19	use FindBin;
	20	use Moose::Autobox;
	21
	22	use Test::More qw( no_plan );
	23	use lib "$FindBin::Bin/lib";
	24	use TestClean;
	25
	26	my ($dir) = ( dir($FindBin::Bin)->parent );
	27	my (@subdirs) = ( map { $dir->subdir($_) } qw( lib t ) );
	28	my (@files);
	29	push @files, File::Find::Rule->perl_file->in(@subdirs);
	30	push @files, File::Find::Rule->name("*.ini")->in("$dir");
	31
	32	for (@files) {
	33	my $fn = file($_)->relative($dir)->stringify;
	34	is_clean($fn);
	35	}⏎

+1

-3

t/author-pod.t less more

12	12	use Test::More;
13	13
14	14	# Ensure a recent version of Test::Pod
15		my $min_tp = 1.22;
16		eval "use Test::Pod $min_tp";
17		plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
	15	use Test::Pod 1.22;
18	16
19	17	all_pod_files_ok();⏎

+57

-0

t/lib/TestClean.pm less more

	0	package TestClean;
	1	our $VERSION = '0.0404';
	2
	3
	4	# $Id:$
	5	my $CLASS = __PACKAGE__;
	6	use base 'Test::Builder::Module';
	7	@EXPORT = qw( is_clean );
	8
	9	sub pp {
	10	require Data::Dumper;
	11	local $Data::Dumper::Terse = 1;
	12	local $Data::Dumper::Useqq = 1;
	13	local $Data::Dumper::Indent = 0;
	14	return Data::Dumper::Dumper(shift);
	15	}
	16
	17	sub is_clean($;$) {
	18	my $file = shift;
	19	my $msg = shift;
	20	$msg \|\|= "Cleanlyness for $file";
	21	my $tb = $CLASS->builder;
	22	my $fh;
	23	my $o;
	24	if ( not open $fh, '<', $file ) {
	25	my $o = $tb->ok( 0, $msg );
	26	$tb->diag("Loading $file Failed");
	27	return $o;
	28	}
	29	while ( my $line = <$fh> ) {
	30
	31	# Tailing Whitespace is pesky
	32	if ( $line =~ qr/\h$/m ) {
	33	$o = $tb->ok( 0, $msg ) unless $o;
	34	$tb->diag( "\n\n\\h found on end of line $. in $file\n" . pp($line) . "\n" );
	35	}
	36
	37	# Tabs are teh satan.
	38	if ( $line =~ qr/\t/m ) {
	39	$o = $tb->ok( 0, $msg ) unless $o;
	40	$tb->diag( "\\t found in line $. in $file\n" . pp($line) . "\n" );
	41	}
	42
	43	# Perltidyness in teh comments
	44	if ( $line =~ qr/[)][{]/ ) {
	45	$o = $tb->ok( 0, $msg ) unless $o;
	46	$tb->diag( ')' . "{ found in line $. in $file\n" . pp($line) . "\n" );
	47	}
	48	}
	49	close $fh;
	50	if ($o) {
	51	return $o;
	52	}
	53	return $tb->ok( 1, $msg );
	54	}
	55
	56	1;