diff options
Diffstat (limited to 't/bundled')
| -rw-r--r-- | t/bundled/Software/License.pm | 56 | ||||
| -rw-r--r-- | t/bundled/Tie/CPHash.pm | 194 |
2 files changed, 250 insertions, 0 deletions
diff --git a/t/bundled/Software/License.pm b/t/bundled/Software/License.pm new file mode 100644 index 0000000..6457ab6 --- /dev/null +++ b/t/bundled/Software/License.pm @@ -0,0 +1,56 @@ +# Modified from the original as a "mock" version for testing +use strict; +use warnings; +use 5.006; # warnings +package Software::License; +our $VERSION = 9999; + +sub new { + my ($class, $arg) = @_; + + # XXX changed from Carp::croak to die + die "no copyright holder specified" unless $arg->{holder}; + + bless $arg => $class; +} + + +sub year { defined $_[0]->{year} ? $_[0]->{year} : (localtime)[5]+1900 } +sub holder { $_[0]->{holder} } + +sub version { + my ($self) = @_; + my $pkg = ref $self ? ref $self : $self; + $pkg =~ s/.+:://; + my (undef, @vparts) = split /_/, $pkg; + + return unless @vparts; + return join '.', @vparts; +} + + +# sub meta1_name { return undef; } # sort this out later, should be easy +sub meta_name { return undef; } +sub meta_yml_name { $_[0]->meta_name } + +sub meta2_name { + my ($self) = @_; + my $meta1 = $self->meta_name; + + return undef unless defined $meta1; + + return $meta1 + if $meta1 =~ /\A(?:open_source|restricted|unrestricted|unknown)\z/; + + return undef; +} + +# XXX these are trivial mocks of the real thing +sub notice { 'NOTICE' } +sub license { 'LICENSE' } +sub fulltext { 'FULLTEXT' } + +1; + + + diff --git a/t/bundled/Tie/CPHash.pm b/t/bundled/Tie/CPHash.pm new file mode 100644 index 0000000..b167622 --- /dev/null +++ b/t/bundled/Tie/CPHash.pm @@ -0,0 +1,194 @@ +#--------------------------------------------------------------------- +package Tie::CPHash; +# +# Copyright 1997 Christopher J. Madsen +# +# Author: Christopher J. Madsen <cjm@pobox.com> +# Created: 08 Nov 1997 +# $Revision$ $Date$ +# +# This program is free software; you can redistribute it and/or modify +# it under the same terms as Perl itself. +# +# 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 either the +# GNU General Public License or the Artistic License for more details. +# +# Case preserving but case insensitive hash +#--------------------------------------------------------------------- + +require 5.000; +use strict; +use vars qw(@ISA $VERSION); + +@ISA = qw(); + +#===================================================================== +# Package Global Variables: + +$VERSION = '1.02'; + +#===================================================================== +# Tied Methods: +#--------------------------------------------------------------------- +# TIEHASH classname +# The method invoked by the command `tie %hash, classname'. +# Associates a new hash instance with the specified class. + +sub TIEHASH +{ + bless {}, $_[0]; +} # end TIEHASH + +#--------------------------------------------------------------------- +# STORE this, key, value +# Store datum *value* into *key* for the tied hash *this*. + +sub STORE +{ + $_[0]->{lc $_[1]} = [ $_[1], $_[2] ]; +} # end STORE + +#--------------------------------------------------------------------- +# FETCH this, key +# Retrieve the datum in *key* for the tied hash *this*. + +sub FETCH +{ + my $v = $_[0]->{lc $_[1]}; + ($v ? $v->[1] : undef); +} # end FETCH + +#--------------------------------------------------------------------- +# FIRSTKEY this +# Return the (key, value) pair for the first key in the hash. + +sub FIRSTKEY +{ + my $a = scalar keys %{$_[0]}; + &NEXTKEY; +} # end FIRSTKEY + +#--------------------------------------------------------------------- +# NEXTKEY this, lastkey +# Return the next (key, value) pair for the hash. + +sub NEXTKEY +{ + my $v = (each %{$_[0]})[1]; + ($v ? $v->[0] : undef ); +} # end NEXTKEY + +#--------------------------------------------------------------------- +# SCALAR this +# Return bucket usage information for the hash (0 if empty). + +sub SCALAR +{ + scalar %{$_[0]}; +} # end SCALAR + +#--------------------------------------------------------------------- +# EXISTS this, key +# Verify that *key* exists with the tied hash *this*. + +sub EXISTS +{ + exists $_[0]->{lc $_[1]}; +} # end EXISTS + +#--------------------------------------------------------------------- +# DELETE this, key +# Delete the key *key* from the tied hash *this*. +# Returns the old value, or undef if it didn't exist. + +sub DELETE +{ + my $v = delete $_[0]->{lc $_[1]}; + ($v ? $v->[1] : undef); +} # end DELETE + +#--------------------------------------------------------------------- +# CLEAR this +# Clear all values from the tied hash *this*. + +sub CLEAR +{ + %{$_[0]} = (); +} # end CLEAR + +#===================================================================== +# Other Methods: +#--------------------------------------------------------------------- +# Return the case of KEY. + +sub key +{ + my $v = $_[0]->{lc $_[1]}; + ($v ? $v->[0] : undef); +} + +#===================================================================== +# Package Return Value: + +1; + +__END__ + +=head1 NAME + +Tie::CPHash - Case preserving but case insensitive hash table + +=head1 SYNOPSIS + + require Tie::CPHash; + tie %cphash, 'Tie::CPHash'; + + $cphash{'Hello World'} = 'Hi there!'; + printf("The key `%s' was used to store `%s'.\n", + tied(%cphash)->key('HELLO WORLD'), + $cphash{'HELLO world'}); + +=head1 DESCRIPTION + +The B<Tie::CPHash> module provides a hash table that is case +preserving but case insensitive. This means that + + $cphash{KEY} $cphash{key} + $cphash{Key} $cphash{keY} + +all refer to the same entry. Also, the hash remembers which form of +the key was last used to store the entry. The C<keys> and C<each> +functions will return the key that was used to set the value. + +An example should make this clear: + + tie %h, 'Tie::CPHash'; + $h{Hello} = 'World'; + print $h{HELLO}; # Prints 'World' + print keys(%h); # Prints 'Hello' + $h{HELLO} = 'WORLD'; + print $h{hello}; # Prints 'WORLD' + print keys(%h); # Prints 'HELLO' + +The additional C<key> method lets you fetch the case of a specific key: + + # When run after the previous example, this prints 'HELLO': + print tied(%h)->key('Hello'); + +(The C<tied> function returns the object that C<%h> is tied to.) + +If you need a case insensitive hash, but don't need to preserve case, +just use C<$hash{lc $key}> instead of C<$hash{$key}>. This has a lot +less overhead than B<Tie::CPHash>. + +=head1 AUTHOR + +Christopher J. Madsen E<lt>F<cjm@pobox.com>E<gt> + +=cut + +# Local Variables: +# tmtrack-file-task: "Tie::CPHash.pm" +# End: |