Array-IntSpan-2.003000755001750001750 012447330407 13215 5ustar00domidomi000000000000README100644001750001750 341012447330407 14154 0ustar00domidomi000000000000Array-IntSpan-2.003 This distribution provides a set of modules: Array::IntSpan - a Module for handling arrays using integer ranges Array::IntSpan::Fields - IntSpan array using integer fields as indices Array::IntSpan::IP - a Module for arrays using IP addresses as indices Array::IntSpan brings the speed advantages of Set::IntSpan (written by Steven McDougall) to arrays. Uses include manipulating grades, routing tables, or any other situation where you have mutually exclusive ranges of integers that map to given values (or objects) The new version of Array::IntSpan is able to consolidate ranges by comparing adjacent values. Array::IntSpan::Fields brings the advantages of Array::IntSpan to indices made of integer fields like an IP address and an ANSI SS7 point code. Array::IntSpan::IP brings the advantages of Array::IntSpan to IP address indices. Anywhere you use an index in Array::IntSpan, you can use an IP address in one of three forms in Array::IntSpan::IP. Version 2.001 was heavily modified from version 1.01. The module was heavily tested but you should test your application with v2.001 before any important use. --------------------------------------------------------------------- INSTALLATION from CPAN gunzip -c .tar.gz | tar xvf - cd perl Makefile.PL make test make install INSTALLATION from git requires Dist::Zilla You must make sure that the following modules are installed: Dist::Zilla::Plugin::MetaResources Dist::Zilla::Plugin::Prepender Dist::Zilla::Plugin::Prereqs Dist::Zilla::PluginBundle::Filter On debian or ubuntu, do: sudo aptitude install \ libdist-zilla-plugin-prepender-perl \ libdist-zilla-plugins-cjm-perl \ libdist-zilla-perl Then run: dzil build or dzil test dzil build LICENSE100644001750001750 1171712447330407 14332 0ustar00domidomi000000000000Array-IntSpan-2.003This software is Copyright (c) 2014 by Dominique Dumont. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. 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. The End dist.ini100644001750001750 156012447330407 14744 0ustar00domidomi000000000000Array-IntSpan-2.003name = Array-IntSpan author = Dominique Dumont license = Artistic_1_0 copyright_holder = Dominique Dumont copyright_year = 2014 [MetaResources] homepage = https://github.com/dod38fr/array-intspan-perl bugtracker.web = http://rt.cpan.org/NoAuth/Bugs.html?Dist=Array-IntSpan bugtracker.mailto = bug-project@rt.cpan.org repository.url = https://github.com/dod38fr/array-intspan-perl.git repository.web = https://github.com/dod38fr/array-intspan-perl repository.type = git [@Filter] -bundle = @Basic -remove = Readme [AutoPrereqs] skip = ^[a-z\d]+$ skip = ExtUtils::testlib skip = Exporter [Prepender] copyright=1 [NextRelease] format = %v%T %{yyyy-MM-dd}d [PkgVersion] ; use 'V=2.234 dzil release' to override version number [Git::NextVersion] [Git::Check] allow_dirty = dist.ini allow_dirty = Changes [Git::Commit] [Git::Tag] [Git::Push] [MetaJSON] META.yml100644001750001750 124412447330407 14550 0ustar00domidomi000000000000Array-IntSpan-2.003--- abstract: 'Handles arrays of scalars or objects using integer ranges' author: - 'Dominique Dumont' build_requires: Data::Dumper: '0' Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 5.020, CPAN::Meta::Converter version 2.142690' license: artistic meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Array-IntSpan requires: Carp: '0' resources: bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Array-IntSpan homepage: https://github.com/dod38fr/array-intspan-perl repository: https://github.com/dod38fr/array-intspan-perl.git version: '2.003' MANIFEST100644001750001750 53612447330407 14413 0ustar00domidomi000000000000Array-IntSpan-2.003# This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.020. ChangeLog LICENSE MANIFEST META.json META.yml Makefile.PL README dist.ini lib/Array/IntSpan.pm lib/Array/IntSpan/Fields.pm lib/Array/IntSpan/IP.pm t/clobbered_items.t t/consolidate.t t/empty_span.t t/fields.t t/get_range.t t/get_splice_parms.t t/search.t t/set_range.t ChangeLog100644001750001750 377312447330407 15062 0ustar00domidomi000000000000Array-IntSpan-2.0032014-12-24 v2.003 * Added set, set_range_as_string and get_range_list methods * mention that consolidate can be called without arguments 2010-09-28 Dominique Dumont v2.002 * Array/IntSpan.pm (lookup): returns undef on an empty object without mucking up internal data (Fixes RT 61700. Thanks to Matthew Nodine for the report) 2004-01-29 Dominique Dumont v2.001 * IntSpan.pm: Updated copyright infos 2003-05-26 Dominique Dumont * IntSpan.pm, IntSpan/Fields.pm: - bug fix in Fields::adapt_range_in_cb: method can be undef 2003-04-17 Dominique Dumont * IntSpan.pm, IntSpan/Fields.pm: - small code refactoring and perf improvement 2003-03-19 Dominique Dumont * IntSpan.pm: - added clear function in IntSpan 2003-03-07 Dominique Dumont * IntSpan.pm: - some optimizations - cannot create range with undef values. 2003-03-04 Dominique Dumont * IntSpan.pm, IntSpan/Fields.pm: - added Array::IntSpan::Fields - callback signature are now (start, end, [payload]) 2003-02-24 Dominique Dumont * IntSpan.pm: - various get_range bug_fixes 2003-02-14 Dominique Dumont * IntSpan.pm: - get_range bug with fill: read range is now also modified 2003-02-13 Dominique Dumont * IntSpan.pm: - get_range: bug fix with filler subf * IntSpan.pm: - get_range: fill can be done with a sub ref - set_*_range: copy of splitted range items can be done using a sub ref. In this case the original value is passed to the sub ref. It must return the new value 2003-02-12 Dominique Dumont * IntSpan.pm: - added fill parameter to get_range - split tests * IntSpan.pm: - bug fix in empty ranges 2003-02-11 Dominique Dumont * IntSpan.pm: - better get_range and set_range 2003-02-06 Dominique Dumont * IntSpan.pm: Modified version 1.02 with consolidation * IntSpan.pm, IntSpan/IP.pm: Initial version 1.01 from Toby Everett * IntSpan.pm, IntSpan/IP.pm: New file. 1.01 Thu Feb 24 14:10:00 2000 - fixed Makefile.PL 1.00 Thu Feb 24 14:00:00 2000 - original version META.json100644001750001750 235512447330407 14724 0ustar00domidomi000000000000Array-IntSpan-2.003{ "abstract" : "Handles arrays of scalars or objects using integer ranges", "author" : [ "Dominique Dumont" ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 5.020, CPAN::Meta::Converter version 2.142690", "license" : [ "artistic_1" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Array-IntSpan", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Carp" : "0" } }, "test" : { "requires" : { "Data::Dumper" : "0", "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-project@rt.cpan.org", "web" : "http://rt.cpan.org/NoAuth/Bugs.html?Dist=Array-IntSpan" }, "homepage" : "https://github.com/dod38fr/array-intspan-perl", "repository" : { "type" : "git", "url" : "https://github.com/dod38fr/array-intspan-perl.git", "web" : "https://github.com/dod38fr/array-intspan-perl" } }, "version" : "2.003" } t000755001750001750 012447330407 13401 5ustar00domidomi000000000000Array-IntSpan-2.003fields.t100644001750001750 361012447330407 15174 0ustar00domidomi000000000000Array-IntSpan-2.003/tuse strict ; use warnings FATAL => qw(all); use ExtUtils::testlib; use Test::More tests => 27 ; use Data::Dumper ; use Array::IntSpan::Fields ; my $trace = shift || 0 ; my @expect= (['0.0.1','0.1.0','ab'], ['1.0.0','1.0.3','cd'], ['1.0.4','1.1.0','ef']) ; my $r = Array::IntSpan::Fields->new('1.2.4',@expect) ; ok ( defined($r) , 'Array::IntSpan::Fields new() works') ; is_deeply([$r->get_element(1)], ['1.0.0','1.0.3','cd'], 'get_element' ); foreach my $t (qw/0.0.10 0.3.0 1.0.0 1.2.3 0.1.0/) { my $int = $r-> field_to_int($t); ok ($int, "field_to_int test $t -> $int") ; is($r-> int_to_field($int), $t, "int_to_field test $int -> $t") ; } eval{$r-> field_to_int('2.0.0')} ; like($@, qr/Field value 2 too great/, 'test field check') ; eval{$r-> field_to_int('1.0.17')} ; like($@, qr/Field value 17 too great/, 'test field check') ; $r->set_range('1.1.1','1.2.1','gh') ; is($r->lookup('1.2.0'),'gh',"lookup test") ; my $res = $r->get_range('1.0.0','1.3.15') ; isa_ok($res,'Array::IntSpan::Fields') ; is($res->lookup('1.0.0'),'cd','get range test 1') ; is($res->lookup('1.0.5'),'ef','get range test 2') ; $r->set_range('1.1.5','1.2.5','sub',sub{"@_"}); is($r->lookup('1.2.4'),'sub','set_range with sub') ; is($r->lookup('1.1.4'),'1.1.1 1.1.4 gh','set_range with sub') ; my $regular = Array::IntSpan::Fields->new([1,3,'ab'],[5, 7, 'cd']); isa_ok($regular,'Array::IntSpan') ; my $int32 = Array::IntSpan::Fields->new('32',[1,3,'ab'],[5, 7, 'cd']); isa_ok($int32,'Array::IntSpan::Fields') ; foreach my $t (qw/1 100/) { my $int = $int32-> field_to_int($t); ok ($int, "field_to_int int 32 test $t -> $int") ; is($int32-> int_to_field($int), $t, "int_to_field int 32 test $int -> $t") ; } eval{my $int2 = Array::IntSpan::Fields->new('2',[1,3,'ab'],[5, 7, 'cd']);}; like($@, qr/Field value 5 too great. Max is 3/, 'test field check') ; search.t100644001750001750 77212447330407 15161 0ustar00domidomi000000000000Array-IntSpan-2.003/t use warnings FATAL => qw(all); use ExtUtils::testlib; use Test::More tests => 9 ; use Data::Dumper ; use Array::IntSpan; my $trace = shift || 0 ; my @expect= ([1,3,'ab'],[6,9,'cd']) ; my $r = Array::IntSpan->new(@expect) ; diag(Dumper $r) if $trace ; ok ( defined($r) , 'Array::IntSpan new() works') ; is_deeply( $r , \@expect, 'new content ok') ; foreach my $a ( [2,0], [3,0], [4,1], [4,1], [6,1], [9,1] , [10,2]) { is($r->search(0,2,$a->[0]), $a->[1], "search(0,2,$a->[0], $a->[1] )"); } Makefile.PL100644001750001750 205512447330407 15252 0ustar00domidomi000000000000Array-IntSpan-2.003 # This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.020. use strict; use warnings; use ExtUtils::MakeMaker ; my %WriteMakefileArgs = ( "ABSTRACT" => "Handles arrays of scalars or objects using integer ranges", "AUTHOR" => "Dominique Dumont", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Array-IntSpan", "EXE_FILES" => [], "LICENSE" => "artistic", "NAME" => "Array::IntSpan", "PREREQ_PM" => { "Carp" => 0 }, "TEST_REQUIRES" => { "Data::Dumper" => 0, "Test::More" => 0 }, "VERSION" => "2.003", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Carp" => 0, "Data::Dumper" => 0, "Test::More" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); set_range.t100644001750001750 243512447330407 15701 0ustar00domidomi000000000000Array-IntSpan-2.003/t# -*- cperl-mode -*- use warnings FATAL => qw(all); use ExtUtils::testlib; use Test::More tests => 10 ; use Data::Dumper ; use Array::IntSpan; my $trace = shift || 0 ; my @expect= ([1,3,'ab'],[6,9,'cd']) ; my $r = Array::IntSpan->new(@expect) ; diag(Dumper $r) if $trace ; ok ( defined($r) , 'Array::IntSpan new() works') ; is_deeply( $r , \@expect, 'new content ok') ; my @range = (12,14,'ef') ; is ($r->set_range(@range),0, 'set_range after') ; push @expect, [@range] ; is_deeply( $r , \@expect ) ; is($r->lookup(13), 'ef', 'lookup 13') ; diag(Dumper $r) if $trace ; @range = (8,13,'ef') ; @expect = ([1, 3, 'ab'], [6, 7, 'cd'], [8, 13, 'ef'], [14, 14, 'ef']) ; is ($r->set_range(@range),1, "set_range @range") ; is_deeply($r, \@expect) || diag(Dumper $r); diag(Dumper $r) if $trace ; my $sub = sub {"c:".$_[2];} ; @range = (10,13,'ef2') ; @expect = ([1, 3, 'ab'], [6, 7, 'cd'], [8, 9, 'c:ef'], [10, 13, 'ef2'], [14, 14, 'ef']) ; is ($r->set_range(@range,$sub),1, "set_range @range with sub") ; is_deeply($r, \@expect) || diag(Dumper $r); diag(Dumper $r) if $trace ; my $rs = Array::IntSpan->new() ; $rs->set('21','bar'); $rs->set_range_as_string('1-10 ,13, 14-20', 'foo') ; is_deeply($rs, [[1,10,'foo'],[13,13,'foo'],[14,20,'foo'],[21,21,'bar']],"set_range_as_string") || diag(Dumper $rs); get_range.t100644001750001750 1177012447330407 15707 0ustar00domidomi000000000000Array-IntSpan-2.003/t# -*- cperl-mode -*- use strict ; use warnings FATAL => qw(all); use ExtUtils::testlib; use Test::More tests => 50 ; use Data::Dumper ; use Array::IntSpan; my $trace = shift || 0 ; # test min max is(Array::IntSpan::min(9,10), 9,'min test 9,10') ; is(Array::IntSpan::max(9,10),10,'max test 9,10') ; my @expect= ([1,3,'ab'],[5, 7, 'cd'], [13, 26, 'ef']) ; my $r = Array::IntSpan->new(@expect) ; diag(Dumper $r) if $trace ; ok ( defined($r) , 'Array::IntSpan new() works') ; is_deeply( $r , \@expect, 'new content ok') ; foreach my $t ( [[32,34],[]], [[4,4],[]], [[24,26],[[24,26,'ef']]], [[24,29],[[24,26,'ef']]], [[10,16],[[13,16,'ef']]], [[20,24],[[20,24,'ef']]], [[0,9],[[1,3,'ab'],[5,7,'cd']]], [[0,6],[[1,3,'ab'],[5,6,'cd']]], ) { my $new = $r->get_range(@{$t->[0]}) ; is_deeply($new, $t->[1], "get_range @{$t->[0]}") || diag("From ".Dumper($r)."Got ".Dumper ($new)) ; is(@$r, 3, 'check nb of items in range') || diag(Dumper $r); } my $fill = 'fi' ; foreach my $t ( [ [32,34], [[32,34,$fill]], [@expect,[32,34,$fill]] ], [ [0,0], [[ 0, 0,$fill]], [[0,0,$fill],@expect] ], [ [5,5], [[ 5, 5,'cd']], [[1,3,'ab'],[ 5, 5,'cd'],[6, 7, 'cd'], [13, 26, 'ef']] ], [ [24,26], [[24,26,'ef' ]], [[1,3,'ab'],[5, 7, 'cd'], [13, 23,'ef'],[24,26, 'ef']] ], [ [24,29], [[24,26,'ef'],[27,29,$fill]], [[1,3,'ab'],[5, 7, 'cd'], [13, 23,'ef'],[24,26,'ef'],[27,29,$fill]] ], [ [10,16], [[10,12,$fill],[13,16,'ef']], [[1,3,'ab'],[5, 7, 'cd'], [10,12,$fill],,[13,16,'ef'],[17, 26, 'ef']] ], [ [20,24], [[20,24,'ef']], [[1,3,'ab'],[5, 7,'cd'],[13,19,'ef'],[20,24,'ef'],[25,26,'ef']] ], [ [0,9], [[0,0,$fill],[1,3,'ab'],[4,4,$fill],[5,7,'cd'],[8,9,$fill]], [[0,0,$fill],[1,3,'ab'],[4,4,$fill],[5,7,'cd'],[8,9,$fill], [13, 26, 'ef']] ], [ [0,6], [[0,0,$fill],[1,3,'ab'],[4,4,$fill],[5,6,'cd']], [[0,0,$fill],[1,3,'ab'],[4,4,$fill],[5,6,'cd'],[7,7,'cd'], [13, 26, 'ef']] ], [ [2,5], [[2,3,'ab'],[4,4,$fill],[5, 5, 'cd']], [[1,1,'ab'],[2,3,'ab'],[4,4,$fill],[5, 5, 'cd'],[6, 7, 'cd'], [13, 26, 'ef']] ] ) { my $r2 = Array::IntSpan->new(@expect) ; my $old = Dumper($r2) ; my $new = $r2->get_range(@{$t->[0]}, $fill) ; is_deeply($new, $t->[1], "get_range with fill @{$t->[0]}") || diag("From ".$old."Got ".Dumper ($new)) ; is_deeply($r2, $t->[2], "range after get_range with fill") || diag("From ".$old."Expected ".Dumper($t->[2])."Got ".Dumper ($r2)) ; } my $sub = sub { "sfi"}; $fill = &$sub ; foreach my $t ( [[30,39],[[30,39,$fill]],[@expect,[30,39,$fill]]], [ [0,9], [[0,0,$fill],[1,3,'ab'],[4,4,$fill],[5,7,'cd'],[8,9,$fill]], [[0,0,$fill],[1,3,'ab'],[4,4,$fill],[5,7, 'cd'],[8,9,$fill], [13, 26, 'ef']] ], ) { my $r2 = Array::IntSpan->new(@expect) ; my $old = Dumper($r2) ; my $new = $r2->get_range(@{$t->[0]}, $sub) ; is_deeply($new, $t->[1], "get_range with fill sub @{$t->[0]}") || diag("From ".$old."Got ".Dumper ($new)) ; is_deeply($r2, $t->[2], "range after get_range with sub") || diag("From ".$old."Expected ".Dumper($t->[2])."Got ".Dumper ($r2)) ; } @expect=([9,9,'ab'],[10,10,'bc'],[11,11,'cd'],[12,12,'ef']); foreach my $t ( [ [9,10], [[9,9,'ab'],[10,10,'bc']], [@expect] ], [ [9,12], [@expect], [@expect] ] ) { my $r2 = Array::IntSpan->new(@expect) ; my $old = Dumper($r2) ; my $new = $r2->get_range(@{$t->[0]}, $sub) ; is_deeply($new, $t->[1], "get_range with fill sub @{$t->[0]}") || diag("From ".$old."Got ".Dumper ($new)) ; is_deeply($r2, $t->[2], "range after get_range with sub") || diag("From ".$old."Expected ".Dumper($t->[2])."Got ".Dumper ($r2)) ; } @expect= ([1,3,'ab'],[5, 5, 'cd'], [13, 26, 'ef']) ; my $rs = Array::IntSpan->new(@expect) ; is_deeply([ $rs->get_range_list ], [[1,3],[5, 5], [13, 26] ], "get_ranges in list context"); is_deeply(scalar $rs->get_range_list, '1-3, 5, 13-26', "get_ranges in scalar context"); diag(Dumper $r) if $trace ; empty_span.t100644001750001750 117012447330407 16104 0ustar00domidomi000000000000Array-IntSpan-2.003/t# -*- cperl -*- use warnings FATAL => qw(all); use ExtUtils::testlib; use Test::More tests => 7 ; use Data::Dumper ; use Array::IntSpan; my $trace = shift || 0 ; my $r2 = Array::IntSpan->new() ; ok($r2, 'empty span created') ; # test for RT 61700 is($r2 -> lookup(1),undef,"test lookup on empty span (RT 61700)") ; is(@{$r2->get_range(1,10)}, 0 , 'get on empty set works'); is(@{$r2->set_range(1,10,'ab')}, 0 , 'set on empty set works'); is(@{$r2->set_range(1,10,undef)}, 0 , 'go back to empty set'); is(@$r2, 0 , 'set is empty'); is(@{$r2->set_consolidate_range(1,10,'ab')}, 0 , 'set_consolidate_range on empty set works'); consolidate.t100644001750001750 366012447330407 16237 0ustar00domidomi000000000000Array-IntSpan-2.003/t use warnings FATAL => qw(all); use ExtUtils::testlib; use Test::More tests => 27 ; use Data::Dumper ; use Array::IntSpan; my $trace = shift || 0 ; my @expect= ([1,3,'ab'], [6, 7, 'cd'], [8, 13, 'ef'], [14, 14, 'ef']) ; my $r = Array::IntSpan->new(@expect) ; diag(Dumper $r) if $trace ; ok ( defined($r) , 'Array::IntSpan new() works') ; is_deeply( $r , \@expect, 'new content ok') ; $r->consolidate ; @expect= ([1,3,'ab'], [6, 7, 'cd'], [8, 14, 'ef']) ; is_deeply( $r , \@expect, 'consolidate ok') || diag(Dumper $r); diag(Dumper $r) if $trace ; my @sub = ( sub {"c:".$_[2];}, sub {print "set called with @_\n";} ); foreach my $t ( [[5,5,'cd'],0,[[1,3,'ab'], [5, 7, 'cd'], [8, 14, 'ef']]], [[13,16,'ef'],1,[[1,3,'ab'], [5, 7, 'cd'], [8, 16, 'ef']]], [[24,26,'ef'],0,[[1,3,'ab'], [5, 7, 'cd'], [8, 16, 'ef'],[24,26,'ef']]] , [[19,22,'ef'],0,[[1,3,'ab'], [5, 7, 'cd'], [8, 16, 'ef'],[19,22,'ef'],[24,26,'ef']]], [[23,23,'efa'],0,[[1,3,'ab'], [5, 7, 'cd'], [8, 16, 'ef'],[19,22,'ef'],[23,23,'efa'],[24,26,'ef']]], [[23,23,'ef'],1,[[1,3,'ab'], [5, 7, 'cd'], [8, 16, 'ef'],[19,26,'ef']]], [[17,18,'efb'],0,[[1,3,'ab'], [5, 7, 'cd'], [8, 16, 'ef'],[17,18,'efb'],[19,26,'ef']]], [[17,18,'ef'],1,[[1,3,'ab'], [5, 7, 'cd'], [8 ,26,'ef']]], [[8,12,undef],1,[[1,3,'ab'], [5, 7, 'cd'], [13 ,26,'ef']]], [[8,12,'gh',@sub],0,[[1,3,'ab'], [5, 7, 'cd'],[8,12,'gh'], [13 ,26,'ef']]], [[13,20,'gh',@sub],1,[[1,3,'ab'], [5, 7, 'cd'],[8,20,'gh'], [21 ,26,'c:ef']]], [[6,7,'gh',@sub],1,[[1,3,'ab'], [5, 5, 'c:cd'],[6,20,'gh'], [21 ,26,'c:ef']]], ) { my @range = @{$t->[0]} ; is ($r->set_consolidate_range(@range),$t->[1], "set_consolidate_range @range[0,1]") ; is_deeply($r, $t->[2], "result of @range[0,1]") || diag("Got ".Dumper($r)) ; } clobbered_items.t100644001750001750 176112447330407 17055 0ustar00domidomi000000000000Array-IntSpan-2.003/t use warnings FATAL => qw(all); use ExtUtils::testlib; use Test::More tests => 18 ; use Data::Dumper ; use Array::IntSpan; my $trace = shift || 0 ; my @expect= ([1,3,'ab'],[5, 7, 'cd'], [13, 26, 'ef']) ; my $r = Array::IntSpan->new(@expect) ; diag(Dumper $r) if $trace ; ok ( defined($r) , 'Array::IntSpan new() works') ; is_deeply( $r , \@expect, 'new content ok') ; foreach my $t ( [[32,34,'oops'],[]], [[4,4,'oops'],[]], [[24,26,'oops'],[[24,26,'ef']]], [[24,29,'oops'],[[24,26,'ef']]], [[10,16,'oops'],[[13,16,'ef']]], [[20,24,'oops'],[[20,24,'ef']]], [[0,9,'oops'],[[1,3,'ab'],[5,7,'cd']]], [[0,6,'oops'],[[1,3,'ab'],[5,6,'cd']]], ) { my @clobbered = $r->clobbered_items(@{$t->[0]}) ; is(@$r, 3, 'check nb of items in range') || diag(Dumper $r); is_deeply(\@clobbered, $t->[1], "clobbered_items @{$t->[0]}") || diag(Dumper \@clobbered) ; } Array000755001750001750 012447330407 14762 5ustar00domidomi000000000000Array-IntSpan-2.003/libIntSpan.pm100644001750001750 5577112447330407 17073 0ustar00domidomi000000000000Array-IntSpan-2.003/lib/Array# # This file is part of Array-IntSpan # # This software is Copyright (c) 2014 by Dominique Dumont. # # This is free software, licensed under: # # The Artistic License 1.0 # ########################################################################## # # Array::IntSpan - a Module for handling arrays using IntSpan techniques # # Author: Toby Everett, Dominique Dumont # ########################################################################## # Copyright 2003-2004,2010,2014 Dominique Dumont. All rights reserved. # Copyright 2000 Toby Everett. All rights reserved. # # This file is distributed under the Artistic License. See # http://www.ActiveState.com/corporate/artistic_license.htm or # the license that comes with your perl distribution. # # For comments, questions, bugs or general interest, feel free to # contact Dominique Dumont at ddumont@cpan.org # or Toby Everett at teverett@alascom.att.com ########################################################################## use strict; use warnings ; package Array::IntSpan; $Array::IntSpan::VERSION = '2.003'; sub min { my @a = sort {$a <=> $b} @_ ; return $a[0] ; } sub max { my @a = sort {$b <=> $a} @_ ; return $a[0] ; } sub new { my $class = shift; my $self = [@_]; bless $self, $class; $self->_check_structure; return $self; } #internal function sub search { my ($self,$start,$end,$index) = @_ ; # Binary search for the first element that is *entirely* before the # element to be inserted while ($start < $end) { my $mid = int(($start+$end)/2); if ($self->[$mid][1] < $index) { $start = $mid+1; } else { $end = $mid; } } return $start ; } # clear the range. Note the the $self ref is preserved sub clear { my $self = shift; @$self = () ; } sub set_range_as_string { my $self = shift; my $str = shift; $str =~ s/\s//g; foreach my $substr (split /,/, $str) { my @range = $substr =~ /-/ ? split /-/,$substr : ($substr) x 2; $self->set_range(@range, @_); } } sub set { my $self = shift; my $idx = shift; $self->set_range($idx, $idx, @_); } sub set_range { my $self = shift; #Test that we were passed appropriate values @_ == 3 or @_ == 4 or croak("Array::IntSpan::set_range should be called with 3 values and an ". "optional code ref."); $_[0] <= $_[1] or croak("Array::IntSpan::set_range called with bad indices: ". "$_[0] and $_[1]."); not defined $_[3] or ref($_[3]) eq 'CODE' or croak("Array::IntSpan::set_range called without 4th parameter ". "set as a sub ref"); my ($offset,$length,@list) = $self -> get_splice_parms(@_) ; #print "splice $offset,$length,@list\n"; splice @$self, $offset,$length,@list ; return $length ? 1 : 0 ; } # not well tested or documented. May be useless... sub check_clobber { my $self = shift; my @clobbered = $self->clobbered_items(@_) ; map {warn "will clobber @$_ with @_\n" ;} @clobbered ; return @clobbered ; } sub get_element { my ($self,$idx) = @_; my $ref = $self->[$idx] ; return () unless defined $ref ; return @$ref ; } # call-back: # filler (start, end) # copy (start, end, payload ) # set (start, end, payload) sub get_range { my $self = shift; #my($new_elem) = [@_]; my ($start_elem,$end_elem, $filler, $copy, $set) = @_ ; $copy = sub{$_[2];} unless defined $copy ; my $end_range = $#{$self}; my $range_size = @$self ; # nb of elements # Before we binary search, first check if we fall before the range if ($end_range < 0 or $self->[$end_range][1] < $start_elem) { my @arg = ref($filler) ? ([$start_elem,$end_elem,&$filler($start_elem,$end_elem)]) : defined $filler ? ([@_]) : () ; push @$self, @arg if @arg; return ref($self)->new(@arg) ; } # Before we binary search, first check if we fall after the range if ($end_elem < $self->[0][0]) { my @arg = ref($filler) ? ([$start_elem,$end_elem,&$filler($start_elem,$end_elem)]) : defined $filler ? ([@_]) : () ; unshift @$self, @arg if @arg; return ref($self)->new(@arg) ; } my $start = $self->search(0, $range_size, $start_elem) ; my $end = $self->search($start,$range_size, $end_elem) ; my $start_offset = $start_elem - $self->[$start][0] ; my $end_offset = defined $self->[$end] ? $end_elem - $self->[$end][0] : undef ; #print "get_range: start $start, end $end, start_offset $start_offset"; #print ", end_offset $end_offset" if defined $end_offset ; #print "\n"; my @extracted ; my @replaced ; my $length = 0; # handle the start if (defined $filler and $start_offset < 0) { my $e = min ($end_elem, $self->[$start][0]-1) ; my $new = ref($filler) ? &$filler($start_elem, $e) : $filler ; my @a = ($start_elem, $e, $new) ; # don't use \@a, as we don't want @extracted and @replaced to # point to the same memory area. But $new must point to the same # object push @extracted, [ @a ] ; push @replaced, [ @a ] ; } if ($self->[$start][0] <= $end_elem) { my $s = max ($start_elem,$self->[$start][0]) ; my $e = min ($end_elem, $self->[$start][1]) ; my $payload = $self->[$start][2] ; if ($self->[$start][0] < $s) { my $s1 = $self->[$start][0]; my $e1 = $s - 1 ; push @replaced, [$s1, $e1 , &$copy($s1,$e1,$payload) ]; } # must duplicate the start, end variable push @extracted, [$s, $e, $payload]; push @replaced, [$s, $e, $payload]; if ($e < $self->[$start][1]) { my $s3 = $e+1 ; my $e3 = $self->[$start][1] ; push @replaced, [$s3, $e3, &$copy($s3, $e3,$payload) ] ; } &$set($s,$e, $payload) if defined $set ; $length ++ ; } # handle the middle if any if ($start + 1 <= $end -1 ) { #print "adding " ; foreach my $idx ( $start+1 .. $end - 1) { #print "idx $idx," ; if (defined $filler) { my $start_fill = $self->[$idx-1][1]+1 ; my $end_fill = $self->[$idx][0]-1 ; if ($start_fill <= $end_fill) { my $new = ref($filler) ? &$filler($start_fill, $end_fill) : $filler ; push @extracted, [$start_fill, $end_fill, $new] ; push @replaced, [$start_fill, $end_fill, $new]; } } push @extracted, [@{$self->[$idx]}]; push @replaced , [@{$self->[$idx]}]; $length++ ; } #print "\n"; } # handle the end if ($end > $start) { if (defined $filler) { # must add end element filler my $start_fill = $self->[$end-1][1]+1 ; my $end_fill = (not defined $end_offset or $end_offset < 0) ? $end_elem : $self->[$end][0]-1 ; if ($start_fill <= $end_fill) { my $new = ref($filler) ? &$filler($start_fill, $end_fill) : $filler ; push @extracted, [$start_fill, $end_fill, $new] ; push @replaced, [$start_fill, $end_fill, $new]; } } if (defined $end_offset and $end_offset >= 0) { my $payload = $self->[$end][2] ; my $s = $self->[$end][0] ; my @a = ($s,$end_elem, $payload) ; push @extracted, [@a]; push @replaced , [@a]; if ($end_elem < $self->[$end][1]) { my $s2 = $end_elem + 1 ; my $e2 = $self->[$end][1] ; push @replaced , [$s2, $e2, &$copy($s2,$e2,$payload)]; } &$set($s,$end_elem, $payload) if defined $set ; $length++ ; } } if (defined $filler) { splice (@$self, $start,$length , @replaced) ; } my $ret = ref($self)->new(@extracted) ; return $ret ; } sub clobbered_items { my $self = shift; my($range_start,$range_stop,$range_value) = @_; my $item = $self->get_range($range_start,$range_stop) ; return grep {$_->[2] ne $range_value} @$item ; } # call-back: # set (start, end, payload) sub consolidate { my ($self,$bottom,$top,$set) = @_; $bottom = 0 if (not defined $bottom or $bottom < 0 ); $top = $#$self if (not defined $top or $top > $#$self) ; #print "consolidate from $top to $bottom\n"; for (my $i= $top; $i>0; $i--) { if ($self->[$i][2] eq $self->[$i-1][2] and $self->[$i][0] == $self->[$i-1][1]+1 ) { #print "consolidate splice ",$i-1,",2\n"; my ($s,$e,$p) = ($self->[$i-1][0], $self->[$i][1], $self->[$i][2]); splice @$self, $i-1, 2, [$s, $e, $p] ; $set->($s,$e,$p) if defined $set ; } } } sub set_consolidate_range { my $self = shift; #Test that we were passed appropriate values @_ == 3 or @_ == 5 or croak("Array::IntSpan::set_range should be called with 3 values ". "and 2 optional code ref."); $_[0] <= $_[1] or croak("Array::IntSpan::set_range called with bad indices: $_[0] and $_[1]."); not defined $_[3] or ref($_[3]) eq 'CODE' or croak("Array::IntSpan::set_range called without 4th parameter set as a sub ref"); my ($offset,$length,@list) = $self -> get_splice_parms(@_[0,1,2,3]) ; #print "splice $offset,$length\n"; splice @$self, $offset,$length,@list ; my $nb = @list ; $self->consolidate($offset - 1 , $offset+ $nb , $_[4]) ; return $length ? 1 : 0 ;#($b , $t ) ; } # get_range_list # scalar context -> return a string # list context => returns list of list sub get_range_list { my ($self, %options) = @_; if (wantarray) { return map { [ @$_[0,1] ] } @$self; } else { return join ', ' , map { my ($a,$b) = @$_; $a == $b ? $a : $a+1==$b ? join(', ',$a,$b) : join('-',$a,$b); } @$self; } } # internal function # call-back: # copy (start, end, payload ) sub get_splice_parms { my $self = shift; my ($start_elem,$end_elem,$value,$copy) = @_ ; my $end_range = $#{$self}; my $range_size = @$self ; # nb of elements #Before we binary search, we'll first check to see if this is an append operation if ( $end_range < 0 or $self->[$end_range][1] < $start_elem ) { return defined $value ? ( $range_size, 0, [$start_elem,$end_elem,$value]) : ($range_size, 0) ; } # Check for prepend operation if ($end_elem < $self->[0][0] ) { return defined $value ? ( 0 , 0, [$start_elem,$end_elem,$value]) : (0,0); } #Binary search for the first element after the last element that is entirely #before the element to be inserted (say that ten times fast) my $start = $self->search(0, $range_size, $start_elem) ; my $end = $self->search($start,$range_size, $end_elem) ; my $start_offset = $start_elem - $self->[$start][0] ; my $end_offset = defined $self->[$end] ? $end_elem - $self->[$end][0] : undef ; #print "get_splice_parms: start $start, end $end, start_offset $start_offset"; #print ", end_offset $end_offset" if defined $end_offset ; #print "\n"; my @modified = () ; #If we are here, we need to test for whether we need to frag the #conflicting element if ($start_offset > 0) { my $item = $self->[$start][2] ; my $s = $self->[$start][0] ; my $e = $start_elem-1 ; my $new = defined($copy) ? $copy->($s,$e,$item) : $item ; push @modified ,[$s, $e, $new ]; } push @modified, [$start_elem,$end_elem,$value] if defined $value ; #Do a fragmentation check if (defined $end_offset and $end_offset >= 0 and $end_elem < $self->[$end][1] ) { my $item = $self->[$end][2] ; my $s = $end_elem+1 ; my $e = $self->[$end][1] ; my $new = defined($copy) ? $copy->($s,$e,$item) : $item ; push @modified , [$s, $e, $new] ; } my $extra = (defined $end_offset and $end_offset >= 0) ? 1 : 0 ; return ($start, $end - $start + $extra , @modified); } sub lookup { my $self = shift; my($key) = @_; my($start, $end) = (0, $#{$self}); return undef unless $end >= 0 ; # completely empty span while ($start < $end) { my $mid = int(($start+$end)/2); if ($self->[$mid][1] < $key) { $start = $mid+1; } else { $end = $mid; } } if ($self->[$start]->[0] <= $key && $self->[$start]->[1] >= $key) { return $self->[$start]->[2]; } return undef; } sub _check_structure { my $self = shift; return unless $#$self >= 0; foreach my $i (0..$#$self) { @{$self->[$i]} == 3 or croak("Array::IntSpan::_check_structure failed - element $i lacks 3 entries."); $self->[$i][0] <= $self->[$i][1] or croak("Array::IntSpan::_check_structure failed - element $i has bad indices."); if ($i > 0) { $self->[$i-1][1] < $self->[$i][0] or croak("Array::IntSpan::_check_structure failed - element $i (", ,$self->[$i][0],",",$self->[$i][1], ") doesn't come after previous element (", $self->[$i-1][0],",",$self->[$i-1][1],")"); } } } #The following code is courtesy of Mark Jacob-Dominus, sub croak { require Carp; no warnings 'redefine' ; *croak = \&Carp::croak; goto &croak; } 1; __END__ =head1 NAME Array::IntSpan - Handles arrays of scalars or objects using integer ranges =head1 SYNOPSIS use Array::IntSpan; my $foo = Array::IntSpan->new([0, 59, 'F'], [60, 69, 'D'], [80, 89, 'B']); print "A score of 84% results in a ".$foo->lookup(84).".\n"; unless (defined($foo->lookup(70))) { print "The grade for the score 70% is currently undefined.\n"; } $foo->set_range(70, 79, 'C'); print "A score of 75% now results in a ".$foo->lookup(75).".\n"; $foo->set_range(0, 59, undef); unless (defined($foo->lookup(40))) { print "The grade for the score 40% is now undefined.\n"; } $foo->set_range(87, 89, 'B+'); $foo->set_range(85, 100, 'A'); $foo->set_range(100, 1_000_000, 'A+'); =head1 DESCRIPTION C brings the speed advantages of C (written by Steven McDougall) to arrays. Uses include manipulating grades, routing tables, or any other situation where you have mutually exclusive ranges of integers that map to given values. The new version of C is also able to consolidate the ranges by comparing the adjacent values of the range. If 2 adjacent values are identical, the 2 adjacent ranges are merged. =head1 Ranges of objects C can also handle objects instead of scalar values. But for the consolidation to work, the payload class must overload the C<"">, C and C<==> operators to perform the consolidation comparisons. When a get_range method is called to a range of objects, it will return a new range of object referencess. These object references points to the objects stored in the original range. In other words the objects contained in the returned range are B copied. Thus if the user calls a methods on the objects contained in the returned range, the method is actually invoked on the objects stored in the original range. When a get_range method is called on a range of objects, several things may happen: =over =item * The get_range spans empty slots. By default the returned range will skip the empty slots. But the user may provide a callback to create new objects (for instance). See details below. =item * The get_range splits existing ranges. By default, the split range will contains the same object reference. The user may provide callback to perform the object copy so that the split range will contains different objects. See details below. =back =head1 Ranges specified with integer fields =over =item * C is also provided with the distribution. It lets you use IP addresses in any of three forms (dotted decimal, network string, and integer) for the indices into the array. See the POD for that module for more information. See L for details. =item * C is also provided with the distribution. It let you specify an arbitrary specification to handle ranges with strings made of several integer separared by dots (like IP addresses of ANSI SS7 point codes). See L for details. =back =head1 METHODS =head2 new (...) The C method takes an optional list of array elements. The elements should be in the form C<[start_index, end_index, value]>. They should be in sorted order and there should be no overlaps. The internal method C<_check_structure> will be called to verify the data is correct. If you wish to avoid the performance penalties of checking the structure, you can use C to dump an object and use that code to reconstitute it. =head2 clear Clear the range. =head2 set_range (start, end, value [, code ref] ) This method takes three parameters - the C, the C, and the C. If you wish to erase a range, specify C for the C. It properly deals with overlapping ranges and will replace existing data as appropriate. If the new range lies after the last existing range, the method will execute in O(1) time. If the new range lies within the existing ranges, the method executes in O(n) time, where n is the number of ranges. It does not consolidate contiguous ranges that have the same C. If you have a large number of inserts to do, it would be beneficial to sort them first. Sorting is O(n lg(n)), and since appending is O(1), that will be considerably faster than the O(n^2) time for inserting n unsorted elements. The method returns C<0> if there were no overlapping ranges and C<1> if there were. The optional code ref is called back when an existing range is split. For instance if the original range is C<[0,10,$foo_obj]> and set_range is called with C<[5,7,$bar_obj']>, the callback will be called twice: $callback->(0, 4,$foo_obj) $callback->(8,10,$foo_obj) It will be the callback responsability to make sure that the range C<0-4> and C<7-10> holds 2 I objects. =head2 set( index, value [, code ref] ) Set a single value. This may split an existing range. Actually calls: set_range( index, index, value [, code ref] ) =head2 set_range_as_string ( index, string [, code ref] ) Set one one several ranges specifed with a string. Ranges are separated by "-". Several ranges can be specified with commas. Example: set_range_as_string( '1-10,13, 14-20', 'foo') White space are ignored. =head2 get_range (start, end [, filler | undef , copy_cb [, set_cb]]) This method returns a range (actually an Array::IntSpan object) from C to C. If C and C span empty slot in the original range, get_range will skip the empty slots. If a C value is provided, get_range will fill the slots with it. original range : [2-4,X],[7-9,Y],[12-14,Z] get_range(3,8) : [3-4,X],[7-8,Y] get_range(2,10,f) : [3-4,X],[5-6,f],[7-8,Y] If the C parameter is a CODE reference, the filler value will be the one returned by the sub ref. The sub ref is invoked with C<(start,end)>, i.e. the range of the empty span to fill (C in the example above). When handling object, the sub ref can invoke an object constructor. If C or C split an original range in 2, the default behavior is to copy the value or object ref contained in the original range: original range : [1-4,X] split range : [1-1,X],[2-2,X],[3-4,X] get_range(2) : [2-2,X] If the original range contains object, this may lead to disapointing results. In the example below the 2 ranges contains references (C) that points to the same object: original range : [1-4,obj_a] split range : [1-1,obj_a],[2-2,obj_a],[3-4,obj_a] get_range(2) : [2-2,obj_a] Which means that invoking a method on the object returned by C will also be invoked on the range 1-4 of the original range which may not be what you want. If C is invoked with a copy parameter (actually a code reference), the result of this routine will be stored in the split range I of the get_range: original range : [1-4,X] get_range(2) : [2-2,X] split range : [1-1,copy_of_X],[2-2,X],[3-4,copy_of_X] When dealing with object, the sub ref should provide a copy of the object: original range : [1-4,obj_a] get_range(2) : [2-2,obj_a] split range : [1-1,obj_a1],[2-2,obj_a],[3-4,obj_a2] Note that the C contained in the C and the C contained in the returned range point to the I. The sub ref is invoked with C<(start,end,obj_a)> and is expected to return a copy of C that will be stored in the split ranges. In the example above, 2 different copies are made: C and C. Last, a 3rd callback may be defined by the user: the C. This callback will be used when the range start or end that holds an object changes. In the example above, the C will be called this way: $obj_a->&$set_cb(2,2) ; As a matter of fact, the 3 callback can be used in the same call. In the example below, C is invoked with 3 subs refs: C<\&f,\&cp,\&set>: original range : [1-4,obj_a],[7-9,obj_b] get_range(3-8,...) : [3-4,obj_a],[5-6,obj_fill],[7-8,obj_b] split range : [1-2,obj_a1], [3-4,obj_a],[5-6,obj_fill], [7-8,obj_b],[9-9,obj_b1] To obtain this, get_range will perform the following calls: $obj_fill = &f ; $obj_a1 = &cp(5,6,obj_a); &set(3,4,$obj_a) ; $obj_b = &cp(9,9,obj_b) ; &set(7-8,obj_b) ; =head2 get_range_list In scalar context, returns a list of range in a string like: "C<1-5,7,9-11>". In list context retunrs a list of list, E.g. C< ( [1,5], [7,7], 9,11])>. =head2 lookup( index ) This method takes as a single parameter the C to look up. If there is an appropriate range, the method will return the associated value. Otherwise, it returns C. =head2 get_element( element_number ) Returns an array containing the Nth range element: ( start, end, value ) =head2 consolidate( [ bottom, top , [ set_cb ]] ) This function scan the range from the range index C to C and compare the values held by the adjacent ranges. If the values are identical, the adjacent ranges are merged. The comparision is made with the C<==> operator. Objects stored in the range B overload the C<==> operator. If not, the comparison will be made with the standard stringification of an object and the merge will never happen. If provided, the C will be invoked on the contained object after 2 ranges are merged. For instance, if the C<"$obj_a" eq "$obj_b">: original range : [1-4,obj_a],[5-9,obj_b] consolidate(0,1,\&set) : [1-9,obj_a] And consolidate will perform this call: &$set(1,9,obj_a) ; Consolidate the whole range when called without parameters. =head1 AUTHOR =over =item * Toby Everett, teverett@alascom.att.com =item * Dominique Dumont, ddumont@cpan.org =back Copyright (c) 2000 Toby Everett. Copyright (c) 2003-2004,2014 Dominique Dumont. All rights reserved. This program is free software. This module is distributed under the Artistic License. See http://www.ActiveState.com/corporate/artistic_license.htm or the license that comes with your perl distribution. =cut get_splice_parms.t100644001750001750 414612447330407 17253 0ustar00domidomi000000000000Array-IntSpan-2.003/t use warnings FATAL => qw(all); use ExtUtils::testlib; use Test::More tests => 30 ; use Data::Dumper ; use Array::IntSpan; my $trace = shift || 0 ; my @expect= ([1,3,'ab'],[6,9,'cd']) ; my $r = Array::IntSpan->new(@expect) ; diag(Dumper $r) if $trace ; ok ( defined($r) , 'Array::IntSpan new() works') ; is_deeply( $r , \@expect, 'new content ok') ; my $spawn = sub { 'sp:'.$_[2] ;} ; foreach my $a ( [[0, 0,'bc'],[0,0,[0, 0,'bc']]], [[0, 1,'bc'],[0,1,[0, 1,'bc'],[2,3,'ab']]], [[0, 3,'bc'],[0,1,[0, 3,'bc']]], [[0, 4,'bc'],[0,1,[0, 4,'bc']]], [[0, 5,'bc'],[0,1,[0, 5,'bc']]], [[0, 6,'bc'],[0,2,[0, 6,'bc'],[7,9,'cd']]], [[0, 9,'bc'],[0,2,[0, 9,'bc']]], [[0,10,'bc'],[0,2,[0,10,'bc']]], [[1, 3,'bc'],[0,1,[1, 3,'bc']]], [[1, 2,'bc'],[0,1,[1, 2,'bc'],[3, 3,'ab']]], [[2, 2,'bc'],[0,1,[1, 1,'ab'],[2, 2,'bc'],[3,3,'ab']]], [[2, 3,'bc'],[0,1,[1, 1,'ab'],[2, 3,'bc']]], [[2, 5,'bc'],[0,1,[1, 1,'ab'],[2, 5,'bc']]], [[2, 8,'bc'],[0,2,[1, 1,'ab'],[2, 8,'bc'],[9,9,'cd']]], [[2, 9,'bc'],[0,2,[1, 1,'ab'],[2, 9,'bc']]], [[2,10,'bc'],[0,2,[1, 1,'ab'],[2,10,'bc']]], [[4, 4,'bc'],[1,0,[4, 4,'bc']]], [[5, 6,'bc'],[1,1,[5, 6,'bc'],[7,9,'cd']]], [[5, 9,'bc'],[1,1,[5, 9,'bc']]], [[5,11,'bc'],[1,1,[5,11,'bc']]], [[6, 6,'bc'],[1,1,[6, 6,'bc'],[7,9,'cd']]], [[6, 9,'bc'],[1,1,[6, 9,'bc']]], [[7, 9,'bc'],[1,1,[6, 6,'cd'],[7,9,'bc']]], [[9,11,'bc'],[1,1,[6, 8,'cd'],[9,11,'bc']]], [[10,11,'bc'],[2,0,[10,11,'bc']]], [[10,11,'bc', $spawn],[2,0,[10,11,'bc']]], [[9,11,'bc', $spawn],[1,1,[6, 8,'sp:cd'],[9,11,'bc']]], [[2, 2,'bc', $spawn],[0,1,[1, 1,'sp:ab'],[2, 2,'bc'],[3,3,'sp:ab']]], ) { my @r = $r->get_splice_parms(@{$a->[0]}) ; is_deeply(\@r, $a->[1], "get_splice_parms @{$a->[0]}") || diag(Dumper \@r); } IntSpan000755001750001750 012447330407 16336 5ustar00domidomi000000000000Array-IntSpan-2.003/lib/ArrayIP.pm100644001750001750 1124712447330407 17371 0ustar00domidomi000000000000Array-IntSpan-2.003/lib/Array/IntSpan# # This file is part of Array-IntSpan # # This software is Copyright (c) 2014 by Dominique Dumont. # # This is free software, licensed under: # # The Artistic License 1.0 # ########################################################################## # # Array::IntSpan::IP - a Module for arrays using IP addresses as indices # # Author: Toby Everett # Revision: 1.01 # Last Change: Makefile.PL ########################################################################## # Copyright 2000 Toby Everett. All rights reserved. # # This file is distributed under the Artistic License. See # http://www.ActiveState.com/corporate/artistic_license.htm or # the license that comes with your perl distribution. # # For comments, questions, bugs or general interest, feel free to # contact Toby Everett at teverett@alascom.att.com ########################################################################## use strict; use Array::IntSpan; package Array::IntSpan::IP; use vars qw($VERSION @ISA); $VERSION = '1.01'; @ISA = ('Array::IntSpan'); sub new { my $class = shift; my(@temp) = @_; foreach my $i (@temp) { $i->[0] = &ip_as_int($i->[0]); $i->[1] = &ip_as_int($i->[1]); } return $class->SUPER::new(@temp); } sub set_range { my $self = shift; my(@temp) = @_; $temp[0] = &ip_as_int($temp[0]); $temp[1] = &ip_as_int($temp[1]); return $self->SUPER::set_range(@temp); } sub lookup { my $self = shift; my($key) = @_; return $self->SUPER::lookup(&ip_as_int($key)); } sub ip_as_int { my($value) = @_; if ($value =~ /^(\d{1,3}\.){3}(\d{1,3})$/) { my(@values) = split(/\./, $value); scalar(grep {$_ > 255} @values) and croak("Unable to parse '$value' as an IP address."); return 16777216*$values[0]+65536*$values[1]+256*$values[2]+$values[3]; } elsif (length($value) == 4) { return unpack('N', $value) } elsif ($value =~ /^\d+$/) { return int($value); } else { croak("Unable to parse '$value' as an IP address."); } } #The following code is courtesy of Mark Jacob-Dominus, sub croak { require Carp; *croak = \&Carp::croak; goto &croak; } 1; __END__ =head1 NAME Array::IntSpan::IP - a Module for arrays using IP addresses as indices =head1 SYNOPSIS use Array::IntSpan::IP; my $foo = Array::IntSpan::IP->new(['123.45.67.0', '123.45.67.255', 'Network 1'], ['123.45.68.0', '123.45.68.127', 'Network 2'], ['123.45.68.128', '123.45.68.255', 'Network 3']); print "The address 123.45.68.37 is on network ".$foo->lookup("\173\105\150\45").".\n"; unless (defined($foo->lookup(((123*256+45)*256+65)*256+67))) { print "The address 123.45.65.67 is not on a known network.\n"; } print "The address 123.45.68.177 is on network ".$foo->lookup("123.45.68.177").".\n"; $foo->set_range('123.45.68.128', '123.45.68.255', 'Network 4'); print "The address 123.45.68.177 is now on network ".$foo->lookup("123.45.68.177").".\n"; =head1 DESCRIPTION C brings the advantages of C to IP address indices. Anywhere you use an index in C, you can use an IP address in one of three forms in C. The three accepted forms are: =over 4 =item Dotted decimal This is the standard human-readable format for IP addresses. The conversion checks that the octets are in the range 0-255. Example: C<'123.45.67.89'>. =item Network string A four character string representing the octets in network order. Example: C<"\173\105\150\131">. =item Integer A integer value representing the IP address. Example: C<((123*256+45)*256+67)*256+89> or C<2066563929>. =back Note that the algorithm has no way of distinguishing between the integer values 1000 through 9999 and the network string format. It will presume network string format in these instances. For instance, the integer C<1234> (representing the address C<'0.0.4.210'>) will be interpreted as C<"\61\62\63\64">, or the IP address C<'49.50.51.52'>. This is unavoidable since Perl does not strongly type integers and strings separately and there is no other information available to distinguish between the two in this situation. I do not expect that this will be a problem in most situations. Most users will probably use dotted decimal or network string notations, and even if they do use the integer notation the likelyhood that they will be using the addresses C<'0.0.3.232'> through C<'0.0.39.15'> as indices is relatively low. =head1 METHODS =head2 ip_as_int The class method C takes as its one parameter the IP address in one of the three formats mentioned above and returns the integer notation. =head1 AUTHOR Toby Everett, teverett@alascom.att.com =cut Fields.pm100644001750001750 1563212447330407 20271 0ustar00domidomi000000000000Array-IntSpan-2.003/lib/Array/IntSpan# # This file is part of Array-IntSpan # # This software is Copyright (c) 2014 by Dominique Dumont. # # This is free software, licensed under: # # The Artistic License 1.0 # ########################################################################## # # Array::IntSpan::Fields - IntSpan array using integer fields as indices # # Author: Dominique Dumont ########################################################################## # Copyright 2003 Dominique Dumont. All rights reserved. # # This file is distributed under the Artistic License. See # http://www.ActiveState.com/corporate/artistic_license.htm or # the license that comes with your perl distribution. # # For comments, questions, bugs or general interest, feel free to # contact Dominique Dumont ddumont@cpan.org ########################################################################## # $Author$ # $Date$ # $Name$ # $Revision$ use strict; use warnings; package Array::IntSpan::Fields; our $VERSION = '2.002'; use Array::IntSpan; use Carp ; use overload # this emulate the usage of Intspan '@{}' => sub { return shift->{range} ;} , # fallback on default behavior for all other operators fallback => 1 ; sub new { my $proto = shift ; my $class = ref($proto) || $proto; my $format = shift ; if (ref $format) { # in fact the user want a regular IntSpan return Array::IntSpan->new($format,@_); } my @temp = @_ ; my $self = {}; bless $self, $class; $self->set_format($format) ; foreach my $i (@temp) { $i->[0] = $self->field_to_int($i->[0]); $i->[1] = $self->field_to_int($i->[1]); } $self->{range}= Array::IntSpan->new(@temp) ; return $self; } sub set_format { my ($self,$format) = @_ ; croak "Unexpected format : $format" unless $format =~ /^[\d\.]+$/ ; $self->{format} = $format ; my @array = split /\./, $self->{format} ; # store nb of bit and corresponding bit mask $self->{fields} = [map { [$_, (1<<$_) -1 ]} @array ] ; } sub int_to_field { my $self = shift ; my @all_int = @_ ; my @result ; foreach my $int (@all_int) { my @res ; foreach my $f (reverse @{$self->{fields}}) { unshift @res, ($f->[0] < 32 ? ($int & $f->[1]) : $int ) ; $int >>= $f->[0] ; } push @result, join('.',@res) ; } return wantarray ? @result : $result[0]; } sub field_to_int { my $self = shift ; my @all_field = @_; my @result ; foreach my $field (@all_field) { my $f = $self->{fields}; my @array = split /\./,$field ; croak "Expected ",scalar @$f, " fields for format $self->{format}, got ", scalar @array," in '$field'\n" unless @array == @$f ; my $res = 0 ; my $i =0 ; while ($i <= $#array) { my $shift = $f->[$i][0] ; croak "Field value $array[$i] too great. ", "Max is $f->[$i][1] (bit width is $shift)" if $shift<32 and $array[$i] >> $shift ; $res = ($res << $shift) + $array[$i++] ; } #print "field_to_int: changed $field to $res for format $self->{format}\n"; push @result, $res ; } return wantarray ? @result : $result[0]; } sub get_range { my ($self,$s_field,$e_field) = splice @_,0,3 ; my ($s, $e) = $self->field_to_int($s_field,$e_field) ; my @newcb = $self->adapt_range_in_cb(@_) ; my $got = $self->{range}->get_range($s,$e,@newcb) ; my $ret = bless {range => $got }, ref($self) ; $ret->set_format($self->{format}) ; return $ret ; } sub lookup { my $self = shift; my @keys = $self->field_to_int(@_); $self->{range}->lookup(@keys) ; } sub clear { my $self = shift; @{$self->{range}} = () ; } sub consolidate { my ($self,$s_field,$e_field) = splice @_,0,3 ; my ($s, $e) = $self->field_to_int($s_field,$e_field) if defined $s_field and defined $e_field; my @newcb = $self->adapt_range_in_cb(@_) if @_; return $self->{range}->consolidate($s,$e,@newcb) ; } foreach my $method (qw/set_range set_consolidate_range/) { no strict 'refs' ; *$method = sub { my ($self,$s_field,$e_field,$value) = splice @_,0,4 ; my ($s, $e) = $self->field_to_int($s_field,$e_field) ; my @newcb = $self->adapt_range_in_cb(@_) ; return $self->{range}->$method ($s, $e, $value, @newcb); }; } sub adapt_range_in_cb { my $self = shift; # the callbacks will be called with ($start, $end,$payload) or # ($start,$end) my @callbacks = @_ ; return map { my $old_cb = $_; # required for closure to work defined $old_cb ? sub { my ($s_int,$e_int,$value) = @_ ; my ($s,$e) = $self->int_to_field($s_int,$e_int) ; $old_cb->($s,$e,$value); } : undef ; } @callbacks ; } sub get_element { my ($self,$idx) = @_; my $elt = $self->{range}[$idx] || return () ; my ($s_int,$e_int,$value) = @$elt ; my ($s,$e) = $self->int_to_field($s_int,$e_int) ; return ($s,$e, $value) ; } 1; __END__ =head1 NAME Array::IntSpan::Fields - IntSpan array using integer fields as indices =head1 SYNOPSIS use Array::IntSpan::Fields; my $foo = Array::IntSpan::Fields ->new( '1.2.4', ['0.0.1','0.1.0','ab'], ['1.0.0','1.0.3','cd']); print "Address 0.0.15 has ".$foo->lookup("0.0.15").".\n"; $foo->set_range('1.0.4','1.1.0','ef') ; =head1 DESCRIPTION C brings the advantages of C to indices made of integer fields like an IP address and an ANSI SS7 point code. The number of integer and their maximum value is defined when calling the constructor (or the C method). The example in the synopsis defines an indice with 3 fields where their maximum values are 1,3,15 (or 0x1,0x3,0xf). This module converts the fields into integer before storing them into the L module. =head1 CONSTRUCTOR =head2 new (...) The first parameter defines the size of the integer of the fields, in number of bits. For an IP address, the field definition would be C<8,8,8,8>. =head1 METHODS All methods of L are available. =head2 set_format( field_description ) Set another field description. Beware: no conversion or checking is done. When changing the format, old indices may become illegal. =head2 int_to_field ( integer ) Returns the field representation of the integer. =head2 field_to_int ( field ) Returns the integer value of the field. May craok if the fields values are too great with respect to the filed description. =head1 AUTHOR Dominique Dumont, ddumont@cpan.org Copyright (c) 2003 Dominique Dumont. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut