This is an automated email from the git hooks/post-receive script.
nickm-guest pushed a commit to branch master
in repository libdata-walk-perl.
commit 5f3a731381b1ee7d43f2ce77085c18e658eceb48
Author: Nick Morrott <knowledgejun...@gmail.com>
Date: Tue Aug 2 02:15:52 2016 +0100
Imported Upstream version 2.01
---
Build.PL | 17 +-
ChangeLog | 78 ++++----
Credits | 1 +
MANIFEST | 25 ++-
META.json | 41 ++++
META.yml | 32 +--
Makefile.PL | 33 +---
NEWS | 12 ++
README | 8 +-
ReleaseNotes | 12 ++
THANKS | 1 +
lib/Data/Walk.pm | 239 +++++++++++------------
t/00basic.t | 140 +++++++++++++
t/{TS_Basic.pm => 01by_depth.t} | 69 ++++---
t/01follow.t | 77 ++++++++
t/{TS_Options.pm => 01index.t} | 60 +++---
t/{TS_Basic.pm => 01post_process.t} | 55 +++---
t/01pre_process.t | 112 +++++++++++
t/{TS_Basic.pm => 03bugs-1.t} | 66 ++++---
t/{TS_All.pm => 04bug-container-type-by-depth.t} | 49 ++---
t/TC_Basic.pm | 214 --------------------
t/TC_Bugs.pm | 80 --------
t/TC_ByDepth.pm | 89 ---------
t/TC_Copy.pm | 88 ---------
t/TC_Examples.pm | 112 -----------
t/TC_Follow.pm | 117 -----------
t/TC_PostProcess.pm | 67 -------
t/TC_PreProcess.pm | 147 --------------
t/testrunner.t | 53 -----
29 files changed, 743 insertions(+), 1351 deletions(-)
diff --git a/Build.PL b/Build.PL
index 85a189b..3909b24 100644
--- a/Build.PL
+++ b/Build.PL
@@ -1,9 +1,7 @@
#! /usr/local/bin/perl -w
-# $Id: Build.PL,v 1.3 2006/05/11 13:56:28 guido Exp $
-
# Experimental build builder script for Data-Walk.
-# Copyright (C) 2005-2006 Guido Flohr <gu...@imperia.net>,
+# Copyright (C) 2005-2016 Guido Flohr <guido.fl...@cantanea.com>,
# all rights reserved.
# This program is free software; you can redistribute it and/or modify it
@@ -34,16 +32,3 @@ my $build = Module::Build->new
);
$build->create_build_script;
-
-#Local Variables:
-#mode: perl
-#perl-indent-level: 4
-#perl-continued-statement-offset: 4
-#perl-continued-brace-offset: 0
-#perl-brace-offset: -4
-#perl-brace-imaginary-offset: 0
-#perl-label-offset: -4
-#cperl-indent-level: 4
-#cperl-continued-statement-offset: 2
-#tab-width: 8
-#End:
diff --git a/ChangeLog b/ChangeLog
index b0b8f33..1dd4abb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,20 +1,20 @@
-2006-05-11 17:11 Guido Flohr <gu...@imperia.net>
+2006-05-11 17:11 Guido Flohr <guido.fl...@cantanea.com>
* x-changelog.sh: search cvs2cl in $PATH
-2006-05-11 17:10 Guido Flohr <gu...@imperia.net>
+2006-05-11 17:10 Guido Flohr <guido.fl...@cantanea.com>
* lib/Data/Walk.pm: bumped version number to 1.00
-2006-05-11 17:10 Guido Flohr <gu...@imperia.net>
+2006-05-11 17:10 Guido Flohr <guido.fl...@cantanea.com>
* NEWS, ReleaseNotes, ChangeLog: updated
-2006-05-11 17:10 Guido Flohr <gu...@imperia.net>
+2006-05-11 17:10 Guido Flohr <guido.fl...@cantanea.com>
* MANIFEST: fixed typo
-2006-05-11 16:56 Guido Flohr <gu...@imperia.net>
+2006-05-11 16:56 Guido Flohr <guido.fl...@cantanea.com>
* Build.PL, Makefile.PL, lib/Data/Walk.pm, t/TC_Basic.pm,
t/TC_Bugs.pm, t/TC_ByDepth.pm, t/TC_Copy.pm, t/TC_Follow.pm,
@@ -22,43 +22,43 @@
t/TS_Basic.pm, t/TS_Options.pm, t/testrunner.t: changed copyright
year
-2006-05-11 16:50 Guido Flohr <gu...@imperia.net>
+2006-05-11 16:50 Guido Flohr <guido.fl...@cantanea.com>
* t/: TC_Basic.pm, TC_ByDepth.pm: test for new variable
$Data::Walk::depth
-2006-05-11 16:50 Guido Flohr <gu...@imperia.net>
+2006-05-11 16:50 Guido Flohr <guido.fl...@cantanea.com>
* lib/Data/Walk.pm: added example code to pod
-2006-05-11 16:49 Guido Flohr <gu...@imperia.net>
+2006-05-11 16:49 Guido Flohr <guido.fl...@cantanea.com>
* MANIFEST, t/TC_Examples.pm, t/TS_All.pm: tests for example code
added
-2006-05-11 12:42 Guido Flohr <gu...@imperia.net>
+2006-05-11 12:42 Guido Flohr <guido.fl...@cantanea.com>
* lib/Data/Walk.pm: Use UNIVERSAL::isa for determining the base
data type of references.
-2005-12-06 18:42 Guido Flohr <gu...@imperia.net>
+2005-12-06 18:42 Guido Flohr <guido.fl...@cantanea.com>
* ChangeLog: re-generated
-2005-12-06 18:42 Guido Flohr <gu...@imperia.net>
+2005-12-06 18:42 Guido Flohr <guido.fl...@cantanea.com>
* NEWS, ReleaseNotes, lib/Data/Walk.pm: bumped version number to
0.02
-2005-12-06 18:41 Guido Flohr <gu...@imperia.net>
+2005-12-06 18:41 Guido Flohr <guido.fl...@cantanea.com>
* README: concise README
-2005-12-06 18:41 Guido Flohr <gu...@imperia.net>
+2005-12-06 18:41 Guido Flohr <guido.fl...@cantanea.com>
* Makefile.PL: README is no longer generated
-2005-11-15 13:19 Guido Flohr <gu...@imperia.net>
+2005-11-15 13:19 Guido Flohr <guido.fl...@cantanea.com>
* Build.PL, MANIFEST, MANIFEST.SKIP, META.yml, Makefile.PL, README,
lib/Data/Walk.pm, t/TC_Basic.pm, t/TC_Bugs.pm, t/TC_ByDepth.pm,
@@ -66,114 +66,114 @@
t/TC_PreProcess.pm, t/TS_All.pm, t/TS_Basic.pm, t/TS_Options.pm:
renamed from Data::Traverse to Data::Walk
-2005-11-15 01:58 Guido Flohr <gu...@imperia.net>
+2005-11-15 01:58 Guido Flohr <guido.fl...@cantanea.com>
* ChangeLog: re-generated
-2005-11-15 01:58 Guido Flohr <gu...@imperia.net>
+2005-11-15 01:58 Guido Flohr <guido.fl...@cantanea.com>
* META.yml: author
-2005-11-15 01:56 Guido Flohr <gu...@imperia.net>
+2005-11-15 01:56 Guido Flohr <guido.fl...@cantanea.com>
* MANIFEST, META.yml: added META.yml
-2005-11-15 01:53 Guido Flohr <gu...@imperia.net>
+2005-11-15 01:53 Guido Flohr <guido.fl...@cantanea.com>
* ChangeLog: re-generated
-2005-11-15 01:52 Guido Flohr <gu...@imperia.net>
+2005-11-15 01:52 Guido Flohr <guido.fl...@cantanea.com>
* NEWS, ReleaseNotes: first release
-2005-11-15 01:39 Guido Flohr <gu...@imperia.net>
+2005-11-15 01:39 Guido Flohr <guido.fl...@cantanea.com>
* README: re-generated
-2005-11-15 01:38 Guido Flohr <gu...@imperia.net>
+2005-11-15 01:38 Guido Flohr <guido.fl...@cantanea.com>
* lib/Data/Walk.pm:
- handle blessed structures
- code cleaned up
- pod corrected
-2005-11-15 01:33 Guido Flohr <gu...@imperia.net>
+2005-11-15 01:33 Guido Flohr <guido.fl...@cantanea.com>
* MANIFEST.SKIP: renamed Data-Find to Data-Traverse
-2005-11-15 01:32 Guido Flohr <gu...@imperia.net>
+2005-11-15 01:32 Guido Flohr <guido.fl...@cantanea.com>
* t/TC_Basic.pm: test blessed structures
-2005-11-15 01:31 Guido Flohr <gu...@imperia.net>
+2005-11-15 01:31 Guido Flohr <guido.fl...@cantanea.com>
* MANIFEST: restructured test suites
-2005-11-15 01:29 Guido Flohr <gu...@imperia.net>
+2005-11-15 01:29 Guido Flohr <guido.fl...@cantanea.com>
* Makefile.PL: added license information
-2005-11-15 00:31 Guido Flohr <gu...@imperia.net>
+2005-11-15 00:31 Guido Flohr <guido.fl...@cantanea.com>
* t/: TC_Bugs.pm, TS_All.pm, TS_Basic.pm, TS_Options.pm:
restructured test suite
-2005-11-15 00:18 Guido Flohr <gu...@imperia.net>
+2005-11-15 00:18 Guido Flohr <guido.fl...@cantanea.com>
* lib/Data/Walk.pm, t/TC_Bugs.pm, t/TS_All.pm: do not bless
unblessed references
-2005-11-14 19:23 Guido Flohr <gu...@imperia.net>
+2005-11-14 19:23 Guido Flohr <guido.fl...@cantanea.com>
* README, lib/Data/Walk.pm, t/TC_Copy.pm, t/TS_All.pm: implemented
call-by-reference for preprocessing callbacks
-2005-11-14 18:35 Guido Flohr <gu...@imperia.net>
+2005-11-14 18:35 Guido Flohr <guido.fl...@cantanea.com>
* README, lib/Data/Walk.pm, t/TC_Follow.pm, t/TS_All.pm: handle
cyclic references correctly
-2005-11-11 13:07 Guido Flohr <gu...@imperia.net>
+2005-11-11 13:07 Guido Flohr <guido.fl...@cantanea.com>
* lib/Data/Walk.pm: comment about untainting
-2005-11-11 12:50 Guido Flohr <gu...@imperia.net>
+2005-11-11 12:50 Guido Flohr <guido.fl...@cantanea.com>
* t/TC_PostProcess.pm, lib/Data/Walk.pm, t/TS_All.pm: implemented
postprocessing
-2005-11-11 12:50 Guido Flohr <gu...@imperia.net>
+2005-11-11 12:50 Guido Flohr <guido.fl...@cantanea.com>
* README: fixed typo
-2005-11-10 23:29 Guido Flohr <gu...@imperia.net>
+2005-11-10 23:29 Guido Flohr <guido.fl...@cantanea.com>
* t/TC_PreProcess.pm: avoid warning
-2005-11-10 23:10 Guido Flohr <gu...@imperia.net>
+2005-11-10 23:10 Guido Flohr <guido.fl...@cantanea.com>
* lib/Data/Walk.pm, t/TC_PreProcess.pm, t/TS_All.pm: implemented
preprocessing
-2005-11-10 23:06 Guido Flohr <gu...@imperia.net>
+2005-11-10 23:06 Guido Flohr <guido.fl...@cantanea.com>
* t/TC_ByDepth.pm: removed debugging noise
-2005-11-10 22:06 Guido Flohr <gu...@imperia.net>
+2005-11-10 22:06 Guido Flohr <guido.fl...@cantanea.com>
* Build.PL, ChangeLog, MANIFEST, Makefile.PL, NEWS, README,
ReleaseNotes, USERS, x-changelog.sh: cpanification
-2005-11-10 21:26 Guido Flohr <gu...@imperia.net>
+2005-11-10 21:26 Guido Flohr <guido.fl...@cantanea.com>
* lib/Data/Walk.pm, t/TC_Basic.pm, t/TC_ByDepth.pm, t/TS_All.pm:
traverse and traversedepth basically work
-2005-11-10 21:24 Guido Flohr <gu...@imperia.net>
+2005-11-10 21:24 Guido Flohr <guido.fl...@cantanea.com>
* t/testrunner.t: fixed intentional syntax error
-2005-11-10 13:01 Guido Flohr <gu...@imperia.net>
+2005-11-10 13:01 Guido Flohr <guido.fl...@cantanea.com>
* COPYING.LESSER, MANIFEST, MANIFEST.SKIP, Makefile.PL,
lib/Data/Walk.pm, t/TC_Basic.pm, t/TS_All.pm, t/testrunner.t:
diff --git a/Credits b/Credits
new file mode 100644
index 0000000..903ee65
--- /dev/null
+++ b/Credits
@@ -0,0 +1 @@
+Thanks to Slaven Rezic for a lot of constructive feedback!
diff --git a/MANIFEST b/MANIFEST
index 1aa9238..0fa68e7 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,6 +1,7 @@
Build.PL Experimental build script
ChangeLog CVS log
COPYING.LESSER GNU Library General Public License
+Credits Credits
lib/Data/Walk.pm Walk Perl data structures
Makefile.PL Makefile generator
MANIFEST This file
@@ -8,16 +9,14 @@ META.yml META.yml
NEWS Release notes
README ASCII manpage
ReleaseNotes Release notes
-t/TC_Basic.pm Basic test case
-t/TC_Bugs.pm Test for previous bugs
-t/TC_ByDepth.pm Option 'bydepth'
-t/TC_Copy.pm Option 'copy'
-t/TC_Examples.pm Test cases for example code
-t/TC_Follow.pm Option 'follow'
-t/TC_PostProcess.pm Options 'postprocess' and 'postprocess_hash'
-t/TC_PreProcess.pm Option 'preprocess'
-t/testrunner.t Test::Harness style unit tester
-t/TS_All.pm Test suite
-t/TS_Basic.pm Test basic functionality
-t/TS_Options.pm Test various options
-SIGNATURE Public-key signature (added by
MakeMaker)
+SIGNATURE Public-key signature (added by MakeMaker)
+THANKS Credits
+t/00basic.t Basic test case
+t/01by_depth.t Option 'bydepth'
+t/01follow.t Option 'follow'
+t/01post_process.t Options 'postprocess' and 'postprocess_hash'
+t/01pre_process.t Option 'preprocess'
+t/01index.t Test $Data::Walk::index
+t/03bugs-1.t Test for old bugs
+t/04bug-container-type-by-depth.t Test that type and container are always set
+META.json Module JSON meta-data (added by
MakeMaker)
diff --git a/META.json b/META.json
new file mode 100644
index 0000000..d0a5abf
--- /dev/null
+++ b/META.json
@@ -0,0 +1,41 @@
+{
+ "abstract" : "Traverse Perl data structures.",
+ "author" : [
+ "Guido Flohr <guido.fl...@cantanea.com>"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter
version 2.150001",
+ "license" : [
+ "open_source"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec";,
+ "version" : "2"
+ },
+ "name" : "Data-Walk",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "Scalar::Util" : "1.38"
+ }
+ }
+ },
+ "release_status" : "stable",
+ "version" : "2.01"
+}
diff --git a/META.yml b/META.yml
index 9450de9..73d3ba9 100644
--- a/META.yml
+++ b/META.yml
@@ -1,12 +1,22 @@
---- #YAML:1.0
-name: Data-Walk
-version: 1.00
-abstract: Traverse Perl data structures.
-license: lgpl
-generated_by: ExtUtils::MakeMaker version 6.30_01
-author: Guido Flohr <gu...@imperia.net>
-distribution_type: module
-requires:
+---
+abstract: 'Traverse Perl data structures.'
+author:
+ - 'Guido Flohr <guido.fl...@cantanea.com>'
+build_requires:
+ ExtUtils::MakeMaker: '0'
+configure_requires:
+ ExtUtils::MakeMaker: '0'
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter
version 2.150001'
+license: open_source
meta-spec:
- url: <http://module-build.sourceforge.net/META-spec-new.html>;
- version: 1.1
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: '1.4'
+name: Data-Walk
+no_index:
+ directory:
+ - t
+ - inc
+requires:
+ Scalar::Util: '1.38'
+version: '2.01'
diff --git a/Makefile.PL b/Makefile.PL
index b3f456e..62fb92c 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -1,9 +1,7 @@
-#! /usr/local/bin/perl -w # -*- perl -*-
-
-# $Id: Makefile.PL,v 1.6 2006/05/11 13:56:28 guido Exp $
+#! /usr/bin/env perl # -*- perl -*-
# Makefile generator for Data-Find.
-# Copyright (C) 2005-2006 Guido Flohr <gu...@imperia.net>,
+# Copyright (C) 2005-2016 Guido Flohr <guido.fl...@cantanea.com>,
# all rights reserved.
# This program is free software; you can redistribute it and/or modify it
@@ -29,37 +27,26 @@ WriteMakefile (
VERSION_FROM => 'lib/Data/Walk.pm',
($] >= 5.005 ?
(ABSTRACT => 'Traverse Perl data structures.',
- AUTHOR => 'Guido Flohr <gu...@imperia.net>',
+ AUTHOR => 'Guido Flohr <guido.fl...@cantanea.com>',
) : (),
),
- PREREQ_PM => {},
+ PREREQ_PM => {
+ 'Scalar::Util' => 1.38,
+ },
PL_FILES => {},
- (MM->can ('signature_target') ? (SIGN => 1) : ()),
LICENSE => 'lgpl',
);
sub MY::postamble {
q (
-all :: ReleaseNotes
+all :: Credits ReleaseNotes
# Make search.cpan.org happy but still follow GNU standards:
# (Thanks to Graham Barr for the hint)
ReleaseNotes: NEWS
cat NEWS >$@
+
+Credits: THANKS
+ cat THANKS >$@
);
}
-
-__END__
-
-Local Variables:
-mode: perl
-perl-indent-level: 4
-perl-continued-statement-offset: 4
-perl-continued-brace-offset: 0
-perl-brace-offset: -4
-perl-brace-imaginary-offset: 0
-perl-label-offset: -4
-cperl-indent-level: 4
-cperl-continued-statement-offset: 2
-tab-width: 8
-End:
diff --git a/NEWS b/NEWS
index 65cec99..41e097e 100644
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,15 @@
+Version 2.01 - 16 May 2016
+
+* Fixed copyright date.
+* Fixed contact information.
+
+Version 2.00 - 13 Apr 2016
+
+* All bugs from rt.cpan.org fixed.
+* Removed option 'copy' because it was mostly useless.
+* Bumped version number to 2.x because of incompatible changes.
+* New variables $Data::Walk::index and $Data::Walk::key.
+
Version 1.00 - 11 May 2006
* The API is now considered stable.
diff --git a/README b/README
index ec3f359..0802c4e 100644
--- a/README
+++ b/README
@@ -1,5 +1,3 @@
-$Id: README,v 1.7 2005/12/06 16:41:28 guido Exp $
-
Data::Walk is for data, what File::Find is for file systems. You can
use it for traversing arbitrarily complex Perl data structures.
@@ -12,4 +10,8 @@ Data::Dumper also offers some callbacks when traversing the
structures,
but not the ones that I needed. That was motivation enough for writing
Data::Walk.
-Guido Flohr
\ No newline at end of file
+You can checkout the latest version from git:
+
+ git clone git://git.guido-flohr.net/perl/Data-Walk.git
+
+Guido Flohr
diff --git a/ReleaseNotes b/ReleaseNotes
index 65cec99..41e097e 100644
--- a/ReleaseNotes
+++ b/ReleaseNotes
@@ -1,3 +1,15 @@
+Version 2.01 - 16 May 2016
+
+* Fixed copyright date.
+* Fixed contact information.
+
+Version 2.00 - 13 Apr 2016
+
+* All bugs from rt.cpan.org fixed.
+* Removed option 'copy' because it was mostly useless.
+* Bumped version number to 2.x because of incompatible changes.
+* New variables $Data::Walk::index and $Data::Walk::key.
+
Version 1.00 - 11 May 2006
* The API is now considered stable.
diff --git a/THANKS b/THANKS
new file mode 100644
index 0000000..903ee65
--- /dev/null
+++ b/THANKS
@@ -0,0 +1 @@
+Thanks to Slaven Rezic for a lot of constructive feedback!
diff --git a/lib/Data/Walk.pm b/lib/Data/Walk.pm
index ea22221..6b0a4af 100755
--- a/lib/Data/Walk.pm
+++ b/lib/Data/Walk.pm
@@ -1,9 +1,7 @@
#! /bin/false
-# $Id: Walk.pm,v 1.15 2006/05/11 14:10:54 guido Exp $
-
# Traverse Perl data structures.
-# Copyright (C) 2005-2006 Guido Flohr <gu...@imperia.net>,
+# Copyright (C) 2005-2016 Guido Flohr <guido.fl...@cantanea.com>,
# all rights reserved.
# This program is free software; you can redistribute it and/or modify it
@@ -26,15 +24,17 @@ package Data::Walk;
use strict;
use 5.004;
+use Scalar::Util;
+
require Exporter;
use vars qw ($VERSION @ISA @EXPORT);
-$VERSION = '1.00';
+$VERSION = '2.01';
@ISA = qw (Exporter);
@EXPORT = qw (walk walkdepth);
-use vars qw ($container $type $seen $address $depth);
+use vars qw ($container $type $seen $address $depth $index $key);
# Forward declarations.
sub walk;
@@ -45,8 +45,8 @@ sub __recurse;
sub walk {
my ($options, @args) = @_;
- unless ('HASH' eq ref $options) {
- $options = { wanted => $options };
+ unless (UNIVERSAL::isa($options, 'HASH')) {
+ $options = { wanted => $options };
}
__walk ($options, @args);
@@ -55,8 +55,8 @@ sub walk {
sub walkdepth {
my ($options, @args) = @_;
- unless ('HASH' eq ref $options) {
- $options = { wanted => $options };
+ unless (UNIVERSAL::isa($options, 'HASH')) {
+ $options = { wanted => $options };
}
$options->{bydepth} = 1;
@@ -68,12 +68,28 @@ sub __walk {
my ($options, @args) = @_;
$options->{seen} = {};
- $options->{copy} = 1 unless exists $options->{copy};
+ local $index = 0;
foreach my $item (@args) {
- local $depth;
- $depth = 0;
- __recurse $options, $item;
+ local ($container, $type, $depth);
+ if (ref $item) {
+ if (UNIVERSAL::isa ($item, 'HASH')) {
+ $container = $item;
+ $type = 'HASH';
+ } elsif (UNIVERSAL::isa ($item, 'ARRAY')) {
+ $container = $item;
+ $type = 'ARRAY';
+ } else {
+ $container = \@args;
+ $type = 'ARRAY';
+ }
+ } else {
+ $container = \@args;
+ $type = 'ARRAY';
+ }
+ $depth = 0;
+ __recurse $options, $item;
+ ++$index;
}
return 1;
@@ -85,81 +101,88 @@ sub __recurse {
++$depth;
my @children;
- my $data_type;
+ my $data_type = '';
- local ($address, $seen);
- undef $address;
- $seen = 0;
+ local ($container, $type, $address, $seen) = ($container, $type, undef, 0);
my $ref = ref $item;
if ($ref) {
- my $blessed = -1 != index $ref, '=';
-
- # Avoid fancy overloading stuff.
- bless $item if $blessed;
- $address = int $item;
-
- $seen = $options->{seen}->{$address}++;
-
- if (UNIVERSAL::isa ($item, 'HASH')) {
- $data_type = 'HASH';
- } elsif (UNIVERSAL::isa ($item, 'ARRAY')) {
- $data_type = 'ARRAY';
- } else {
- $data_type = '';
- }
-
- if ($data_type eq 'HASH' || $data_type eq 'ARRAY') {
- if (('ARRAY' eq $data_type || 'HASH' eq $data_type)) {
- if ('ARRAY' eq $data_type) {
- @children = @{$item};
- } else {
- @children = %{$item};
- }
-
- if ($options->{copy}) {
- if ('ARRAY' eq $data_type) {
- @children = $options->{preprocess} (@{$item})
- if $options->{preprocess};
- } else {
- @children = %{$item};
- @children = $options->{preprocess} (@children)
- if $options->{preprocess};
- @children = $options->{preprocess_hash} (@children)
- if $options->{preprocess_hash};
- }
- } else {
- $item = $options->{preprocess} ($item)
- if $options->{preprocess};
- $item = $options->{preprocess_hash} ($item)
- if 'HASH' eq $data_type && $options->{preprocess_hash};
- @children = 'HASH' eq $data_type ? %{$item} : @{$item};
- }
- }
- }
+ my $blessed = Scalar::Util::blessed($item);
+
+ # Avoid fancy overloading stuff.
+ bless $item if $blessed;
+ $address = Scalar::Util::refaddr($item);
+
+ $seen = $options->{seen}->{$address}++;
+
+ if (UNIVERSAL::isa ($item, 'HASH')) {
+ $data_type = 'HASH';
+ } elsif (UNIVERSAL::isa ($item, 'ARRAY')) {
+ $data_type = 'ARRAY';
+ } else {
+ $data_type = '';
+ }
+
+ if ('ARRAY' eq $data_type || 'HASH' eq $data_type) {
+ local $index = -1;
+ local $type = $data_type;
+ local $container = $item;
+
+ if ('ARRAY' eq $data_type) {
+ @children = @{$item};
+ } else {
+ @children = %{$item};
+ }
+
+ if ('ARRAY' eq $data_type) {
+ @children = $options->{preprocess} (@{$item})
+ if $options->{preprocess};
+ } else {
+ local $container = \@children;
+ @children = $options->{preprocess} (@children)
+ if $options->{preprocess};
+ @children = $options->{preprocess_hash} (@children)
+ if $options->{preprocess_hash};
+ }
+ } else {
+ $data_type = '';
+ }
+
+ # Recover original object state.
+ bless $item, $ref if $blessed;
}
unless ($options->{bydepth}) {
- $_ = $item;
- $options->{wanted}->($item);
+ local $_ = $item;
+ $options->{wanted}->($item);
}
- local ($container, $type);
- $type = $data_type;
- $container = $item;
-
- if ($options->{follow} || !$seen) {
- foreach my $child (@children) {
- __recurse $options, $child;
- }
+ if (@children && ($options->{follow} || !$seen)) {
+ local ($container, $type, $index);
+ $type = $data_type;
+ $container = $item;
+ $index = 0;
+
+ foreach my $child (@children) {
+ if ($type eq 'HASH' && $index & 1) {
+ $key = $children[$index - 1];
+ } else {
+ undef $key;
+ }
+ __recurse $options, $child;
+ ++$index;
+ }
}
if ($options->{bydepth}) {
- $_ = $item;
- $options->{wanted}->($item);
+ local $_ = $item;
+ $options->{wanted}->($item);
}
- $options->{postprocess}->() if $options->{postprocess};
+ if ($data_type) {
+ local ($container, $type, $index) = ($item, $data_type, -1);
+ $options->{postprocess}->() if $options->{postprocess};
+ }
--$depth;
# void
@@ -254,10 +277,9 @@ preprocessing function is called before the loop that
calls the
C<wanted()> function. It is called with a list of member nodes
and is expected to return such a list. The list will contain
all sub-nodes, regardless of the value of the option I<follow>!
-The list is normally a shallow copy of the data contained in the original
+The list is a shallow copy of the data contained in the original
structure. You can therefore safely delete items in it, without
-affecting the original data. You can use the option I<copy>,
-if you want to change that behavior.
+affecting the original data.
The behavior is identical for regular arrays and hashes, so you
probably want to coerce the list passed as an argument into a hash
@@ -297,29 +319,6 @@ Please note that the &wanted function is also called for
nodes
that have already been visited! The effect of I<follow> is to
suppress descending into subnodes.
-=item B<copy>
-
-Normally, the &preprocess function is called with a shallow copy
-of the data. If you set the option I<copy> to a false value,
-the &preprocess function is called with one single argument,
-a reference to the original data structure. In that case, you
-also have to return a suitable reference.
-
-Using this option will result in a slight performance win, and
-can make it sometimes easier to manipulate the original data.
-
-What is a shallow copy? Think of a list containing references
-to hashes:
-
- my @list = ({ foo => 'bar' }, { foo => 'baz' });
- my @shallow = @list;
-
-After this, @shallow will contain a new list, but the items
-stored in it are exactly identical to the ones stored in the
-original. In other words, @shallow occupies new memory, whereas
-both lists contain references to the same memory for the list
-members.
-
=back
All other options are silently ignored.
@@ -349,7 +348,8 @@ a hash or an array. Think "directory" in terms of
File::Find(3pm)!
=item B<$Data::Walk::type>
The base type of the object that $Data::Walk::container
-references. This is either "ARRAY" or "HASH".
+references. This is either "ARRAY" or "HASH" or the empty string for
+everything else.
=item B<$Data::Walk::seen>
@@ -368,6 +368,18 @@ references, the value is undefined.
The depth of the current recursion.
+=item B<$Data::Walk::index>
+
+Holds the index of the current item in the container. Note that hashes
+and arrays are treated the same. Therefore, if the current container is
+a hash and B<$Data::Walk::index> is even then B<$_> is a hash key. If
+it is odd, then B<$_> is a hash value.
+
+Note that the root container is the array of items to search that you
+passed to the wanted function!
+
+This variable has been added in Data::Walk version 1.01.
+
=back
These variables should not be modified.
@@ -418,25 +430,10 @@ I<follow_skip>, I<no_chdir>, I<untaint>,
I<untaint_pattern>, and
I<untaint_skip>. To give truth the honor, all unrecognized options
are skipped.
-You may argue, that the options I<untaint> and friends would be
-useful, too, allowing you to recursively untaint data structures.
-But, hey, that is what Data::Walk(3pm) is all about. It makes
-it very easy for you to write that yourself.
-
=head1 EXAMPLES
Following are some recipies for common tasks.
-=head2 Recursive Untainting
-
- sub untaint {
- s/(.*)/$1/s unless ref $_;
- };
- walk \&untaint, $data;
-
-See perlsec(1), if you don't understand why the untaint() function
-untaints your data here.
-
=head2 Recurse To Maximum Depth
If you want to stop the recursion at a certain level, do it as follows:
@@ -444,13 +441,13 @@ If you want to stop the recursion at a certain level, do
it as follows:
my $max_depth = 20;
sub not_too_deep {
if ($Data::Walk::depth > $max_depth) {
- return ();
+ return ();
} else {
- return @_;
+ return @_;
}
}
sub do_something1 {
- # Your code goes here.
+ # Your code goes here.
}
walk { wanted => \&do_something, preprocess => \¬_too_deep };
@@ -461,8 +458,8 @@ bug tracking system at
http://rt.cpan.org/NoAuth/Bugs.html?Dist=Data-Walk.
=head1 COPYING
-Copyright (C) 2005-2006, Guido Flohr E<lt>gu...@imperia.nete<gt>, all
-rights reserved.
+Copyright (C) 2005-2016 L<Guido Flohr|http://www.guido-flohr.net/>,
+L<mailto:guido.fl...@cantanea.com>, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
diff --git a/t/00basic.t b/t/00basic.t
new file mode 100755
index 0000000..3029990
--- /dev/null
+++ b/t/00basic.t
@@ -0,0 +1,140 @@
+# Data::Walk - Traverse Perl data structures.
+# Copyright (C) 2005-2016 Guido Flohr <guido.fl...@cantanea.com>,
+# all rights reserved.
+
+# This program is free software; you can redistribute it and/or modify it
+# under the terms of the GNU Library General Public License as published
+# by the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# Library General Public License for more details.
+
+# You should have received a copy of the GNU Library General Public
+# License along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+# USA.
+
+use strict;
+
+use Test;
+use Data::Walk;
+
+BEGIN {
+ plan tests => 52;
+}
+
+my ($data, $item, $count, $wanted, @hashdata);
+
+$data = "foobar";
+$item;
+$count = 0;
+$wanted = sub {
+ ++$count;
+ $item = $_;
+};
+walk $wanted, $data;
+ok $count, 1;
+ok $item, $data;
+
+$data = [ (0 .. 4) ];
+$count = 0;
+$wanted = sub {
+ ok($Data::Walk::type, 'ARRAY') unless ref $_;
+ ++$count;
+};
+walk $wanted, $data;
+ok $count, 1 + @{$data};
+
+@hashdata = qw (a b c d e);
+$data = { map { $_ => $_ } @hashdata };
+$count = 0;
+$wanted = sub {
+ ok($Data::Walk::type, 'HASH')unless ref $_;
+ ++$count;
+};
+walk $wanted, $data;
+ok $count, 1 + 2 * @hashdata;
+
+@hashdata = qw (a b c d e);
+$data = { map { $_ => $_ } @hashdata };
+my @list = (0 .. 4);
+$data->{list} = [ @list ];
+$count = 0;
+$wanted = sub {
+ ++$count;
+};
+walk $wanted, $data;
+ok $count, 1 + 2 * @hashdata + 2 + @list;
+
+$data = [ (0 .. 4) ];
+bless $data;
+$count = 0;
+$wanted = sub {
+ $DB::single = 1;
+ ok($Data::Walk::type, 'ARRAY') unless ref $_;
+ ++$count;
+};
+walk $wanted, $data;
+ok $count, 1 + @{$data};
+
+@hashdata = qw (a b c d e);
+$data = { map { $_ => $_ } @hashdata };
+bless $data;
+
+$count = 0;
+$wanted = sub {
+ ok($Data::Walk::type, 'HASH') unless ref $_;
+ ++$count;
+};
+walk $wanted, $data;
+ok $count, 1 + 2 * @hashdata;
+
+@hashdata = qw (a b c d e);
+$data = { map { $_ => $_ } @hashdata };
+@list = (0 .. 4);
+$data->{list} = [ @list ];
+bless $data;
+bless $data->{list};
+
+$count = 0;
+$wanted = sub {
+ ++$count;
+};
+walk $wanted, $data;
+ok $count, 1 + 2 * @hashdata + 2 + @list;
+
+$data = [[[[[ 1 ], 11], 111], 1111], 11111];
+my $wasref = 1;
+my $last = '';
+$wanted = sub {
+ my $isref = ref $_;
+
+ ok ($wasref || (!$wasref && !$isref));
+
+ $last = $_;
+ $wasref = $isref;
+};
+walk $wanted, $data;
+ok !$wasref;
+
+# The test data is constructed so that each node that is an
+# array reference has a number of elements equal to its depth.
+# Scalars are also equal to their depth.
+$data = [
+ [
+ 3, [ 4, 4, 4, ],
+ ],
+ ];
+
+$wanted = sub {
+ if (ref $_) {
+ my $num = @$_;
+ ok $Data::Walk::depth, $num;
+ } else {
+ $Data::Walk::depth, $_;
+ }
+};
+walk $wanted, $data;
diff --git a/t/TS_Basic.pm b/t/01by_depth.t
similarity index 51%
copy from t/TS_Basic.pm
copy to t/01by_depth.t
index e7de3b6..003fe22 100755
--- a/t/TS_Basic.pm
+++ b/t/01by_depth.t
@@ -1,9 +1,5 @@
-#! /bin/false
-
-# $Id: TS_Basic.pm,v 1.3 2006/05/11 13:56:28 guido Exp $
-
# Data::Walk - Traverse Perl data structures.
-# Copyright (C) 2005-2006 Guido Flohr <gu...@imperia.net>,
+# Copyright (C) 2005-2016 Guido Flohr <guido.fl...@cantanea.com>,
# all rights reserved.
# This program is free software; you can redistribute it and/or modify it
@@ -21,31 +17,44 @@
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
# USA.
-package TS_Basic;
-
use strict;
-use base qw (Test::Unit::TestSuite);
-
-sub name { "Testsuite for basic functionality Data::Walk" }
-sub include_tests {
- qw (
- TC_Basic
- TC_ByDepth
- );
+use Test;
+use Data::Walk;
+
+BEGIN {
+ plan tests => 13;
+}
+
+my ($data, $wanted);
+
+my $data = [[[[[ 1 ], 11], 111], 1111], 11111];
+
+my $wasref = 1;
+my $last = 'undef';
+$wanted = sub {
+ my $isref = ref $_;
+ ok ($wasref xor $isref);
+ $last = $_;
+ $wasref = $isref;
+};
+walkdepth $wanted, $data;
+
+# The test data is constructed so that each node that is an
+# array reference has a number of elements equal to its depth.
+# Scalars are also equal to their depth.
+$data = [
+ [
+ 3, [ 4, 4, 4, ],
+ ],
+];
+
+$wanted = sub {
+ if (ref $_) {
+ my $num = @$_;
+ ok $Data::Walk::depth, $num;
+ } else {
+ $Data::Walk::depth, $_;
}
-
-1;
-
-#Local Variables:
-#mode: perl
-#perl-indent-level: 4
-#perl-continued-statement-offset: 4
-#perl-continued-brace-offset: 0
-#perl-brace-offset: -4
-#perl-brace-imaginary-offset: 0
-#perl-label-offset: -4
-#cperl-indent-level: 4
-#cperl-continued-statement-offset: 2
-#tab-width: 8
-#End:
+};
+walkdepth $wanted, $data;
diff --git a/t/01follow.t b/t/01follow.t
new file mode 100755
index 0000000..9a78acc
--- /dev/null
+++ b/t/01follow.t
@@ -0,0 +1,77 @@
+# Data::Walk - Traverse Perl data structures.
+# Copyright (C) 2005-2016 Guido Flohr <guido.fl...@cantanea.com>,
+# all rights reserved.
+
+# This program is free software; you can redistribute it and/or modify it
+# under the terms of the GNU Library General Public License as published
+# by the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# Library General Public License for more details.
+
+# You should have received a copy of the GNU Library General Public
+# License along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+# USA.
+
+use strict;
+
+use Test;
+use Data::Walk;
+
+BEGIN {
+ plan tests => 11;
+}
+
+my ($data, $wanted, $count, $preprocess);
+
+$data = { foo => 'bar' };
+$data->{baz} = $data;
+
+$count = 0;
+$wanted = sub {
+ ++$count;
+ ok ($count <= 5);
+};
+walk { wanted => $wanted }, $data;
+
+ok $count, 5;
+
+$preprocess = sub {
+ my @args = @_;
+
+ return () if $count > 10;
+
+ return @args;
+};
+
+$wanted = sub {
+ ++$count;
+};
+walk { wanted => $wanted,
+ follow => 1,
+ preprocess => $preprocess,
+ }, $data;
+ok $count > 5;
+
+$data = {};
+bless $data, 'Data::Walk::Fake';
+
+$wanted = sub {
+ ok $Data::Walk::address, int $_;
+};
+walk { wanted => $wanted }, $data;
+
+my $scalar = 'foobar';
+$data = [ \$scalar, \$scalar, \$scalar ];
+$count = 0;
+$wanted = sub {
+ unless ('ARRAY' eq ref $_) {
+ ok $Data::Walk::seen, $count++;
+ }
+};
+walk { wanted => $wanted }, $data;
+$count, scalar @{$data};
diff --git a/t/TS_Options.pm b/t/01index.t
similarity index 56%
rename from t/TS_Options.pm
rename to t/01index.t
index ebdca5f..b8328be 100755
--- a/t/TS_Options.pm
+++ b/t/01index.t
@@ -1,9 +1,5 @@
-#! /bin/false
-
-# $Id: TS_Options.pm,v 1.3 2006/05/11 13:56:28 guido Exp $
-
# Data::Walk - Traverse Perl data structures.
-# Copyright (C) 2005-2006 Guido Flohr <gu...@imperia.net>,
+# Copyright (C) 2005-2016 Guido Flohr <guido.fl...@cantanea.com>,
# all rights reserved.
# This program is free software; you can redistribute it and/or modify it
@@ -21,33 +17,31 @@
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
# USA.
-package TS_Options;
-
use strict;
-use base qw (Test::Unit::TestSuite);
-
-sub name { "Test various options of Data::Walk" }
-sub include_tests {
- qw (
- TC_PreProcess
- TC_PostProcess
- TC_Follow
- TC_Copy
- );
- }
-
-1;
-
-#Local Variables:
-#mode: perl
-#perl-indent-level: 4
-#perl-continued-statement-offset: 4
-#perl-continued-brace-offset: 0
-#perl-brace-offset: -4
-#perl-brace-imaginary-offset: 0
-#perl-label-offset: -4
-#cperl-indent-level: 4
-#cperl-continued-statement-offset: 2
-#tab-width: 8
-#End:
+use Test;
+use Data::Walk;
+
+BEGIN {
+ plan tests => 12;
+}
+
+my ($data, $wanted, $count, @expect);
+
+$data = { hash => [0 .. 2]};
+$data => {foo => 27, bar => 42, baz => 33};
+@expect = (0, 0, 1, 0, 1, 2);
+$count = 0;
+$wanted = sub {
+ ok $Data::Walk::index, shift @expect, "Index wrong at position $count";
+ ++$count;
+};
+walk { wanted => $wanted }, $data;
+
+@expect = (0, 0, 1, 2, 1, 0);
+$count = 0;
+$wanted = sub {
+ ok $Data::Walk::index, shift @expect, "Index wrong at position $count";
+ ++$count;
+};
+walkdepth { wanted => $wanted }, $data;
diff --git a/t/TS_Basic.pm b/t/01post_process.t
similarity index 57%
copy from t/TS_Basic.pm
copy to t/01post_process.t
index e7de3b6..bdfae8b 100755
--- a/t/TS_Basic.pm
+++ b/t/01post_process.t
@@ -1,9 +1,5 @@
-#! /bin/false
-
-# $Id: TS_Basic.pm,v 1.3 2006/05/11 13:56:28 guido Exp $
-
# Data::Walk - Traverse Perl data structures.
-# Copyright (C) 2005-2006 Guido Flohr <gu...@imperia.net>,
+# Copyright (C) 2005-2016 Guido Flohr <guido.fl...@cantanea.com>,
# all rights reserved.
# This program is free software; you can redistribute it and/or modify it
@@ -21,31 +17,28 @@
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
# USA.
-package TS_Basic;
-
use strict;
-use base qw (Test::Unit::TestSuite);
-
-sub name { "Testsuite for basic functionality Data::Walk" }
-sub include_tests {
- qw (
- TC_Basic
- TC_ByDepth
- );
- }
-
-1;
-
-#Local Variables:
-#mode: perl
-#perl-indent-level: 4
-#perl-continued-statement-offset: 4
-#perl-continued-brace-offset: 0
-#perl-brace-offset: -4
-#perl-brace-imaginary-offset: 0
-#perl-label-offset: -4
-#cperl-indent-level: 4
-#cperl-continued-statement-offset: 2
-#tab-width: 8
-#End:
+use Test;
+use Data::Walk;
+
+BEGIN {
+ plan tests => 2;
+}
+
+my (%data, $wanted, $count, $postprocess);
+
+%data = ('A' .. 'Z', 'a' .. 'z');
+
+my $postprocessor_calls = 0;
+my $container;
+
+$postprocess = sub {
+ ++$postprocessor_calls;
+ $container = $Data::Walk::container;
+};
+
+$wanted = sub {};
+walk { wanted => $wanted, postprocess => $postprocess}, \%data;
+ok $postprocessor_calls;
+ok \%data, $container;
diff --git a/t/01pre_process.t b/t/01pre_process.t
new file mode 100755
index 0000000..ece0ee2
--- /dev/null
+++ b/t/01pre_process.t
@@ -0,0 +1,112 @@
+# Data::Walk - Traverse Perl data structures.
+# Copyright (C) 2005-2016 Guido Flohr <guido.fl...@cantanea.com>,
+# all rights reserved.
+
+# This program is free software; you can redistribute it and/or modify it
+# under the terms of the GNU Library General Public License as published
+# by the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# Library General Public License for more details.
+
+# You should have received a copy of the GNU Library General Public
+# License along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+# USA.
+
+use strict;
+
+use Test;
+use Data::Walk;
+
+BEGIN {
+ plan tests => 160;
+}
+
+my ($wanted, $count, $preprocess, $preprocessor_calls, $last);
+
+my %data = ('A' .. 'Z', 'a' .. 'z');
+
+$preprocessor_calls = 0;
+$preprocess = sub {
+ my %container = @_;
+ my @sorted;
+
+ foreach my $key (sort keys %container) {
+ push @sorted, $key, $container{$key};
+ }
+
+ ++$preprocessor_calls;
+ return @sorted;
+};
+
+$last = '';
+$wanted = sub {
+ unless (ref $_) {
+ ok($_ gt $last);
+ $last = $_;
+ }
+};
+walk { wanted => $wanted, preprocess => $preprocess}, \%data;
+
+ok $preprocessor_calls;
+
+my @data = ('A' .. 'Z', 'a' .. 'z');
+
+$preprocessor_calls = 0;
+$preprocess = sub {
+ ++$preprocessor_calls;
+ return reverse sort @_;
+};
+
+$last = chr (1 + ord $data[-1]);
+$wanted = sub {
+ unless (ref $_) {
+ ok($_ lt $last);
+ $last = $_;
+ }
+};
+walk { wanted => $wanted, preprocess => $preprocess}, \@data;
+
+ok $preprocessor_calls;
+
+%data = ('A' .. 'Z', 'a' .. 'z');
+
+$preprocessor_calls = 0;
+$preprocess = sub {
+ my %container = @_;
+ my @sorted;
+
+ foreach my $key (sort keys %container) {
+ push @sorted, $key, $container{$key};
+ }
+
+ ++$preprocessor_calls;
+ return @sorted;
+};
+
+$last = '';
+$wanted = sub {
+ unless (ref $_) {
+ ok($_ gt $last);
+ $last = $_;
+ }
+};
+walk { wanted => $wanted, preprocess_hash => $preprocess}, \%data;
+
+ok $preprocessor_calls;
+
+@data = ('A' .. 'Z', 'a' .. 'z');
+
+$preprocessor_calls = 0;
+$preprocess = sub {
+ ++$preprocessor_calls;
+};
+
+$wanted = sub {};
+walk { wanted => $wanted, preprocess_hash => $preprocess}, \@data;
+
+ok(!$preprocessor_calls);
diff --git a/t/TS_Basic.pm b/t/03bugs-1.t
similarity index 56%
rename from t/TS_Basic.pm
rename to t/03bugs-1.t
index e7de3b6..713393f 100755
--- a/t/TS_Basic.pm
+++ b/t/03bugs-1.t
@@ -1,9 +1,5 @@
-#! /bin/false
-
-# $Id: TS_Basic.pm,v 1.3 2006/05/11 13:56:28 guido Exp $
-
# Data::Walk - Traverse Perl data structures.
-# Copyright (C) 2005-2006 Guido Flohr <gu...@imperia.net>,
+# Copyright (C) 2005-2016 Guido Flohr <guido.fl...@cantanea.com>,
# all rights reserved.
# This program is free software; you can redistribute it and/or modify it
@@ -21,31 +17,39 @@
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
# USA.
-package TS_Basic;
-
use strict;
-use base qw (Test::Unit::TestSuite);
-
-sub name { "Testsuite for basic functionality Data::Walk" }
-sub include_tests {
- qw (
- TC_Basic
- TC_ByDepth
- );
- }
-
-1;
-
-#Local Variables:
-#mode: perl
-#perl-indent-level: 4
-#perl-continued-statement-offset: 4
-#perl-continued-brace-offset: 0
-#perl-brace-offset: -4
-#perl-brace-imaginary-offset: 0
-#perl-label-offset: -4
-#cperl-indent-level: 4
-#cperl-continued-statement-offset: 2
-#tab-width: 8
-#End:
+use Test;
+use Data::Walk;
+
+BEGIN {
+ plan tests => 6;
+}
+
+my ($data);
+
+$data = {
+ foo => 'bar',
+ baz => 'bazoo',
+};
+bless $data;
+walk { wanted => sub {} }, $data;
+ok ref $data, __PACKAGE__;
+
+$data = [ 0, 1, 2, 3 ];
+bless $data;
+walk { wanted => sub {} }, $data;
+ok ref $data, __PACKAGE__;
+
+$data = {
+ foo => 'bar',
+ baz => 'bazoo',
+};
+walk { wanted => sub {} }, $data;
+ok ref $data, 'HASH';
+ok $data =~ /^HASH\(0x[0-9a-f]+\)$/;
+
+$data = [ 0, 1, 2, 3];
+walk { wanted => sub {} }, $data;
+ok ref $data, 'ARRAY';
+ok $data =~ /^ARRAY\(0x[0-9a-f]+\)$/;
diff --git a/t/TS_All.pm b/t/04bug-container-type-by-depth.t
similarity index 57%
rename from t/TS_All.pm
rename to t/04bug-container-type-by-depth.t
index 80fc18d..6bed43c 100755
--- a/t/TS_All.pm
+++ b/t/04bug-container-type-by-depth.t
@@ -1,9 +1,5 @@
-#! /bin/false
-
-# $Id: TS_All.pm,v 1.11 2006/05/11 13:56:28 guido Exp $
-
# Data::Walk - Traverse Perl data structures.
-# Copyright (C) 2005-2006 Guido Flohr <gu...@imperia.net>,
+# Copyright (C) 2005-2016 Guido Flohr <guido.fl...@cantanea.com>,
# all rights reserved.
# This program is free software; you can redistribute it and/or modify it
@@ -21,33 +17,20 @@
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
# USA.
-package TS_All;
-
use strict;
-use base qw (Test::Unit::TestSuite);
-
-sub name { "Top level testsuite for Data::Walk" }
-sub include_tests {
- qw (
- TS_Basic
- TS_Options
- TC_Examples
- TC_Bugs
- );
- }
-
-1;
-
-#Local Variables:
-#mode: perl
-#perl-indent-level: 4
-#perl-continued-statement-offset: 4
-#perl-continued-brace-offset: 0
-#perl-brace-offset: -4
-#perl-brace-imaginary-offset: 0
-#perl-label-offset: -4
-#cperl-indent-level: 4
-#cperl-continued-statement-offset: 2
-#tab-width: 8
-#End:
+use Test;
+use Data::Walk;
+
+BEGIN {
+ plan tests => 10;
+}
+
+my $data = {
+ foo => 'bar',
+ baz => 'bazoo',
+};
+walk sub {
+ ok $Data::Walk::type, 'HASH';
+ ok $Data::Walk::container, $data;
+}, $data;
diff --git a/t/TC_Basic.pm b/t/TC_Basic.pm
deleted file mode 100755
index 31b9962..0000000
--- a/t/TC_Basic.pm
+++ /dev/null
@@ -1,214 +0,0 @@
-#! /bin/false
-
-# $Id: TC_Basic.pm,v 1.6 2006/05/11 13:56:28 guido Exp $
-
-# Data::Walk - Traverse Perl data structures.
-# Copyright (C) 2005-2006 Guido Flohr <gu...@imperia.net>,
-# all rights reserved.
-
-# This program is free software; you can redistribute it and/or modify it
-# under the terms of the GNU Library General Public License as published
-# by the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# Library General Public License for more details.
-
-# You should have received a copy of the GNU Library General Public
-# License along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
-# USA.
-
-package TC_Basic;
-
-use strict;
-
-use base qw (Test::Unit::TestCase);
-
-use Data::Walk;
-
-sub testScalar {
- my $self = shift,
-
- my $data = "foobar";
-
- my $item;
- my $count = 0;
- my $wanted = sub {
- ++$count;
- $item = $_;
- };
- walk $wanted, $data;
-
- $self->assert_equals (1, $count);
- $self->assert_str_equals ($data, $item);
-}
-
-sub testArray {
- my $self = shift;
-
- my $data = [ (0 .. 4) ];
-
- my $count;
- my $wanted = sub {
- $self->assert_str_equals ('ARRAY', $Data::Walk::type)
- unless ref $_;
- ++$count;
- };
- walk $wanted, $data;
-
- $self->assert_equals (1 + @{$data}, $count);
-}
-
-sub testHash {
- my $self = shift;
-
- my @hashdata = qw (a b c d e);
- my $data = { map { $_ => $_ } @hashdata };
-
- my $count;
- my $wanted = sub {
- $self->assert_str_equals ('HASH', $Data::Walk::type)
- unless ref $_;
- ++$count;
- };
- walk $wanted, $data;
-
- $self->assert_equals (1 + 2 * @hashdata, $count);
-}
-
-sub testMixed {
- my $self = shift;
-
- my @hashdata = qw (a b c d e);
- my $data = { map { $_ => $_ } @hashdata };
- my @list = (0 .. 4);
- $data->{list} = [ @list ];
-
- my $count;
- my $wanted = sub {
- ++$count;
- };
- walk $wanted, $data;
-
- $self->assert_equals (1 + 2 * @hashdata + 2 + @list, $count);
-}
-
-sub testBlessedArray {
- my $self = shift;
-
- my $data = [ (0 .. 4) ];
- bless $data;
-
- my $count;
- my $wanted = sub {
- $self->assert_str_equals ('ARRAY', $Data::Walk::type)
- unless ref $_;
- ++$count;
- };
- walk $wanted, $data;
-
- $self->assert_equals (1 + @{$data}, $count);
-}
-
-sub testBlessedHash {
- my $self = shift;
-
- my @hashdata = qw (a b c d e);
- my $data = { map { $_ => $_ } @hashdata };
- bless $data;
-
- my $count;
- my $wanted = sub {
- $self->assert_str_equals ('HASH', $Data::Walk::type)
- unless ref $_;
- ++$count;
- };
- walk $wanted, $data;
-
- $self->assert_equals (1 + 2 * @hashdata, $count);
-}
-
-sub testBlessedMixed {
- my $self = shift;
-
- my @hashdata = qw (a b c d e);
- my $data = { map { $_ => $_ } @hashdata };
- my @list = (0 .. 4);
- $data->{list} = [ @list ];
- bless $data;
- bless $data->{list};
-
- my $count;
- my $wanted = sub {
- ++$count;
- };
- walk $wanted, $data;
-
- $self->assert_equals (1 + 2 * @hashdata + 2 + @list, $count);
-}
-
-sub testTraverse {
- my $self = shift;
-
- my $data = [[[[[ 1 ], 11], 111], 1111], 11111];
-
- my $wasref = 1;
- my $last = '';
- my $wanted = sub {
- my $isref = ref $_;
-
- $self->assert ($wasref || (!$wasref && !$isref),
- "References and non-references should "
- . "alternate only once. "
- . "Last: $last ($wasref), current: $_ ($isref).");
-
- $last = $_;
- $wasref = $isref;
- };
- walk $wanted, $data;
-
- $self->assert (!$wasref,
- "The last visited node should not be "
- . "a reference.");
-}
-
-sub testDepth {
- my $self = shift;
-
- # The test data is constructed so that each node that is an
- # array reference has a number of elements equal to its depth.
- # Scalars are also equal to their depth.
- my $data = [
- [
- 3, [ 4, 4, 4, ],
- ],
- ];
-
- my $wanted = sub {
- if (ref $_) {
- my $num = @$_;
- $self->assert_num_equals ($num, $Data::Walk::depth);
- } else {
- $self->assert_num_equals ($_, $Data::Walk::depth);
- }
- };
- walk $wanted, $data;
-}
-
-1;
-
-#Local Variables:
-#mode: perl
-#perl-indent-level: 4
-#perl-continued-statement-offset: 4
-#perl-continued-brace-offset: 0
-#perl-brace-offset: -4
-#perl-brace-imaginary-offset: 0
-#perl-label-offset: -4
-#cperl-indent-level: 4
-#cperl-continued-statement-offset: 2
-#tab-width: 8
-#End:
diff --git a/t/TC_Bugs.pm b/t/TC_Bugs.pm
deleted file mode 100755
index 101e026..0000000
--- a/t/TC_Bugs.pm
+++ /dev/null
@@ -1,80 +0,0 @@
-#! /bin/false
-
-# $Id: TC_Bugs.pm,v 1.4 2006/05/11 13:56:28 guido Exp $
-
-# Data::Walk - Traverse Perl data structures.
-# Copyright (C) 2005-2006 Guido Flohr <gu...@imperia.net>,
-# all rights reserved.
-
-# This program is free software; you can redistribute it and/or modify it
-# under the terms of the GNU Library General Public License as published
-# by the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# Library General Public License for more details.
-
-# You should have received a copy of the GNU Library General Public
-# License along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
-# USA.
-
-package TC_Bugs;
-
-use strict;
-
-use base qw (Test::Unit::TestCase);
-
-use Data::Walk;
-
-sub testKeepBlessing {
- my ($self) = @_;
-
- my $data;
-
- $data = {
- foo => 'bar',
- baz => 'bazoo',
- };
- bless $data;
- walk { wanted => sub {} }, $data;
- $self->assert_str_equals (__PACKAGE__, ref $data);
-
- $data = [ 0, 1, 2, 3 ];
- bless $data;
- walk { wanted => sub {} }, $data;
- $self->assert_str_equals (__PACKAGE__, ref $data);
-
- $data = {
- foo => 'bar',
- baz => 'bazoo',
- };
- walk { wanted => sub {} }, $data;
- $self->assert_str_equals ('HASH', ref $data);
- my $success = $data =~ /^HASH\(0x[0-9a-f]+\)$/;
- $self->assert ($success, "Simple hash has been blessed: $data.");
-
-
- $data = [ 0, 1, 2, 3];
- walk { wanted => sub {} }, $data;
- $self->assert_str_equals ('ARRAY', ref $data);
- $success = $data =~ /^ARRAY\(0x[0-9a-f]+\)$/;
- $self->assert ($success, "Simple array has been blessed: $data.");
-}
-
-1;
-
-#Local Variables:
-#mode: perl
-#perl-indent-level: 4
-#perl-continued-statement-offset: 4
-#perl-continued-brace-offset: 0
-#perl-brace-offset: -4
-#perl-brace-imaginary-offset: 0
-#perl-label-offset: -4
-#cperl-indent-level: 4
-#cperl-continued-statement-offset: 2
-#tab-width: 8
-#End:
diff --git a/t/TC_ByDepth.pm b/t/TC_ByDepth.pm
deleted file mode 100755
index 590eeba..0000000
--- a/t/TC_ByDepth.pm
+++ /dev/null
@@ -1,89 +0,0 @@
-#! /bin/false
-
-# $Id: TC_ByDepth.pm,v 1.5 2006/05/11 13:56:28 guido Exp $
-
-# Data::Walk - Traverse Perl data structures.
-# Copyright (C) 2005-2006 Guido Flohr <gu...@imperia.net>,
-# all rights reserved.
-
-# This program is free software; you can redistribute it and/or modify it
-# under the terms of the GNU Library General Public License as published
-# by the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# Library General Public License for more details.
-
-# You should have received a copy of the GNU Library General Public
-# License along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
-# USA.
-
-package TC_ByDepth;
-
-use strict;
-
-use base qw (Test::Unit::TestCase);
-
-use Data::Walk;
-
-sub testTraverseDepth {
- my $self = shift;
-
- my $data = [[[[[ 1 ], 11], 111], 1111], 11111];
-
- my $wasref = 1;
- my $last = 'undef';
- my $wanted = sub {
- my $isref = ref $_;
-
- $self->assert (($wasref xor $isref),
- "References and non-references should "
- . "alternate. Last: $last, current: $_.");
- $last = $_;
- $wasref = $isref;
- };
-
- walkdepth $wanted, $data;
-}
-
-sub testDepth {
- my $self = shift;
-
- # The test data is constructed so that each node that is an
- # array reference has a number of elements equal to its depth.
- # Scalars are also equal to their depth.
- my $data = [
- [
- 3, [ 4, 4, 4, ],
- ],
- ];
-
- my $wanted = sub {
- if (ref $_) {
- my $num = @$_;
- $self->assert_num_equals ($num, $Data::Walk::depth);
- } else {
- $self->assert_num_equals ($_, $Data::Walk::depth);
- }
- };
-
- walkdepth $wanted, $data;
-}
-
-1;
-
-#Local Variables:
-#mode: perl
-#perl-indent-level: 4
-#perl-continued-statement-offset: 4
-#perl-continued-brace-offset: 0
-#perl-brace-offset: -4
-#perl-brace-imaginary-offset: 0
-#perl-label-offset: -4
-#cperl-indent-level: 4
-#cperl-continued-statement-offset: 2
-#tab-width: 8
-#End:
diff --git a/t/TC_Copy.pm b/t/TC_Copy.pm
deleted file mode 100755
index 33d365b..0000000
--- a/t/TC_Copy.pm
+++ /dev/null
@@ -1,88 +0,0 @@
-#! /bin/false
-
-# $Id: TC_Copy.pm,v 1.3 2006/05/11 13:56:28 guido Exp $
-
-# Data::Walk - Traverse Perl data structures.
-# Copyright (C) 2005-2006 Guido Flohr <gu...@imperia.net>,
-# all rights reserved.
-
-# This program is free software; you can redistribute it and/or modify it
-# under the terms of the GNU Library General Public License as published
-# by the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# Library General Public License for more details.
-
-# You should have received a copy of the GNU Library General Public
-# License along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
-# USA.
-
-package TC_Copy;
-
-use strict;
-
-use base qw (Test::Unit::TestCase);
-
-use Data::Walk;
-
-sub testHashCopy {
- my ($self) = @_;
-
- my $data = {
- foo => 'bar',
- baz => 'bazoo',
- };
-
- my $count = 0;
- my $preprocess = sub {
- my %args= @_;
- delete $args{baz};
- return %args;
- };
- walk { wanted => sub { ++$count }, preprocess => $preprocess }, $data;
-
- $self->assert_str_equals ($data->{foo}, 'bar');
- $self->assert_str_equals ($data->{baz}, 'bazoo');
- $self->assert_num_equals (3, $count);
-}
-
-sub testHashNoCopy {
- my ($self) = @_;
-
- my $data = {
- foo => 'bar',
- baz => 'bazoo',
- };
-
- my $count = 0;
- my $preprocess = sub {
- my $args = shift;
- delete $args->{baz};
- return $args;
- };
- walk { wanted => sub { ++$count }, preprocess => $preprocess,
- copy => 0 }, $data;
-
- $self->assert_str_equals ($data->{foo}, 'bar');
- $self->assert (!exists $data->{baz});
- $self->assert_num_equals (3, $count);
-}
-
-1;
-
-#Local Variables:
-#mode: perl
-#perl-indent-level: 4
-#perl-continued-statement-offset: 4
-#perl-continued-brace-offset: 0
-#perl-brace-offset: -4
-#perl-brace-imaginary-offset: 0
-#perl-label-offset: -4
-#cperl-indent-level: 4
-#cperl-continued-statement-offset: 2
-#tab-width: 8
-#End:
diff --git a/t/TC_Examples.pm b/t/TC_Examples.pm
deleted file mode 100755
index a407cbd..0000000
--- a/t/TC_Examples.pm
+++ /dev/null
@@ -1,112 +0,0 @@
-#! /bin/false
-
-# $Id: TC_Examples.pm,v 1.1 2006/05/11 13:49:09 guido Exp $
-
-# Data::Walk - Traverse Perl data structures.
-# Copyright (C) 2006 Guido Flohr <gu...@imperia.net>,
-# all rights reserved.
-
-# This program is free software; you can redistribute it and/or modify it
-# under the terms of the GNU Library General Public License as published
-# by the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# Library General Public License for more details.
-
-# You should have received a copy of the GNU Library General Public
-# License along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
-# USA.
-
-package TC_Examples;
-
-use strict;
-
-use base qw (Test::Unit::TestCase);
-
-use Data::Walk;
-
-sub testRecursiveUntainting {
- my ($self) = @_;
-
- # We don't really untaint here, because we don't want to rely
- # on external modules or on running with -T.
- my $data = {
- foo => [
- 'bar', [ 'baz', "bazoo\nbazaar" ],
- ],
- };
-
- my $concat = '';
- my $expect = "foobarbazbazoo\nbazaar";
- my $wanted = sub {
- s/(.*)/$1/s unless ref $_;
- $concat .= $1 unless ref $_;
- };
- walk $wanted, $data;
- $self->assert_str_equals ($expect, $concat);
-}
-
-sub testMaxDepth {
- my ($self) = @_;
-
- my $data =[
- f => [
- fo => [
- foo => [
- 'Ouch!',
- ],
- ],
- ],
- b => [
- ba => [
- bar => [
- 'Ouch!',
- ],
- ],
- ],
- b => [
- ba => [
- baz => [
- 'Ouch!',
- ],
- ],
- ],
- ];
-
- my $pre_process = sub {
- if ($Data::Walk::depth > 3) {
- return ();
- } else {
- return @_;
- }
- };
-
- my $concat = '';
- my $wanted = sub {
- $self->assert_str_not_equals ('Ouch!', $_) unless ref $_;
- $concat .= $_ unless ref $_;
- };
-
- walk { wanted => $wanted, preprocess => $pre_process }, $data;
- my $expect = "ffofoobbabarbbabaz";
- $self->assert_str_equals ($expect, $concat);
-}
-
-1;
-
-#Local Variables:
-#mode: perl
-#perl-indent-level: 4
-#perl-continued-statement-offset: 4
-#perl-continued-brace-offset: 0
-#perl-brace-offset: -4
-#perl-brace-imaginary-offset: 0
-#perl-label-offset: -4
-#cperl-indent-level: 4
-#cperl-continued-statement-offset: 2
-#tab-width: 8
-#End:
diff --git a/t/TC_Follow.pm b/t/TC_Follow.pm
deleted file mode 100755
index a97c652..0000000
--- a/t/TC_Follow.pm
+++ /dev/null
@@ -1,117 +0,0 @@
-#! /bin/false
-
-# $Id: TC_Follow.pm,v 1.3 2006/05/11 13:56:28 guido Exp $
-
-# Data::Walk - Traverse Perl data structures.
-# Copyright (C) 2005-2006 Guido Flohr <gu...@imperia.net>,
-# all rights reserved.
-
-# This program is free software; you can redistribute it and/or modify it
-# under the terms of the GNU Library General Public License as published
-# by the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# Library General Public License for more details.
-
-# You should have received a copy of the GNU Library General Public
-# License along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
-# USA.
-
-package TC_Follow;
-
-use strict;
-
-use base qw (Test::Unit::TestCase);
-
-use Data::Walk;
-
-my $data = { foo => 'bar' };
-$data->{baz} = $data;
-
-sub testDoNotFollow {
- my ($self) = @_;
-
- my $count = 0;
- my $wanted = sub {
- ++$count;
- $self->assert ($count <= 5,
- "Cyclic references were followed although the"
- . " option 'follow' was not given.");
- };
- walk { wanted => $wanted }, $data;
-
- $self->assert_equals (5, $count);
-}
-
-sub testDoFollow {
- my ($self) = @_;
-
- my $count = 0;
-
- my $preprocess = sub {
- my @args = @_;
-
- return () if $count > 10;
-
- return @args;
- };
-
- my $wanted = sub {
- ++$count;
- };
- walk { wanted => $wanted,
- follow => 1,
- preprocess => $preprocess,
- }, $data;
-
- $self->assert ($count > 5, "Cyclic references were not followed.");
-}
-
-sub testAddress {
- my ($self) = @_;
-
- my $data = {};
- bless $data, 'Data::Walk::Fake';
-
- my $wanted = sub {
- my $address = int $_;
- $self->assert_equals ($address, $Data::Walk::address);
- };
- walk { wanted => $wanted }, $data;
-}
-
-sub testSeen {
- my ($self) = @_;
-
- my $scalar = 'foobar';
-
- my $data = [ \$scalar, \$scalar, \$scalar ];
- my $count = 0;
-
- my $wanted = sub {
- unless ('ARRAY' eq ref $_) {
- $self->assert_equals ($count++, $Data::Walk::seen);
- }
- };
- walk { wanted => $wanted }, $data;
- $self->assert_equals (@{$data}, $count);
-}
-
-1;
-
-#Local Variables:
-#mode: perl
-#perl-indent-level: 4
-#perl-continued-statement-offset: 4
-#perl-continued-brace-offset: 0
-#perl-brace-offset: -4
-#perl-brace-imaginary-offset: 0
-#perl-label-offset: -4
-#cperl-indent-level: 4
-#cperl-continued-statement-offset: 2
-#tab-width: 8
-#End:
diff --git a/t/TC_PostProcess.pm b/t/TC_PostProcess.pm
deleted file mode 100755
index 9ccfb45..0000000
--- a/t/TC_PostProcess.pm
+++ /dev/null
@@ -1,67 +0,0 @@
-#! /bin/false
-
-# $Id: TC_PostProcess.pm,v 1.3 2006/05/11 13:56:28 guido Exp $
-
-# Data::Walk - Traverse Perl data structures.
-# Copyright (C) 2005-2006 Guido Flohr <gu...@imperia.net>,
-# all rights reserved.
-
-# This program is free software; you can redistribute it and/or modify it
-# under the terms of the GNU Library General Public License as published
-# by the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# Library General Public License for more details.
-
-# You should have received a copy of the GNU Library General Public
-# License along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
-# USA.
-
-package TC_PostProcess;
-
-use strict;
-
-use base qw (Test::Unit::TestCase);
-
-use Data::Walk;
-
-sub testCalling {
- my ($self) = @_;
-
- my %data = ('A' .. 'Z', 'a' .. 'z');
-
- my $postprocessor_calls = 0;
- my $container;
-
- my $postprocess = sub {
- ++$postprocessor_calls;
- $container = $Data::Walk::container;
- };
-
- my $wanted = sub {};
- walk { wanted => $wanted, postprocess => $postprocess}, \%data;
-
- $self->assert ($postprocessor_calls,
- "Postprocessing function never called.");
-
- $self->assert_equals (\%data, $container);
-}
-
-1;
-
-#Local Variables:
-#mode: perl
-#perl-indent-level: 4
-#perl-continued-statement-offset: 4
-#perl-continued-brace-offset: 0
-#perl-brace-offset: -4
-#perl-brace-imaginary-offset: 0
-#perl-label-offset: -4
-#cperl-indent-level: 4
-#cperl-continued-statement-offset: 2
-#tab-width: 8
-#End:
diff --git a/t/TC_PreProcess.pm b/t/TC_PreProcess.pm
deleted file mode 100755
index e8e15b3..0000000
--- a/t/TC_PreProcess.pm
+++ /dev/null
@@ -1,147 +0,0 @@
-#! /bin/false
-
-# $Id: TC_PreProcess.pm,v 1.4 2006/05/11 13:56:28 guido Exp $
-
-# Data::Walk - Traverse Perl data structures.
-# Copyright (C) 2005-2006 Guido Flohr <gu...@imperia.net>,
-# all rights reserved.
-
-# This program is free software; you can redistribute it and/or modify it
-# under the terms of the GNU Library General Public License as published
-# by the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# Library General Public License for more details.
-
-# You should have received a copy of the GNU Library General Public
-# License along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
-# USA.
-
-package TC_PreProcess;
-
-use strict;
-
-use base qw (Test::Unit::TestCase);
-
-use Data::Walk;
-
-sub testHash {
- my ($self) = @_;
-
- my %data = ('A' .. 'Z', 'a' .. 'z');
-
- my $preprocessor_calls = 0;
- my $preprocess = sub {
- my %container = @_;
- my @sorted;
-
- foreach my $key (sort keys %container) {
- push @sorted, $key, $container{$key};
- }
-
- ++$preprocessor_calls;
- return @sorted;
- };
-
- my $last = '';
- my $wanted = sub {
- unless (ref $_) {
- $self->assert ($_ gt $last,
- "Hash is not traversed in preprocess order.");
- $last = $_;
- }
- };
- walk { wanted => $wanted, preprocess => $preprocess}, \%data;
-
- $self->assert ($preprocessor_calls,
- "Preprocessing function never called.");
-}
-
-sub testArray {
- my ($self) = @_;
-
- my @data = ('A' .. 'Z', 'a' .. 'z');
-
- my $preprocessor_calls = 0;
- my $preprocess = sub {
- ++$preprocessor_calls;
- return reverse sort @_;
- };
-
- my $last = chr (1 + ord $data[-1]);
- my $wanted = sub {
- unless (ref $_) {
- $self->assert ($_ lt $last,
- "Array is not traversed in preprocess order.");
- $last = $_;
- }
- };
- walk { wanted => $wanted, preprocess => $preprocess}, \@data;
-
- $self->assert ($preprocessor_calls,
- "Preprocessing function never called.");
-}
-
-sub testPreprocessHash {
- my ($self) = @_;
-
- my %data = ('A' .. 'Z', 'a' .. 'z');
-
- my $preprocessor_calls = 0;
- my $preprocess = sub {
- my %container = @_;
- my @sorted;
-
- foreach my $key (sort keys %container) {
- push @sorted, $key, $container{$key};
- }
-
- ++$preprocessor_calls;
- return @sorted;
- };
-
- my $last = '';
- my $wanted = sub {
- unless (ref $_) {
- $self->assert ($_ gt $last,
- "Hash is not traversed in preprocess order.");
- $last = $_;
- }
- };
- walk { wanted => $wanted, preprocess_hash => $preprocess}, \%data;
-
- $self->assert ($preprocessor_calls,
- "Preprocessing function never called.");
-
- my @data = ('A' .. 'Z', 'a' .. 'z');
-
- $preprocessor_calls = 0;
- $preprocess = sub {
- ++$preprocessor_calls;
- };
-
- $wanted = sub {};
- walk { wanted => $wanted, preprocess_hash => $preprocess}, \@data;
-
- $self->assert (!$preprocessor_calls,
- "Preprocessing function has been called for array.");
-}
-
-1;
-
-#Local Variables:
-#mode: perl
-#perl-indent-level: 4
-#perl-continued-statement-offset: 4
-#perl-continued-brace-offset: 0
-#perl-brace-offset: -4
-#perl-brace-imaginary-offset: 0
-#perl-label-offset: -4
-#cperl-indent-level: 4
-#cperl-continued-statement-offset: 2
-#tab-width: 8
-#End:
diff --git a/t/testrunner.t b/t/testrunner.t
deleted file mode 100755
index 4e21c87..0000000
--- a/t/testrunner.t
+++ /dev/null
@@ -1,53 +0,0 @@
-#! /usr/local/bin/perl
-
-# $Id: testrunner.t,v 1.3 2006/05/11 13:56:28 guido Exp $
-
-# Unit test runner.
-# Copyright (C) 2005-2006 Guido Flohr <gu...@imperia.net>,
-# all rights reserved.
-
-# This program is free software; you can redistribute it and/or modify it
-# under the terms of the GNU Library General Public License as published
-# by the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# Library General Public License for more details.
-
-# You should have received a copy of the GNU Library General Public
-# License along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
-# USA.
-
-use strict;
-
-eval { require Test::Unit::HarnessUnit; };
-if($@) {
- my $message = "1..1\nok 1 \# skip ";
- $message .= "You must install Test::Unit in order to run the test ";
- $message .= "suite for this Perl extension. Test::Unit is available ";
- $message .= "from CPAN.";
- print $message;
- exit 0;
-}
-
-use lib 't';
-
-Test::Unit::HarnessUnit->new->start (qw (TS_All));
-
-#Local Variables:
-#mode: perl
-#perl-indent-level: 4
-#perl-continued-statement-offset: 4
-#perl-continued-brace-offset: 0
-#perl-brace-offset: -4
-#perl-brace-imaginary-offset: 0
-#perl-label-offset: -4
-#cperl-indent-level: 4
-#cperl-continued-statement-offset: 2
-#tab-width: 8
-#End:
-
-__DATA__
--
Alioth's /usr/local/bin/git-commit-notice on
/srv/git.debian.org/git/pkg-perl/packages/libdata-walk-perl.git
_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
