aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTom Ryder <tom@sanctum.geek.nz>2017-10-03 15:13:57 +1300
committerTom Ryder <tom@sanctum.geek.nz>2017-10-03 15:21:57 +1300
commit65a54c00d8083a96c18f02b7f43a4822e3f1fd9a (patch)
tree09b826ca77ccd7b9aad4cf830ff156eea8799499
downloadList-Breakdown-65a54c00d8083a96c18f02b7f43a4822e3f1fd9a.tar.gz
First commit of List::Filtersv0.01
I'll add more Perl distribution infrastructure and tests as I learn more about how that all works. The README.markdown is just a manually converted README for now.
-rw-r--r--.gitignore18
-rw-r--r--MANIFEST5
-rw-r--r--Makefile.PL23
-rw-r--r--README62
-rw-r--r--README.markdown66
-rw-r--r--lib/List/Filters.pm220
-rw-r--r--t/words.t39
7 files changed, 433 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..3c76d95
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,18 @@
+Makefile
+Makefile.old
+Build
+Build.bat
+META.*
+MYMETA.*
+.build/
+_build/
+cover_db/
+blib/
+inc/
+.lwpcookies
+.last_cover_stats
+nytprof.out
+pod2htm*.tmp
+pm_to_blib
+List-Categorize-*
+List-Categorize-*.tar.gz
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..cc69a76
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,5 @@
+lib/List/Filters.pm
+Makefile.PL
+MANIFEST
+README
+t/words.t
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..54aef50
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,23 @@
+use 5.006;
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'List::Filters',
+ AUTHOR => 'Tom Ryder <tom@sanctum.geek.nz>',
+ VERSION_FROM => 'lib/List/Filters.pm',
+ ABSTRACT_FROM => 'lib/List/Filters.pm',
+ LICENSE => 'artistic_2',
+ PL_FILES => {},
+ MIN_PERL_VERSION => '5.006',
+ CONFIGURE_REQUIRES => {
+ 'ExtUtils::MakeMaker' => '0',
+ },
+ BUILD_REQUIRES => {
+ 'Test::More' => '0',
+ },
+ PREREQ_PM => {},
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+ clean => { FILES => 'List-Filters-*' },
+);
diff --git a/README b/README
new file mode 100644
index 0000000..b52ef57
--- /dev/null
+++ b/README
@@ -0,0 +1,62 @@
+List-Filters
+
+Filters elements from a list non-uniquely into a specified hash
+structure, which can be nested, that pass subroutines or match regular
+expressions.
+
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the
+perldoc command.
+
+ perldoc List::Filters
+
+LICENSE AND COPYRIGHT
+
+Copyright (C) 2017 Tom Ryder
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of the the Artistic License (2.0). You may obtain a
+copy of the full license at:
+
+L<http://www.perlfoundation.org/artistic_license_2_0>
+
+Any use, modification, and distribution of the Standard or Modified
+Versions is governed by this Artistic License. By using, modifying or
+distributing the Package, you accept this license. Do not use, modify,
+or distribute the Package, if you do not accept this license.
+
+If your Modified Version has been derived from a Modified Version made
+by someone other than you, you are nevertheless required to ensure that
+your Modified Version complies with the requirements of this license.
+
+This license does not grant you the right to use any trademark, service
+mark, tradename, or logo of the Copyright Holder.
+
+This license includes the non-exclusive, worldwide, free-of-charge
+patent license to make, have made, use, offer to sell, sell, import and
+otherwise transfer the Package with respect to any patent claims
+licensable by the Copyright Holder that are necessarily infringed by the
+Package. If you institute patent litigation (including a cross-claim or
+counterclaim) against any party alleging that the Package constitutes
+direct or contributory patent infringement, then this Artistic License
+to you shall terminate on the date that such litigation is filed.
+
+Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
+AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
+THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
+PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
+YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
+CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
+CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
+EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.markdown b/README.markdown
new file mode 100644
index 0000000..6d5e8e4
--- /dev/null
+++ b/README.markdown
@@ -0,0 +1,66 @@
+List::Filters
+=============
+
+Filters elements from a list non-uniquely into a specified hash
+structure, which can be nested, that pass subroutines or match regular
+expressions.
+
+
+Installation
+------------
+
+To install this module, run the following commands:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+Support and Documentation
+-------------------------
+
+After installing, you can find documentation for this module with the
+perldoc command.
+
+ perldoc List::Filters
+
+License and Copyright
+---------------------
+
+Copyright (C) 2017 Tom Ryder
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of the the Artistic License (2.0). You may obtain a
+copy of the full license at:
+
+<http://www.perlfoundation.org/artistic_license_2_0>
+
+Any use, modification, and distribution of the Standard or Modified
+Versions is governed by this Artistic License. By using, modifying or
+distributing the Package, you accept this license. Do not use, modify,
+or distribute the Package, if you do not accept this license.
+
+If your Modified Version has been derived from a Modified Version made
+by someone other than you, you are nevertheless required to ensure that
+your Modified Version complies with the requirements of this license.
+
+This license does not grant you the right to use any trademark, service
+mark, tradename, or logo of the Copyright Holder.
+
+This license includes the non-exclusive, worldwide, free-of-charge
+patent license to make, have made, use, offer to sell, sell, import and
+otherwise transfer the Package with respect to any patent claims
+licensable by the Copyright Holder that are necessarily infringed by the
+Package. If you institute patent litigation (including a cross-claim or
+counterclaim) against any party alleging that the Package constitutes
+direct or contributory patent infringement, then this Artistic License
+to you shall terminate on the date that such litigation is filed.
+
+Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
+AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
+THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
+PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
+YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
+CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
+CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
+EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/lib/List/Filters.pm b/lib/List/Filters.pm
new file mode 100644
index 0000000..aa59a49
--- /dev/null
+++ b/lib/List/Filters.pm
@@ -0,0 +1,220 @@
+package List::Filters;
+
+# Force me to write this properly
+use strict;
+use warnings;
+use utf8;
+
+# Target reasonably old Perls
+use 5.006;
+
+# Import required modules
+use Carp;
+use Exporter 'import';
+
+# Specify package version
+our $VERSION = 0.01;
+
+# Specify functions available for export
+our @EXPORT_OK = 'filter';
+
+# Dispatch table of functions to handle different ref types for the spec
+# hashref's values
+my %types = (
+
+ # If it's a hash, apply filter() again as if it were another root-level
+ # spec
+ HASH => sub {
+ my $spec = shift;
+ return { filter( $spec, @_ ) };
+ },
+
+ # If it's a subroutine, return a arrayref of all elements for which it
+ # returns true
+ CODE => sub {
+ my $sub = shift;
+ return [ grep { $sub->() } @_ ];
+ },
+
+ # If it's a regular expression, return an arrayref of all elements it
+ # matches
+ Regexp => sub {
+ my $re = shift;
+ return [ grep { $_ =~ $re } @_ ];
+ },
+);
+
+# Given a spec and a list of items, filter them into a hash of the same
+# structure
+sub filter {
+ my ( $spec, @items ) = @_;
+
+ # Check the spec is a hashref
+ ref $spec eq 'HASH'
+ or croak 'HASH reference expected for first argument';
+
+ # Start building a results hash
+ my %results;
+ for my $key ( keys %{$spec} ) {
+
+ # Check that the value for this key is a reference
+ my $ref = ref $spec->{$key}
+ or croak "Reference expected for '$key'";
+
+ # Check it's a reference we understand
+ exists $types{$ref}
+ or croak "Unhandled ref type $ref for '$key'";
+
+ # Apply the appropriate subroutine for this reference type to the list
+ # of items
+ $results{$key} = $types{$ref}->( $spec->{$key}, @items );
+ }
+
+ # Return the constructed result set
+ return %results;
+}
+
+1;
+
+__END__
+
+=pod
+
+=for stopwords
+sublists Unhandled tradename licensable MERCHANTABILITY
+
+=head1 NAME
+
+List::Filters - Build list sublists matching conditions
+
+=head1 VERSION
+
+Version 0.01
+
+=head1 DESCRIPTION
+
+This module filters elements from a list non-uniquely into a specified hash
+structure, which can be nested. It may be useful in situations where you have a
+big list of things to generate reports on or to otherwise filter into several
+sublists.
+
+It differs from the excellent C<List::Categorize> in that it does not require
+only one final category for any given item; an item can be in more than one
+filter.
+
+You could maybe think of it as a multi-C<grep> that returns named results.
+
+=head1 SYNOPSIS
+
+ my @words = qw(foo bar baz quux wibble florb);
+ my $cats = {
+ all => sub { 1 },
+ has_b => sub { m/ b /msx },
+ has_w => sub { m/ w /msx },
+ length => {
+ 3 => sub { length == 3 },
+ 4 => sub { length == 4 },
+ long => sub { length > 4 },
+ },
+ has_ba => qr/ba/msx,
+ };
+ my %filterd = filter $cats, @words;
+
+=head1 SUBROUTINES/METHODS
+
+=head2 B<filter(\%spec, @items)>
+
+Given a hash reference structure and a list of items, apply each of the
+subroutines or regular expressions given as values of the hash reference,
+returning a new hash in the same structure with the tests replaced with the
+items that for which the subroutine was true or the regular expression matched.
+
+=head1 AUTHOR
+
+Tom Ryder C<< <tom@staff.inspire.net.nz> >>
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item HASH reference expected for first argument
+
+The first argument that B<filter()> saw wasn't the hash reference it expects.
+That's the only format a spec is allowed to have.
+
+=item Reference expected for '%s'
+
+The value for the named key in the spec was not a reference, and one was
+expected.
+
+=item Unhandled ref type %s for '%s'
+
+The value for the named key in the spec is of a type that makes no sense to
+this module. Legal reference types are C<HASH>, C<CODE>, and C<Regexp>.
+
+=back
+
+=head1 DEPENDENCIES
+
+Perl 5.6 and the core modules C<Carp> and C<Exporter>.
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+None required.
+
+=head1 INCOMPATIBILITIES
+
+None known.
+
+=head1 BUGS AND LIMITATIONS
+
+Definitely. This is a very early release. Please report any bugs or feature
+requests to C<tom@staff.inspire.net.nz>.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the C<perldoc> command.
+
+ perldoc List::Filters
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (C) 2017 Tom Ryder
+
+This program is free software; you can redistribute it and/or modify it under
+the terms of the the Artistic License (2.0). You may obtain a copy of the full
+license at:
+
+<http://www.perlfoundation.org/artistic_license_2_0>
+
+Any use, modification, and distribution of the Standard or Modified Versions is
+governed by this Artistic License. By using, modifying or distributing the
+Package, you accept this license. Do not use, modify, or distribute the
+Package, if you do not accept this license.
+
+If your Modified Version has been derived from a Modified Version made by
+someone other than you, you are nevertheless required to ensure that your
+Modified Version complies with the requirements of this license.
+
+This license does not grant you the right to use any trademark, service mark,
+tradename, or logo of the Copyright Holder.
+
+This license includes the non-exclusive, worldwide, free-of-charge patent
+license to make, have made, use, offer to sell, sell, import and otherwise
+transfer the Package with respect to any patent claims licensable by the
+Copyright Holder that are necessarily infringed by the Package. If you
+institute patent litigation (including a cross-claim or counterclaim) against
+any party alleging that the Package constitutes direct or contributory patent
+infringement, then this Artistic License to you shall terminate on the date
+that such litigation is filed.
+
+Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND
+CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
+WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
+NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW.
+UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY
+OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.
+
+=cut
diff --git a/t/words.t b/t/words.t
new file mode 100644
index 0000000..bdefa43
--- /dev/null
+++ b/t/words.t
@@ -0,0 +1,39 @@
+#!perl -T
+
+use strict;
+use warnings;
+use utf8;
+
+use Test::More tests => 1;
+
+use List::Filters 'filter';
+
+our $VERSION = 0.01;
+
+my @words = qw(foo bar baz quux wibble florb);
+my $filters = {
+ all => sub { 1 },
+ has_b => sub { m/ b /msx },
+ has_w => sub { m/ w /msx },
+ length => {
+ 3 => sub { length == 3 },
+ 4 => sub { length == 4 },
+ long => sub { length > 4 },
+ },
+ has_ba => qr/ba/msx,
+};
+my %filtered = filter $filters, @words;
+
+my %expected = (
+ all => [qw(foo bar baz quux wibble florb)],
+ has_b => [qw(bar baz wibble florb)],
+ has_w => [qw(wibble)],
+ length => {
+ 3 => [qw(foo bar baz)],
+ 4 => [qw(quux)],
+ long => [qw(wibble florb)],
+ },
+ has_ba => [qw(bar baz)],
+);
+
+is_deeply( \%filtered, \%expected, 'words' );