Toby Inkster avatar Toby Inkster committed 3b6fcdf Draft

initial version

Comments (0)

Files changed (14)

+use inc::Module::Package 'RDF:tobyink 0.009';
+

lib/List/AssignRef.pm

+package List::AssignRef;
+
+use 5.006;
+use strict;
+use warnings;
+use lvalue;
+use Carp qw( confess );
+use Scalar::Util qw( reftype );
+
+use constant {
+	SCALAR   => 'SCALAR',
+	ARRAY    => 'ARRAY',
+	HASH     => 'HASH',
+};
+
+use constant {
+	ERR_UNSUPPORTED => "Unsupported reference type: %s",
+	ERR_MISMATCH    => "Reference type mismatch: %s vs %s",
+};
+
+BEGIN {
+	$List::AssignRef::AUTHORITY = 'cpan:TOBYINK';
+	$List::AssignRef::VERSION   = '0.001';
+}
+
+use Sub::Exporter -setup => {
+	exports  => [qw( deref )],
+	groups   => {
+		default  => [qw( deref )],
+	},
+};
+
+sub _confessf
+{
+	my $fmt = shift;
+	confess sprintf $fmt, @_;
+}
+
+sub deref (\[$@%]) :lvalue
+{
+	my $given = shift;
+	get {
+		reftype($given) eq SCALAR ? $$given :
+		reftype($given) eq ARRAY  ? @$given :
+		reftype($given) eq HASH   ? %$given :
+		_confessf(ERR_UNSUPPORTED, reftype($given));
+	}
+	set {
+		my $assign = shift;
+		reftype($given) eq reftype($assign)
+			or _confessf(ERR_MISMATCH, reftype($given), reftype($assign));
+		reftype($given) eq SCALAR ? ($$given = $$assign):
+		reftype($given) eq ARRAY  ? (@$given = @$assign):
+		reftype($given) eq HASH   ? (%$given = %$assign):
+		_confessf(ERR_UNSUPPORTED, reftype($given));
+	}
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+List::AssignRef - assign an arrayref to an array sensibly
+
+=head1 SYNOPSIS
+
+	# You can't do this in Perl...
+	
+	my \@array = $arrayref;
+	
+	# But you can do this...
+	
+	use List::AssignRef;
+	deref my @array = $arrayref;
+
+=head1 DESCRIPTION
+
+OK, so you might ask yourself, why would you want to do this:
+
+	my \@array = $arrayref;
+
+When you can just do this:
+
+	my @array = @{ $arrayref };
+
+Well, in that simple case List::AssignRef is overkill.
+
+However, what about cases when you have a function that returns a list of
+arrayrefs, such as C<part> from L<List::MoreUtils>. For example:
+
+	my ($staff, $managers) = part { $_->title =~ /Manager/ } @employees;
+
+If you want C<< @staff >> and C<< @managers >> arrays (as against arrayrefs),
+you need to dereference each separately. Something like:
+
+	my @parted = part { $_->title =~ /Manager/ } @employees;
+	my @staff    = @{$parted[0]};
+	my @managers = @{$parted[1]};
+
+List::AssignRef makes this slightly prettier:
+
+	(deref my @staff, deref my @managers)
+		= part { $_->title =~ /Manager/ } @employees;
+
+List::AssignRef exports exactly one function...
+
+=over
+
+=item C<< deref ARRAY|HASH|SCALAR >>
+
+C<deref> must be given a (non-reference) array, hash or scalar. It acts as
+an lvalue, allowing a reference array, hash or scalar respectively to be
+assigned to it.
+
+=back
+
+This module uses L<Sub::Exporter> which means that you can rename the
+exported function easily:
+
+	use List::AssignRef deref => { -as => 'dereference' };
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=List-AssignRef>.
+
+=head1 SEE ALSO
+
+L<List::Util>,
+L<List::MoreUtils>.
+
+L<Ref::List> is not dissimilar but without the prototype trickery and lvalue
+stuff, so doesn't satisfy this module's use case.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2012 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.
+

meta/changes.pret

+# This file acts as the project's changelog.
+
+`List-AssignRef 0.001 cpan:TOBYINK`
+	issued  2012-11-01;
+	label   "Initial release".
+
+# This file contains general metadata about the project.
+
+@prefix : <http://usefulinc.com/ns/doap#>.
+
+`List-AssignRef`
+	:programming-language "Perl" ;
+	:shortdesc            "assign an arrayref to an array sensibly";
+	:homepage             <https://metacpan.org/release/List-AssignRef>;
+	:download-page        <https://metacpan.org/release/List-AssignRef>;
+	:bug-database         <http://rt.cpan.org/Dist/Display.html?Queue=List-AssignRef>;
+	:respository          [ a :HgRepository; :browse <https://bitbucket.org/tobyink/p5-list-assignref> ];
+	:created              2012-11-01;
+	:license              <http://dev.perl.org/licenses/>;
+	:maintainer           cpan:TOBYINK;
+	:developer            cpan:TOBYINK.
+
+<http://dev.perl.org/licenses/>
+	dc:title  "the same terms as the perl 5 programming language system itself".
+

meta/makefile.pret

+# This file provides instructions for packaging.
+
+`List-AssignRef`
+	perl_version_from m`List::AssignRef`;
+	version_from      m`List::AssignRef`;
+	readme_from       m`List::AssignRef`;
+	test_requires     p`Test::More 0.61`;
+	test_requires     p`List::MoreUtils`;
+	requires          p`lvalue`;
+	requires          p`Sub::Exporter`;
+.
+
+# This file contains data about the project developers.
+
+@prefix : <http://xmlns.com/foaf/0.1/>.
+
+cpan:TOBYINK
+	:name  "Toby Inkster";
+	:mbox  <mailto:tobyink@cpan.org>.
+
+use Test::More tests => 5;
+use List::AssignRef;
+use List::MoreUtils qw( part );
+
+deref my @input = [qw(
+	Ape
+	Bear
+	Bunny
+	Alligator
+	Bison
+	Badger
+)];
+
+(deref my @A, deref my @B) = part { !!/^B/ } sort @input;
+
+is_deeply(
+	\@A,
+	[qw( Alligator Ape )],
+);
+
+is_deeply(
+	\@B,
+	[qw( Badger Bear Bison Bunny )],
+);
+
+deref my %H = +{ foo => 1, bar => 2 };
+is_deeply(
+	\%H,
+	+{ foo => 1, bar => 2 },
+);
+
+
+deref my $S = \"Hello World";
+is(
+	$S,
+	"Hello World",
+);
+
+ok not eval {
+	deref my %H2 = [];
+};
+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 XT::Util;
+use Test::More;
+use Test::Pod::Coverage;
+
+plan skip_all => __CONFIG__->{skip_all}
+	if __CONFIG__->{skip_all};
+
+if ( __CONFIG__->{modules} )
+{
+	my @modules = @{ __CONFIG__->{modules} };
+	pod_coverage_ok($_, "$_ is covered") for @modules;
+	done_testing(scalar @modules);
+}
+else
+{
+	all_pod_coverage_ok();
+}
+

xt/03meta_uptodate.config

+{"package":"List-AssignRef"}
+

xt/03meta_uptodate.t

+use XT::Util;
+use Test::More tests => 1;
+use Test::RDF::DOAP::Version;
+doap_version_ok(__CONFIG__->{package}, __CONFIG__->{version_from});
+
+use Test::EOL;
+all_perl_files_ok();
+use Test::Tabs;
+all_perl_files_ok();
+use XT::Util;
+use Test::More;
+use Test::HasVersion;
+
+plan skip_all => __CONFIG__->{skip_all}
+	if __CONFIG__->{skip_all};
+
+if ( __CONFIG__->{modules} )
+{
+	my @modules = @{ __CONFIG__->{modules} };
+	pm_version_ok($_, "$_ is covered") for @modules;
+	done_testing(scalar @modules);
+}
+else
+{
+	all_pm_version_ok();
+}
+
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.