Import Upstream version 2.004
This commit is contained in:
commit
6cd3c9f4be
|
@ -0,0 +1,94 @@
|
||||||
|
2.004 2020-03-27
|
||||||
|
|
||||||
|
Main change: This module is now distributed under Artistic
|
||||||
|
2.0 license (instead of Artistic 1.0)
|
||||||
|
|
||||||
|
Other changes are
|
||||||
|
* add contributors section
|
||||||
|
* clarify and fix typos in documentation
|
||||||
|
* Added minimum perl version as suggested by CPANTS.
|
||||||
|
(Thanks Mohammad S Anwar)
|
||||||
|
|
||||||
|
2014-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 <ddumont@cpan.org> 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
|
|
@ -0,0 +1,207 @@
|
||||||
|
This software is Copyright (c) 2014 by Dominique Dumont.
|
||||||
|
|
||||||
|
This is free software, licensed under:
|
||||||
|
|
||||||
|
The Artistic License 2.0 (GPL Compatible)
|
||||||
|
|
||||||
|
The Artistic License 2.0
|
||||||
|
|
||||||
|
Copyright (c) 2000-2006, The Perl Foundation.
|
||||||
|
|
||||||
|
Everyone is permitted to copy and distribute verbatim copies
|
||||||
|
of this license document, but changing it is not allowed.
|
||||||
|
|
||||||
|
Preamble
|
||||||
|
|
||||||
|
This license establishes the terms under which a given free software
|
||||||
|
Package may be copied, modified, distributed, and/or redistributed.
|
||||||
|
The intent is that the Copyright Holder maintains some artistic
|
||||||
|
control over the development of that Package while still keeping the
|
||||||
|
Package available as open source and free software.
|
||||||
|
|
||||||
|
You are always permitted to make arrangements wholly outside of this
|
||||||
|
license directly with the Copyright Holder of a given Package. If the
|
||||||
|
terms of this license do not permit the full use that you propose to
|
||||||
|
make of the Package, you should contact the Copyright Holder and seek
|
||||||
|
a different licensing arrangement.
|
||||||
|
|
||||||
|
Definitions
|
||||||
|
|
||||||
|
"Copyright Holder" means the individual(s) or organization(s)
|
||||||
|
named in the copyright notice for the entire Package.
|
||||||
|
|
||||||
|
"Contributor" means any party that has contributed code or other
|
||||||
|
material to the Package, in accordance with the Copyright Holder's
|
||||||
|
procedures.
|
||||||
|
|
||||||
|
"You" and "your" means any person who would like to copy,
|
||||||
|
distribute, or modify the Package.
|
||||||
|
|
||||||
|
"Package" means the collection of files distributed by the
|
||||||
|
Copyright Holder, and derivatives of that collection and/or of
|
||||||
|
those files. A given Package may consist of either the Standard
|
||||||
|
Version, or a Modified Version.
|
||||||
|
|
||||||
|
"Distribute" means providing a copy of the Package or making it
|
||||||
|
accessible to anyone else, or in the case of a company or
|
||||||
|
organization, to others outside of your company or organization.
|
||||||
|
|
||||||
|
"Distributor Fee" means any fee that you charge for Distributing
|
||||||
|
this Package or providing support for this Package to another
|
||||||
|
party. It does not mean licensing fees.
|
||||||
|
|
||||||
|
"Standard Version" refers to the Package if it has not been
|
||||||
|
modified, or has been modified only in ways explicitly requested
|
||||||
|
by the Copyright Holder.
|
||||||
|
|
||||||
|
"Modified Version" means the Package, if it has been changed, and
|
||||||
|
such changes were not explicitly requested by the Copyright
|
||||||
|
Holder.
|
||||||
|
|
||||||
|
"Original License" means this Artistic License as Distributed with
|
||||||
|
the Standard Version of the Package, in its current version or as
|
||||||
|
it may be modified by The Perl Foundation in the future.
|
||||||
|
|
||||||
|
"Source" form means the source code, documentation source, and
|
||||||
|
configuration files for the Package.
|
||||||
|
|
||||||
|
"Compiled" form means the compiled bytecode, object code, binary,
|
||||||
|
or any other form resulting from mechanical transformation or
|
||||||
|
translation of the Source form.
|
||||||
|
|
||||||
|
|
||||||
|
Permission for Use and Modification Without Distribution
|
||||||
|
|
||||||
|
(1) You are permitted to use the Standard Version and create and use
|
||||||
|
Modified Versions for any purpose without restriction, provided that
|
||||||
|
you do not Distribute the Modified Version.
|
||||||
|
|
||||||
|
|
||||||
|
Permissions for Redistribution of the Standard Version
|
||||||
|
|
||||||
|
(2) You may Distribute verbatim copies of the Source form of the
|
||||||
|
Standard Version of this Package in any medium without restriction,
|
||||||
|
either gratis or for a Distributor Fee, provided that you duplicate
|
||||||
|
all of the original copyright notices and associated disclaimers. At
|
||||||
|
your discretion, such verbatim copies may or may not include a
|
||||||
|
Compiled form of the Package.
|
||||||
|
|
||||||
|
(3) You may apply any bug fixes, portability changes, and other
|
||||||
|
modifications made available from the Copyright Holder. The resulting
|
||||||
|
Package will still be considered the Standard Version, and as such
|
||||||
|
will be subject to the Original License.
|
||||||
|
|
||||||
|
|
||||||
|
Distribution of Modified Versions of the Package as Source
|
||||||
|
|
||||||
|
(4) You may Distribute your Modified Version as Source (either gratis
|
||||||
|
or for a Distributor Fee, and with or without a Compiled form of the
|
||||||
|
Modified Version) provided that you clearly document how it differs
|
||||||
|
from the Standard Version, including, but not limited to, documenting
|
||||||
|
any non-standard features, executables, or modules, and provided that
|
||||||
|
you do at least ONE of the following:
|
||||||
|
|
||||||
|
(a) make the Modified Version available to the Copyright Holder
|
||||||
|
of the Standard Version, under the Original License, so that the
|
||||||
|
Copyright Holder may include your modifications in the Standard
|
||||||
|
Version.
|
||||||
|
|
||||||
|
(b) ensure that installation of your Modified Version does not
|
||||||
|
prevent the user installing or running the Standard Version. In
|
||||||
|
addition, the Modified Version must bear a name that is different
|
||||||
|
from the name of the Standard Version.
|
||||||
|
|
||||||
|
(c) allow anyone who receives a copy of the Modified Version to
|
||||||
|
make the Source form of the Modified Version available to others
|
||||||
|
under
|
||||||
|
|
||||||
|
(i) the Original License or
|
||||||
|
|
||||||
|
(ii) a license that permits the licensee to freely copy,
|
||||||
|
modify and redistribute the Modified Version using the same
|
||||||
|
licensing terms that apply to the copy that the licensee
|
||||||
|
received, and requires that the Source form of the Modified
|
||||||
|
Version, and of any works derived from it, be made freely
|
||||||
|
available in that license fees are prohibited but Distributor
|
||||||
|
Fees are allowed.
|
||||||
|
|
||||||
|
|
||||||
|
Distribution of Compiled Forms of the Standard Version
|
||||||
|
or Modified Versions without the Source
|
||||||
|
|
||||||
|
(5) You may Distribute Compiled forms of the Standard Version without
|
||||||
|
the Source, provided that you include complete instructions on how to
|
||||||
|
get the Source of the Standard Version. Such instructions must be
|
||||||
|
valid at the time of your distribution. If these instructions, at any
|
||||||
|
time while you are carrying out such distribution, become invalid, you
|
||||||
|
must provide new instructions on demand or cease further distribution.
|
||||||
|
If you provide valid instructions or cease distribution within thirty
|
||||||
|
days after you become aware that the instructions are invalid, then
|
||||||
|
you do not forfeit any of your rights under this license.
|
||||||
|
|
||||||
|
(6) You may Distribute a Modified Version in Compiled form without
|
||||||
|
the Source, provided that you comply with Section 4 with respect to
|
||||||
|
the Source of the Modified Version.
|
||||||
|
|
||||||
|
|
||||||
|
Aggregating or Linking the Package
|
||||||
|
|
||||||
|
(7) You may aggregate the Package (either the Standard Version or
|
||||||
|
Modified Version) with other packages and Distribute the resulting
|
||||||
|
aggregation provided that you do not charge a licensing fee for the
|
||||||
|
Package. Distributor Fees are permitted, and licensing fees for other
|
||||||
|
components in the aggregation are permitted. The terms of this license
|
||||||
|
apply to the use and Distribution of the Standard or Modified Versions
|
||||||
|
as included in the aggregation.
|
||||||
|
|
||||||
|
(8) You are permitted to link Modified and Standard Versions with
|
||||||
|
other works, to embed the Package in a larger work of your own, or to
|
||||||
|
build stand-alone binary or bytecode versions of applications that
|
||||||
|
include the Package, and Distribute the result without restriction,
|
||||||
|
provided the result does not expose a direct interface to the Package.
|
||||||
|
|
||||||
|
|
||||||
|
Items That are Not Considered Part of a Modified Version
|
||||||
|
|
||||||
|
(9) Works (including, but not limited to, modules and scripts) that
|
||||||
|
merely extend or make use of the Package, do not, by themselves, cause
|
||||||
|
the Package to be a Modified Version. In addition, such works are not
|
||||||
|
considered parts of the Package itself, and are not subject to the
|
||||||
|
terms of this license.
|
||||||
|
|
||||||
|
|
||||||
|
General Provisions
|
||||||
|
|
||||||
|
(10) 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.
|
||||||
|
|
||||||
|
(11) 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.
|
||||||
|
|
||||||
|
(12) This license does not grant you the right to use any trademark,
|
||||||
|
service mark, tradename, or logo of the Copyright Holder.
|
||||||
|
|
||||||
|
(13) 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.
|
||||||
|
|
||||||
|
(14) 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.
|
|
@ -0,0 +1,20 @@
|
||||||
|
# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.014.
|
||||||
|
Changes
|
||||||
|
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
|
|
@ -0,0 +1,67 @@
|
||||||
|
{
|
||||||
|
"abstract" : "Handles arrays of scalars or objects using integer ranges",
|
||||||
|
"author" : [
|
||||||
|
"Dominique Dumont"
|
||||||
|
],
|
||||||
|
"dynamic_config" : 0,
|
||||||
|
"generated_by" : "Dist::Zilla version 6.014, CPAN::Meta::Converter version 2.150010",
|
||||||
|
"license" : [
|
||||||
|
"artistic_2"
|
||||||
|
],
|
||||||
|
"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",
|
||||||
|
"perl" : "5.008"
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"test" : {
|
||||||
|
"requires" : {
|
||||||
|
"Data::Dumper" : "0",
|
||||||
|
"Test::More" : "0"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"provides" : {
|
||||||
|
"Array::IntSpan" : {
|
||||||
|
"file" : "lib/Array/IntSpan.pm",
|
||||||
|
"version" : "2.004"
|
||||||
|
},
|
||||||
|
"Array::IntSpan::Fields" : {
|
||||||
|
"file" : "lib/Array/IntSpan/Fields.pm",
|
||||||
|
"version" : "2.004"
|
||||||
|
},
|
||||||
|
"Array::IntSpan::IP" : {
|
||||||
|
"file" : "lib/Array/IntSpan/IP.pm",
|
||||||
|
"version" : "2.004"
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"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.004",
|
||||||
|
"x_generated_by_perl" : "v5.30.0",
|
||||||
|
"x_serialization_backend" : "Cpanel::JSON::XS version 4.19",
|
||||||
|
"x_spdx_expression" : "Artistic-2.0"
|
||||||
|
}
|
||||||
|
|
|
@ -0,0 +1,37 @@
|
||||||
|
---
|
||||||
|
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 6.014, CPAN::Meta::Converter version 2.150010'
|
||||||
|
license: artistic_2
|
||||||
|
meta-spec:
|
||||||
|
url: http://module-build.sourceforge.net/META-spec-v1.4.html
|
||||||
|
version: '1.4'
|
||||||
|
name: Array-IntSpan
|
||||||
|
provides:
|
||||||
|
Array::IntSpan:
|
||||||
|
file: lib/Array/IntSpan.pm
|
||||||
|
version: '2.004'
|
||||||
|
Array::IntSpan::Fields:
|
||||||
|
file: lib/Array/IntSpan/Fields.pm
|
||||||
|
version: '2.004'
|
||||||
|
Array::IntSpan::IP:
|
||||||
|
file: lib/Array/IntSpan/IP.pm
|
||||||
|
version: '2.004'
|
||||||
|
requires:
|
||||||
|
Carp: '0'
|
||||||
|
perl: '5.008'
|
||||||
|
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.004'
|
||||||
|
x_generated_by_perl: v5.30.0
|
||||||
|
x_serialization_backend: 'YAML::Tiny version 1.73'
|
||||||
|
x_spdx_expression: Artistic-2.0
|
|
@ -0,0 +1,58 @@
|
||||||
|
#
|
||||||
|
# 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 2.0 (GPL Compatible)
|
||||||
|
#
|
||||||
|
# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.014.
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
use 5.008;
|
||||||
|
|
||||||
|
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",
|
||||||
|
"LICENSE" => "artistic_2",
|
||||||
|
"MIN_PERL_VERSION" => "5.008",
|
||||||
|
"NAME" => "Array::IntSpan",
|
||||||
|
"PREREQ_PM" => {
|
||||||
|
"Carp" => 0
|
||||||
|
},
|
||||||
|
"TEST_REQUIRES" => {
|
||||||
|
"Data::Dumper" => 0,
|
||||||
|
"Test::More" => 0
|
||||||
|
},
|
||||||
|
"VERSION" => "2.004",
|
||||||
|
"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);
|
|
@ -0,0 +1,63 @@
|
||||||
|
|
||||||
|
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 <dist_file>.tar.gz | tar xvf -
|
||||||
|
cd <dist_directory>
|
||||||
|
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
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,47 @@
|
||||||
|
name = Array-IntSpan
|
||||||
|
author = Dominique Dumont
|
||||||
|
license = Artistic_2_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
|
||||||
|
|
||||||
|
[MetaProvides::Package]
|
||||||
|
|
||||||
|
[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]
|
||||||
|
[MinimumPerlFast]
|
|
@ -0,0 +1,805 @@
|
||||||
|
#
|
||||||
|
# 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 2.0 (GPL Compatible)
|
||||||
|
#
|
||||||
|
##########################################################################
|
||||||
|
#
|
||||||
|
# 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 2.0 License. See
|
||||||
|
# https://www.perlfoundation.org/artistic-license-20.html
|
||||||
|
#
|
||||||
|
# For comments, questions, bugs or general interest, feel free to
|
||||||
|
# contact Dominique Dumont at ddumont@cpan.org
|
||||||
|
##########################################################################
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings ;
|
||||||
|
|
||||||
|
package Array::IntSpan;
|
||||||
|
$Array::IntSpan::VERSION = '2.004';
|
||||||
|
|
||||||
|
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<Array::IntSpan> brings the speed advantages of C<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.
|
||||||
|
|
||||||
|
The new version of C<Array::IntSpan> 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<Array::IntSpan> can also handle objects instead of scalar values.
|
||||||
|
|
||||||
|
But for the consolidation to work, the payload class must overload the
|
||||||
|
C<"">, C<eq> 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<not> 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<Array::IntSpan::IP> 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<Array::IntSpan::IP> for
|
||||||
|
details.
|
||||||
|
|
||||||
|
=item *
|
||||||
|
|
||||||
|
C<Array::IntSpan::Fields> 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<Array::IntSpan::Fields> for details.
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
|
||||||
|
=head1 METHODS
|
||||||
|
|
||||||
|
=head2 new (...)
|
||||||
|
|
||||||
|
The C<new> 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<Data::Dumper> 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<start_index>, the
|
||||||
|
C<end_index>, and the C<value>. If you wish to erase a range, specify
|
||||||
|
C<undef> for the C<value>. 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<value>.
|
||||||
|
|
||||||
|
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<different> 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 specified 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<start> to C<end>.
|
||||||
|
|
||||||
|
If C<start> and C<end> span empty slot in the original range,
|
||||||
|
get_range will skip the empty slots. If a C<filler> 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<filler> 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<get_range(5,6)> in the example above). When handling object, the
|
||||||
|
sub ref can invoke an object constructor.
|
||||||
|
|
||||||
|
If C<start> or C<end> 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<obj_a>) 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<get_range(2)> will also be invoked on the range 1-4 of the original
|
||||||
|
range which may not be what you want.
|
||||||
|
|
||||||
|
If C<get_range> is invoked with a copy parameter (actually a code
|
||||||
|
reference), the result of this routine will be stored in the split
|
||||||
|
range I<outside> 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<obj_a> contained in the C<split range> and the
|
||||||
|
C<obj_a> contained in the returned range point to the I<same object>.
|
||||||
|
|
||||||
|
The sub ref is invoked with C<(start,end,obj_a)> and is expected to
|
||||||
|
return a copy of C<obj_a> that will be stored in the split ranges. In
|
||||||
|
the example above, 2 different copies are made: C<obj_a1> and
|
||||||
|
C<obj_a2>.
|
||||||
|
|
||||||
|
Last, a 3rd callback may be defined by the user: the C<set_cb>. This
|
||||||
|
callback will be used when the range start or end that holds an object
|
||||||
|
changes. In the example above, the C<set_cb> 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<get_range> 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<index> to look up. If
|
||||||
|
there is an appropriate range, the method will return the associated
|
||||||
|
value. Otherwise, it returns C<undef>.
|
||||||
|
|
||||||
|
=head2 get_element( element_number )
|
||||||
|
|
||||||
|
Returns an array containing the Nth range element:
|
||||||
|
|
||||||
|
( start, end, value )
|
||||||
|
|
||||||
|
=head2 consolidate( [ bottom, top , [ set_cb ]] )
|
||||||
|
|
||||||
|
This function scans the range from the range index C<bottom> to C<top>
|
||||||
|
and compare the values held by the adjacent ranges. If the values are
|
||||||
|
identical, the adjacent ranges are merged.
|
||||||
|
|
||||||
|
The comparison is made with the C<==> operator. Objects stored in the
|
||||||
|
range B<must> overload the C<==> operator. If not, the comparison is
|
||||||
|
made with the standard stringification of an object and the merge
|
||||||
|
never happens.
|
||||||
|
|
||||||
|
If provided, the C<set_cb> is invoked on the contained object
|
||||||
|
after 2 ranges are merged.
|
||||||
|
|
||||||
|
For instance, if C<"$obj_a" eq "$obj_b">:
|
||||||
|
|
||||||
|
original range is : [1-4,obj_a],[5-9,obj_b]
|
||||||
|
consolidate(0,1,\&set) yields: [1-9,obj_a]
|
||||||
|
|
||||||
|
And C<consolidate> performs this call:
|
||||||
|
|
||||||
|
$set->(1,9,obj_a) ;
|
||||||
|
|
||||||
|
Consolidate the whole range when called without parameters.
|
||||||
|
|
||||||
|
=head1 CONTRIBUTORS
|
||||||
|
|
||||||
|
=over
|
||||||
|
|
||||||
|
=item *
|
||||||
|
|
||||||
|
Mohammad S Anwar <mohammad.anwar@yahoo.com>
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
=head1 AUTHORS
|
||||||
|
|
||||||
|
=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,2020 Dominique Dumont.
|
||||||
|
All rights reserved. This program is free software.
|
||||||
|
|
||||||
|
This module is distributed under the Artistic 2.0 License. See
|
||||||
|
https://www.perlfoundation.org/artistic-license-20.html
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
|
@ -0,0 +1,288 @@
|
||||||
|
#
|
||||||
|
# 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 2.0 (GPL Compatible)
|
||||||
|
#
|
||||||
|
##########################################################################
|
||||||
|
#
|
||||||
|
# Array::IntSpan::Fields - IntSpan array using integer fields as indices
|
||||||
|
#
|
||||||
|
# Author: Dominique Dumont
|
||||||
|
##########################################################################
|
||||||
|
# Copyright 2003 Dominique Dumont. All rights reserved.
|
||||||
|
#
|
||||||
|
# This module is distributed under the Artistic 2.0 License. See
|
||||||
|
# https://www.perlfoundation.org/artistic-license-20.html
|
||||||
|
#
|
||||||
|
# For comments, questions, bugs or general interest, feel free to
|
||||||
|
# contact Dominique Dumont ddumont@cpan.org
|
||||||
|
##########################################################################
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
package Array::IntSpan::Fields;
|
||||||
|
$Array::IntSpan::Fields::VERSION = '2.004';
|
||||||
|
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<Array::IntSpan::Fields> brings the advantages of C<Array::IntSpan>
|
||||||
|
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<set_format> 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<Array::IntSpan> 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<Array::IntSpan> 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 module is distributed under the Artistic 2.0 License. See
|
||||||
|
https://www.perlfoundation.org/artistic-license-20.html
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
|
@ -0,0 +1,172 @@
|
||||||
|
#
|
||||||
|
# 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 2.0 (GPL Compatible)
|
||||||
|
#
|
||||||
|
##########################################################################
|
||||||
|
#
|
||||||
|
# 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 module is distributed under the Artistic 2.0 License. See
|
||||||
|
# https://www.perlfoundation.org/artistic-license-20.html
|
||||||
|
#
|
||||||
|
# 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;
|
||||||
|
$Array::IntSpan::IP::VERSION = '2.004';
|
||||||
|
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<Array::IntSpan::IP> brings the advantages of C<Array::IntSpan> to IP
|
||||||
|
address indices. Anywhere you use an index in C<Array::IntSpan>, you
|
||||||
|
can use an IP address in one of three forms in C<Array::IntSpan::IP>.
|
||||||
|
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<Array::IntSpan::IP::ip_as_int> 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
|
||||||
|
|
|
@ -0,0 +1,35 @@
|
||||||
|
|
||||||
|
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) ;
|
||||||
|
}
|
||||||
|
|
|
@ -0,0 +1,49 @@
|
||||||
|
|
||||||
|
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)) ;
|
||||||
|
}
|
||||||
|
|
|
@ -0,0 +1,23 @@
|
||||||
|
# -*- 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');
|
|
@ -0,0 +1,67 @@
|
||||||
|
use 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') ;
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,157 @@
|
||||||
|
# -*- 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 ;
|
|
@ -0,0 +1,55 @@
|
||||||
|
|
||||||
|
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);
|
||||||
|
}
|
||||||
|
|
|
@ -0,0 +1,23 @@
|
||||||
|
|
||||||
|
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] )");
|
||||||
|
}
|
||||||
|
|
|
@ -0,0 +1,46 @@
|
||||||
|
# -*- 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);
|
Loading…
Reference in New Issue