r3902 - in /packages/libtie-array-sorted-perl: ./ branches/
branches/upstream/ branches/upstream/current/
branches/upstream/current/lib/ branches/upstream/current/lib/Tie/
branches/upstream/current/lib/Tie/Array/
branches/upstream/current/lib/Tie/Array/Sorted/
branches/upstream/current/t/ tags/
gwolf at users.alioth.debian.org
gwolf at users.alioth.debian.org
Fri Sep 22 16:23:52 UTC 2006
Author: gwolf
Date: Fri Sep 22 16:23:49 2006
New Revision: 3902
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=3902
Log:
[svn-inject] Installing original source of libtie-array-sorted-perl
Added:
packages/libtie-array-sorted-perl/
packages/libtie-array-sorted-perl/branches/
packages/libtie-array-sorted-perl/branches/upstream/
packages/libtie-array-sorted-perl/branches/upstream/current/
packages/libtie-array-sorted-perl/branches/upstream/current/Changes
packages/libtie-array-sorted-perl/branches/upstream/current/MANIFEST
packages/libtie-array-sorted-perl/branches/upstream/current/META.yml
packages/libtie-array-sorted-perl/branches/upstream/current/Makefile.PL
packages/libtie-array-sorted-perl/branches/upstream/current/lib/
packages/libtie-array-sorted-perl/branches/upstream/current/lib/Tie/
packages/libtie-array-sorted-perl/branches/upstream/current/lib/Tie/Array/
packages/libtie-array-sorted-perl/branches/upstream/current/lib/Tie/Array/Sorted/
packages/libtie-array-sorted-perl/branches/upstream/current/lib/Tie/Array/Sorted.pm
packages/libtie-array-sorted-perl/branches/upstream/current/lib/Tie/Array/Sorted/Lazy.pm
packages/libtie-array-sorted-perl/branches/upstream/current/t/
packages/libtie-array-sorted-perl/branches/upstream/current/t/1.t
packages/libtie-array-sorted-perl/branches/upstream/current/t/pod-coverage.t
packages/libtie-array-sorted-perl/branches/upstream/current/t/pod.t
packages/libtie-array-sorted-perl/tags/
Added: packages/libtie-array-sorted-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtie-array-sorted-perl/branches/upstream/current/Changes?rev=3902&op=file
==============================================================================
--- packages/libtie-array-sorted-perl/branches/upstream/current/Changes (added)
+++ packages/libtie-array-sorted-perl/branches/upstream/current/Changes Fri Sep 22 16:23:49 2006
@@ -1,0 +1,21 @@
+Revision history for Perl extension Tie::Array::Sorted.
+
+1.4 Sat Sep 3 20:29:42 UTC 2005
+ - Test for sort method calling object methods
+
+1.3 Sun Oct 10 11:14:41 UTC 2004
+ - Tony Bowden is now maintainer
+ - Lazy is implemented internally for speed, rather than being a
+ subclass
+
+1.2 Wed Mar 24 11:16:25 GMT 2004
+ - Add Lazy subclass
+ - Small doc fixes
+
+1.1 Wed Nov 12 17:28:39 2003
+ - Change default sort to lexical
+
+1.0 Wed Nov 12 13:38:15 2003
+ - original version; created by h2xs 1.22 with options
+ -b 5.6.0 -AX -n Tie::Array::Sorted
+
Added: packages/libtie-array-sorted-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtie-array-sorted-perl/branches/upstream/current/MANIFEST?rev=3902&op=file
==============================================================================
--- packages/libtie-array-sorted-perl/branches/upstream/current/MANIFEST (added)
+++ packages/libtie-array-sorted-perl/branches/upstream/current/MANIFEST Fri Sep 22 16:23:49 2006
@@ -1,0 +1,9 @@
+Changes
+lib/Tie/Array/Sorted.pm
+lib/Tie/Array/Sorted/Lazy.pm
+Makefile.PL
+MANIFEST
+META.yml Module meta-data (added by MakeMaker)
+t/1.t
+t/pod-coverage.t
+t/pod.t
Added: packages/libtie-array-sorted-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtie-array-sorted-perl/branches/upstream/current/META.yml?rev=3902&op=file
==============================================================================
--- packages/libtie-array-sorted-perl/branches/upstream/current/META.yml (added)
+++ packages/libtie-array-sorted-perl/branches/upstream/current/META.yml Fri Sep 22 16:23:49 2006
@@ -1,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Tie-Array-Sorted
+version: 1.4
+version_from: lib/Tie/Array/Sorted.pm
+installdirs: site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Added: packages/libtie-array-sorted-perl/branches/upstream/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtie-array-sorted-perl/branches/upstream/current/Makefile.PL?rev=3902&op=file
==============================================================================
--- packages/libtie-array-sorted-perl/branches/upstream/current/Makefile.PL (added)
+++ packages/libtie-array-sorted-perl/branches/upstream/current/Makefile.PL Fri Sep 22 16:23:49 2006
@@ -1,0 +1,10 @@
+use 5.006;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'Tie::Array::Sorted',
+ AUTHOR => 'Tony Bowden <tony at cpan.org>',
+ VERSION_FROM => 'lib/Tie/Array/Sorted.pm',
+ ABSTRACT_FROM => 'lib/Tie/Array/Sorted.pm',
+ PREREQ_PM => {},
+);
Added: packages/libtie-array-sorted-perl/branches/upstream/current/lib/Tie/Array/Sorted.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtie-array-sorted-perl/branches/upstream/current/lib/Tie/Array/Sorted.pm?rev=3902&op=file
==============================================================================
--- packages/libtie-array-sorted-perl/branches/upstream/current/lib/Tie/Array/Sorted.pm (added)
+++ packages/libtie-array-sorted-perl/branches/upstream/current/lib/Tie/Array/Sorted.pm Fri Sep 22 16:23:49 2006
@@ -1,0 +1,127 @@
+package Tie::Array::Sorted;
+
+use 5.006;
+
+use strict;
+use warnings;
+
+use base 'Tie::Array';
+
+our $VERSION = '1.4';
+
+=head1 NAME
+
+Tie::Array::Sorted - An array which is kept sorted
+
+=head1 SYNOPSIS
+
+ use Tie::Array::Sorted;
+
+ tie @a, "Tie::Array::Sorted", sub { $_[0] <=> $_[1] };
+
+ push @a, 10, 4, 7, 3, 4;
+ print "@a"; # "3 4 4 7 10"
+
+=head1 DESCRIPTION
+
+This presents an ordinary array, but is kept sorted. All pushes and
+unshifts cause the elements in question to be inserted in the
+appropriate location to maintain order.
+
+Direct stores (C<$a[10] = "wibble">) effectively splice out the original
+value and insert the new element. It's not clear why you'd want to use
+direct stores like that, but this module does the right thing if you do.
+
+If you don't like the ordinary lexical comparator, you can provide your
+own; it should compare the two elements it is given. For instance, a
+numeric comparator would look like this:
+
+ tie @a, "Tie::Array::Sorted", sub { $_[0] <=> $_[1] }
+
+Whereas to compare a list of files by their sizes, you'd so something
+like:
+
+ tie @a, "Tie::Array::Sorted", sub { -s $_[0] <=> -s $_[1] }
+
+=head1 LAZY SORTING
+
+If you do more stores than fetches, you may wish to use
+Tie::Array::Sorted::Lazy instead.
+
+=cut
+
+sub TIEARRAY {
+ my ($class, $comparator) = @_;
+ bless {
+ array => [],
+ comp => (defined $comparator ? $comparator : sub { $_[0] cmp $_[1] })
+ }, $class;
+}
+
+sub STORE {
+ my ($self, $index, $elem) = @_;
+ splice @{ $self->{array} }, $index, 0;
+ $self->PUSH($elem);
+}
+
+sub PUSH {
+ my ($self, @elems) = @_;
+ ELEM: for my $elem (@elems) {
+ my ($lo, $hi) = (0, $#{ $self->{array} });
+ while ($hi >= $lo) {
+ my $mid = int(($lo + $hi) / 2);
+ my $mid_val = $self->{array}[$mid];
+ my $cmp = $self->{comp}($elem, $mid_val);
+ if ($cmp == 0) {
+ splice(@{ $self->{array} }, $mid, 0, $elem);
+ next ELEM;
+ } elsif ($cmp > 0) {
+ $lo = $mid + 1;
+ } elsif ($cmp < 0) {
+ $hi = $mid - 1;
+ }
+ }
+ splice(@{ $self->{array} }, $lo, 0, $elem);
+ }
+}
+
+sub UNSHIFT { goto &PUSH }
+
+sub FETCHSIZE { scalar @{ $_[0]->{array} } }
+sub STORESIZE { $#{ $_[0]->{array} } = $_[1] - 1 }
+sub FETCH { $_[0]->{array}->[ $_[1] ] }
+sub CLEAR { @{ $_[0]->{array} } = () }
+sub POP { pop(@{ $_[0]->{array} }) }
+sub SHIFT { shift(@{ $_[0]->{array} }) }
+
+sub EXISTS { exists $_[0]->{array}->[ $_[1] ] }
+sub DELETE { delete $_[0]->{array}->[ $_[1] ] }
+
+1;
+
+=head1 AUTHOR
+
+Original author: Simon Cozens
+
+Current maintainer: Tony Bowden
+
+=head1 BUGS and QUERIES
+
+Please direct all correspondence regarding this module to:
+ bug-Tie-Array-Sorted at rt.cpan.org
+
+=head1 COPYRIGHT AND LICENSE
+
+ Copyright (C) 2003-2005 Tony Bowden.
+
+ This program is free software; you can redistribute it and/or modify it under
+ the terms of the GNU General Public License; either version 2 of the License,
+ 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.
+
+
+=cut
+
Added: packages/libtie-array-sorted-perl/branches/upstream/current/lib/Tie/Array/Sorted/Lazy.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtie-array-sorted-perl/branches/upstream/current/lib/Tie/Array/Sorted/Lazy.pm?rev=3902&op=file
==============================================================================
--- packages/libtie-array-sorted-perl/branches/upstream/current/lib/Tie/Array/Sorted/Lazy.pm (added)
+++ packages/libtie-array-sorted-perl/branches/upstream/current/lib/Tie/Array/Sorted/Lazy.pm Fri Sep 22 16:23:49 2006
@@ -1,0 +1,103 @@
+package Tie::Array::Sorted::Lazy;
+
+use base 'Tie::Array';
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+Tie::Array::Sorted::Lazy - An array which is kept sorted
+
+=head1 SYNOPSIS
+
+ use Tie::Array::Sorted::Lazy;
+
+ tie @a, "Tie::Array::Sorted::Lazy", sub { $_[0] <=> $_[1] };
+
+ push @a, 10, 4, 7, 3, 4;
+ print "@a"; # "3 4 4 7 10"
+
+=head1 DESCRIPTION
+
+This is a version Tie::Array::Sorted optimised for arrays which are
+stored to more often than fetching. In this case the array is resorted
+on retrieval, rather than insertion. (It only re-sorts if data has been
+modified since the last sort).
+
+ tie @a, "Tie::Array::Sorted::Lazy", sub { -s $_[0] <=> -s $_[1] };
+
+=cut
+
+sub TIEARRAY {
+ my ($class, $comparator) = @_;
+ bless {
+ array => [],
+ comp => (defined $comparator ? $comparator : sub { $_[0] cmp $_[1] })
+ }, $class;
+}
+
+sub STORE {
+ my ($self, $index, $elem) = @_;
+ splice @{ $self->{array} }, $index, 0;
+ $self->PUSH($elem);
+}
+
+sub PUSH {
+ my $self = shift;
+ $self->{dirty} = 1;
+ push @{ $self->{array} }, @_;
+}
+
+sub UNSHIFT {
+ my $self = shift;
+ $self->{dirty} = 1;
+ push @{ $self->{array} }, @_;
+}
+
+sub _fixup {
+ my $self = shift;
+ $self->{array} = [ sort { $self->{comp}->($a, $b) } @{ $self->{array} } ];
+ $self->{dirty} = 0;
+}
+
+sub FETCH {
+ $_[0]->_fixup if $_[0]->{dirty};
+ $_[0]->{array}->[ $_[1] ];
+}
+
+sub FETCHSIZE {
+ scalar @{ $_[0]->{array} }
+}
+
+sub STORESIZE {
+ $_[0]->_fixup if $_[0]->{dirty};
+ $#{ $_[0]->{array} } = $_[1] - 1;
+}
+
+sub POP {
+ $_[0]->_fixup if $_[0]->{dirty};
+ pop(@{ $_[0]->{array} });
+}
+
+sub SHIFT {
+ $_[0]->_fixup if $_[0]->{dirty};
+ shift(@{ $_[0]->{array} });
+}
+
+sub EXISTS {
+ $_[0]->_fixup if $_[0]->{dirty};
+ exists $_[0]->{array}->[ $_[1] ];
+}
+
+sub DELETE {
+ $_[0]->_fixup if $_[0]->{dirty};
+ delete $_[0]->{array}->[ $_[1] ];
+}
+
+sub CLEAR {
+ @{ $_[0]->{array} } = ()
+}
+
+1;
+
Added: packages/libtie-array-sorted-perl/branches/upstream/current/t/1.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtie-array-sorted-perl/branches/upstream/current/t/1.t?rev=3902&op=file
==============================================================================
--- packages/libtie-array-sorted-perl/branches/upstream/current/t/1.t (added)
+++ packages/libtie-array-sorted-perl/branches/upstream/current/t/1.t Fri Sep 22 16:23:49 2006
@@ -1,0 +1,64 @@
+use Test::More tests => 52;
+
+for $mod ("Tie::Array::Sorted", "Tie::Array::Sorted::Lazy") {
+ use_ok $mod;
+ my @a;
+ tie @a, $mod, sub { $_[0] <=> $_[1] };
+ @a = ();
+
+ push @a, 10;
+ is($a[0], 10, "Stored");
+ is($a[-1], 10, "Stored");
+
+ push @a, 5;
+ is($a[0], 5, "Sorted");
+ is($a[-1], 10, "Sorted");
+
+ push @a, 15;
+ is($a[0], 5, "Still sorted");
+ is($a[1], 10, "Still sorted");
+ is($a[2], 15, "Still sorted");
+
+ push @a, 12;
+ is($a[0], 5, "Sorted with 12 in there too");
+ is($a[1], 10, "Sorted with 12 in there too");
+ is($a[2], 12, "Sorted with 12 in there too");
+ is($a[3], 15, "Sorted with 12 in there too");
+
+ push @a, 10;
+ is($a[0], 5, "Sorted with duplicates");
+ is($a[1], 10, "Sorted with duplicates");
+ is($a[2], 10, "Sorted with duplicates");
+ is($a[3], 12, "Sorted with duplicates");
+ is($a[4], 15, "Sorted with duplicates");
+
+ pop @a;
+ is($a[0], 5, "Pop");
+ is($a[1], 10, "Pop");
+ is($a[2], 10, "Pop");
+ is($a[3], 12, "Pop");
+ is(@a, 4, "Pop");
+
+ push @a, 4,5,6;
+ is("@a", "4 5 5 6 10 10 12", "push");
+}
+
+{
+ tie @b, "Tie::Array::Sorted";
+ push @b, "beta"; is "@b", "beta", "default comparator";
+ push @b, "alpha"; is "@b", "alpha beta", " is text search";
+ push @b, "gamma"; is "@b", "alpha beta gamma", " and it works";
+}
+
+{
+ use Class::Struct OBJ => [ id => '$' ];
+
+ my @list;
+ tie @list, "Tie::Array::Sorted", sub { $_[0]->id <=> $_[1]->id };
+ my @obj = map OBJ->new(id => $_), 1 .. 3;
+ is @list, 0, "Start with empty list";
+ push @list, $_ for reverse @obj;
+ is @list, 3, "3 objects on list";
+ is $list[0]->id, "1", "Starts with 1";
+}
+
Added: packages/libtie-array-sorted-perl/branches/upstream/current/t/pod-coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtie-array-sorted-perl/branches/upstream/current/t/pod-coverage.t?rev=3902&op=file
==============================================================================
--- packages/libtie-array-sorted-perl/branches/upstream/current/t/pod-coverage.t (added)
+++ packages/libtie-array-sorted-perl/branches/upstream/current/t/pod-coverage.t Fri Sep 22 16:23:49 2006
@@ -1,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod::Coverage 1.00";
+plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
Added: packages/libtie-array-sorted-perl/branches/upstream/current/t/pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtie-array-sorted-perl/branches/upstream/current/t/pod.t?rev=3902&op=file
==============================================================================
--- packages/libtie-array-sorted-perl/branches/upstream/current/t/pod.t (added)
+++ packages/libtie-array-sorted-perl/branches/upstream/current/t/pod.t Fri Sep 22 16:23:49 2006
@@ -1,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
More information about the Pkg-perl-cvs-commits
mailing list