From 65a54c00d8083a96c18f02b7f43a4822e3f1fd9a Mon Sep 17 00:00:00 2001 From: Tom Ryder Date: Tue, 3 Oct 2017 15:13:57 +1300 Subject: First commit of List::Filters 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. --- .gitignore | 18 +++++ MANIFEST | 5 ++ Makefile.PL | 23 ++++++ README | 62 +++++++++++++++ README.markdown | 66 ++++++++++++++++ lib/List/Filters.pm | 220 ++++++++++++++++++++++++++++++++++++++++++++++++++++ t/words.t | 39 ++++++++++ 7 files changed, 433 insertions(+) create mode 100644 .gitignore create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 README.markdown create mode 100644 lib/List/Filters.pm create mode 100644 t/words.t 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 ', + 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 + +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: + + + +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 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 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 + +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<< >> + +=head1 DIAGNOSTICS + +=over 4 + +=item HASH reference expected for first argument + +The first argument that B 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, C, and C. + +=back + +=head1 DEPENDENCIES + +Perl 5.6 and the core modules C and C. + +=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. + +=head1 SUPPORT + +You can find documentation for this module with the C 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: + + + +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' ); -- cgit v1.2.3