/usr/share/perl5/Tie/Array/Sorted/Lazy.pm is in libtie-array-sorted-perl 1.41-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 | 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;
|