r38019 - in /branches/upstream/libstring-random-perl: ./ current/ current/lib/ current/lib/String/ current/t/
bartm at users.alioth.debian.org
bartm at users.alioth.debian.org
Thu Jun 11 18:25:35 UTC 2009
Author: bartm
Date: Thu Jun 11 18:25:29 2009
New Revision: 38019
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=38019
Log:
[svn-inject] Installing original source of libstring-random-perl
Added:
branches/upstream/libstring-random-perl/
branches/upstream/libstring-random-perl/current/
branches/upstream/libstring-random-perl/current/Build.PL (with props)
branches/upstream/libstring-random-perl/current/Changes
branches/upstream/libstring-random-perl/current/MANIFEST
branches/upstream/libstring-random-perl/current/META.yml
branches/upstream/libstring-random-perl/current/README
branches/upstream/libstring-random-perl/current/TODO
branches/upstream/libstring-random-perl/current/lib/
branches/upstream/libstring-random-perl/current/lib/String/
branches/upstream/libstring-random-perl/current/lib/String/Random.pm
branches/upstream/libstring-random-perl/current/t/
branches/upstream/libstring-random-perl/current/t/01_use.t
branches/upstream/libstring-random-perl/current/t/02_new.t
branches/upstream/libstring-random-perl/current/t/03_random_string.t
branches/upstream/libstring-random-perl/current/t/04_randpattern.t
branches/upstream/libstring-random-perl/current/t/05_randregex.t
branches/upstream/libstring-random-perl/current/t/06_random_regex.t
Added: branches/upstream/libstring-random-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libstring-random-perl/current/Build.PL?rev=38019&op=file
==============================================================================
--- branches/upstream/libstring-random-perl/current/Build.PL (added)
+++ branches/upstream/libstring-random-perl/current/Build.PL Thu Jun 11 18:25:29 2009
@@ -1,0 +1,16 @@
+use strict;
+use warnings;
+use Module::Build;
+
+my $builder = Module::Build->new(
+ module_name => 'String::Random',
+ license => 'perl',
+ dist_author => 'Steven Pritchard <steve at silug.org>',
+ requires => {
+ 'Test::More' => 0,
+ },
+);
+
+$builder->create_build_script();
+
+# vi: set ai et:
Propchange: branches/upstream/libstring-random-perl/current/Build.PL
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libstring-random-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libstring-random-perl/current/Changes?rev=38019&op=file
==============================================================================
--- branches/upstream/libstring-random-perl/current/Changes (added)
+++ branches/upstream/libstring-random-perl/current/Changes Thu Jun 11 18:25:29 2009
@@ -1,0 +1,61 @@
+Revision history for Perl extension String::Random:
+
+0.22 Thu Sep 21 2006
+- Fix README to reflect current reality.
+- Random cleanup in this file.
+- Since we've broken compatibility with *really* old Perl5 anyway,
+ modernize a bit more ("our" instead of "use vars"). Also
+ explicitly require 5.6.1.
+
+0.21 Thu Apr 20 2006
+- Modify test.pl to use Test::More.
+- Build with Module::Build.
+- Minor whitespace cleanup.
+- Avoid undefined results from randregex() and randpattern().
+- Turn on warnings in the module.
+
+0.20 Mon Sep 29 2003
+- Added support for *, +, and ? in regular expressions.
+
+0.1992 Thu Jul 25 2002
+- Added support for {n,m} ranges in regular expressions.
+- Cleaned up the initialization of @punct.
+
+0.1991 Thu Feb 28 2002
+- Added a "b" for random binary data in randpattern().
+
+0.199 Tue Feb 26 2002
+- fixed randregex() and randpattern() to Do The Right Thing(TM)
+ when called in an array or scalar context, and when passed
+ multiple arguments.
+ (* WARNING * This is an incompatible change. Code expecting the
+ behavior of earlier versions may break. Of course, the documentation
+ warned that this change would be made, and everybody reads
+ documentation, right? :-)
+- fixed use of $_ in randpattern().
+ (Unfortunately, there's still one use of $_ in a grep(), but I don't
+ see how that can be avoided, and it only happens once on
+ initialization.)
+
+0.198 Tue May 16 2000
+- fixed \W generating "_"
+- reorganized a bit to make it easier to add more patterns
+- added \s and \S
+- added two-character literals (\t, \n, \r, \f, \a, \e)
+
+0.197 Sat Jul 10 1999
+- moved most of randregex() to %regch
+- added random_regex() function interface
+
+0.195 Wed Jul 7 1999
+- regex support is (at least mostly) complete
+
+0.19 Sun Jul 4 1999
+- first pass of regex support
+
+0.1 Thu Sep 10 1998
+- original version
+
+$Id: Changes,v 1.13 2006/09/21 17:33:58 steve Exp $
+
+# vi: set ai et:
Added: branches/upstream/libstring-random-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libstring-random-perl/current/MANIFEST?rev=38019&op=file
==============================================================================
--- branches/upstream/libstring-random-perl/current/MANIFEST (added)
+++ branches/upstream/libstring-random-perl/current/MANIFEST Thu Jun 11 18:25:29 2009
@@ -1,0 +1,13 @@
+Build.PL
+Changes
+MANIFEST
+META.yml
+TODO
+README
+lib/String/Random.pm
+t/01_use.t
+t/02_new.t
+t/03_random_string.t
+t/04_randpattern.t
+t/05_randregex.t
+t/06_random_regex.t
Added: branches/upstream/libstring-random-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libstring-random-perl/current/META.yml?rev=38019&op=file
==============================================================================
--- branches/upstream/libstring-random-perl/current/META.yml (added)
+++ branches/upstream/libstring-random-perl/current/META.yml Thu Jun 11 18:25:29 2009
@@ -1,0 +1,19 @@
+---
+name: String-Random
+version: 0.22
+author:
+ - 'Steven Pritchard <steve at silug.org>'
+abstract: Perl module to generate random strings based on a pattern
+license: perl
+resources:
+ license: http://dev.perl.org/licenses/
+requires:
+ Test::More: 0
+provides:
+ String::Random:
+ file: lib/String/Random.pm
+ version: 0.22
+generated_by: Module::Build version 0.2805
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
Added: branches/upstream/libstring-random-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libstring-random-perl/current/README?rev=38019&op=file
==============================================================================
--- branches/upstream/libstring-random-perl/current/README (added)
+++ branches/upstream/libstring-random-perl/current/README Thu Jun 11 18:25:29 2009
@@ -1,0 +1,29 @@
+String::Random is used to generate random strings. It was written to
+make generating random passwords and such a little easier. See the
+documentation in pod format in the module for more information.
+
+String::Random now requires Module::Build to build and install.
+To install the module, simply do the following:
+
+ perl Build.PL
+ ./Build
+ ./Build test
+ ./Build install
+
+This module requires Perl5. Any version newer than 5.6.0 should work,
+but it has only been tested on recent versions. Version 0.20 and
+earlier of this module should work with any Perl5 release. You can
+find older releases on backpan:
+
+ http://backpan.cpan.org/authors/id/S/ST/STEVE/
+
+ ****** PLEASE NOTE ******
+
+This module is still somewhat experimental. I'm trying to determine
+exactly what the feature set of the module should be. Please send
+suggestions, bug reports, comments, etc. to the author, Steven
+Pritchard <steve at silug.org>.
+
+Copyright (C) 1999-2006 Steven Pritchard <steve at silug.org>
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
Added: branches/upstream/libstring-random-perl/current/TODO
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libstring-random-perl/current/TODO?rev=38019&op=file
==============================================================================
--- branches/upstream/libstring-random-perl/current/TODO (added)
+++ branches/upstream/libstring-random-perl/current/TODO Thu Jun 11 18:25:29 2009
@@ -1,0 +1,6 @@
+FEATURES:
+* (foo|bar) should be doable.
+* Generally make some attempt to implement everything documented in
+ perlre(1), or at least carp() that we aren't doing the right thing.
+* Allow . to mean binary data in regular expressions (maybe with a flag
+ to new()).
Added: branches/upstream/libstring-random-perl/current/lib/String/Random.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libstring-random-perl/current/lib/String/Random.pm?rev=38019&op=file
==============================================================================
--- branches/upstream/libstring-random-perl/current/lib/String/Random.pm (added)
+++ branches/upstream/libstring-random-perl/current/lib/String/Random.pm Thu Jun 11 18:25:29 2009
@@ -1,0 +1,439 @@
+# String::Random - Generates a random string from a pattern
+# Copyright (C) 1999-2006 Steven Pritchard <steve at silug.org>
+#
+# 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.
+#
+# $Id: Random.pm,v 1.4 2006/09/21 17:34:07 steve Exp $
+
+package String::Random;
+
+require 5.006_001;
+
+use strict;
+use warnings;
+
+use Carp;
+use Exporter ();
+
+our @ISA = qw(Exporter);
+our %EXPORT_TAGS = ( 'all' => [ qw(
+ &random_string
+ &random_regex
+) ] );
+our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+our @EXPORT = ();
+our $VERSION = '0.22';
+
+# These are the various character sets.
+our @upper=("A".."Z");
+our @lower=("a".."z");
+our @digit=("0".."9");
+our @punct=map { chr($_); } (33..47,58..64,91..96,123..126);
+our @any=(@upper, @lower, @digit, @punct);
+our @salt=(@upper, @lower, @digit, ".", "/");
+our @binary=map { chr($_) } (0..255);
+
+# What's important is how they relate to the pattern characters.
+# These are the old patterns for randpattern/random_string.
+our %old_patterns = (
+ 'C' => [ @upper ],
+ 'c' => [ @lower ],
+ 'n' => [ @digit ],
+ '!' => [ @punct ],
+ '.' => [ @any ],
+ 's' => [ @salt ],
+ 'b' => [ @binary ],
+);
+
+# These are the regex-based patterns.
+our %patterns = (
+ # These are the regex-equivalents.
+ '.' => [ @any ],
+ '\d' => [ @digit ],
+ '\D' => [ @upper, @lower, @punct ],
+ '\w' => [ @upper, @lower, @digit, "_" ],
+ '\W' => [ grep { $_ ne "_" } @punct ],
+ '\s' => [ " ", "\t" ], # Would anything else make sense?
+ '\S' => [ @upper, @lower, @digit, @punct ],
+
+ # These are translated to their double quoted equivalents.
+ '\t' => [ "\t" ],
+ '\n' => [ "\n" ],
+ '\r' => [ "\r" ],
+ '\f' => [ "\f" ],
+ '\a' => [ "\a" ],
+ '\e' => [ "\e" ],
+);
+
+# These characters are treated specially in randregex().
+our %regch = (
+ "\\" => sub {
+ my ($self, $ch, $chars, $string)=@_;
+ if (@{$chars}) {
+ my $tmp=shift(@{$chars});
+ if ($tmp eq "x") {
+ # This is supposed to be a number in hex, so
+ # there had better be at least 2 characters left.
+ $tmp=shift(@{$chars}) . shift(@{$chars});
+ push(@{$string}, [chr(hex($tmp))]);
+ } elsif ($tmp=~/[0-7]/) {
+ carp "octal parsing not implemented. treating literally.";
+ push(@{$string}, [$tmp]);
+ } elsif (defined($patterns{"\\$tmp"})) {
+ $ch.=$tmp;
+ push(@{$string}, $patterns{$ch});
+ } else {
+ carp "'\\$tmp' being treated as literal '$tmp'";
+ push(@{$string}, [$tmp]);
+ }
+ } else {
+ croak "regex not terminated";
+ }
+ },
+ '.' => sub {
+ my ($self, $ch, $chars, $string)=@_;
+ push(@{$string}, $patterns{$ch});
+ },
+ '[' => sub {
+ my ($self, $ch, $chars, $string)=@_;
+ my @tmp;
+ while (defined($ch=shift(@{$chars})) && ($ch ne "]")) {
+ if (($ch eq "-") && @{$chars} && @tmp) {
+ $ch=shift(@{$chars});
+ for (my $n=ord($tmp[$#tmp]);$n<ord($ch);$n++) {
+ push(@tmp, chr($n+1));
+ }
+ } else {
+ carp "'$ch' will be treated literally inside []"
+ if ($ch=~/\W/);
+ push(@tmp, $ch);
+ }
+ }
+ croak "unmatched []" if ($ch ne "]");
+ push(@{$string}, \@tmp);
+ },
+ '*' => sub {
+ my ($self, $ch, $chars, $string)=@_;
+ unshift(@{$chars}, split("", "{0,}"));
+ },
+ '+' => sub {
+ my ($self, $ch, $chars, $string)=@_;
+ unshift(@{$chars}, split("", "{1,}"));
+ },
+ '?' => sub {
+ my ($self, $ch, $chars, $string)=@_;
+ unshift(@{$chars}, split("", "{0,1}"));
+ },
+ '{' => sub {
+ my ($self, $ch, $chars, $string)=@_;
+ my ($n, $closed);
+ for ($n=0;$n<scalar(@{$chars});$n++) {
+ if ($chars->[$n] eq "}") {
+ $closed++;
+ last;
+ }
+ }
+ if ($closed) {
+ my $tmp;
+ while (defined($ch=shift(@{$chars})) && ($ch ne "}")) {
+ croak "'$ch' inside {} not supported" if ($ch!~/[\d,]/);
+ $tmp.=$ch;
+ }
+ if ($tmp=~/,/) {
+ if (my ($min,$max) = $tmp =~ /^(\d*),(\d*)$/) {
+ $min = 0 if (!length($min));
+ $max = $self->{'_max'} if (!length($max));
+ croak "bad range {$tmp}" if ($min>$max);
+ if ($min == $max) {
+ $tmp = $min;
+ } else {
+ $tmp = $min + int(rand($max - $min +1));
+ }
+ } else {
+ croak "malformed range {$tmp}";
+ }
+ }
+ if ($tmp) {
+ my $last=$string->[$#{$string}];
+ for ($n=0;$n<($tmp-1);$n++) {
+ push(@{$string}, $last);
+ }
+ } else {
+ pop(@{$string});
+ }
+ } else {
+ # { isn't closed, so treat it literally.
+ push(@{$string}, [$ch]);
+ }
+ },
+);
+
+sub new {
+ my $proto=shift;
+ my $class=ref($proto) || $proto;
+ my $self;
+ $self={ %old_patterns }; # makes $self refer to a copy of %old_patterns
+ my %args=();
+ %args=@_ if (@_);
+ if (defined($args{'max'})) {
+ $self->{'_max'}=$args{'max'};
+ } else {
+ $self->{'_max'}=10;
+ }
+ return bless($self, $class);
+}
+
+# Returns a random string for each regular expression given as an
+# argument, or the strings concatenated when used in a scalar context.
+sub randregex {
+ my $self=shift;
+ croak "called without a reference" if (!ref($self));
+
+ my @strings=();
+
+ while (defined(my $pattern=shift)) {
+ my $ch;
+ my @string=();
+ my $string='';
+
+ # Split the characters in the pattern
+ # up into a list for easier parsing.
+ my @chars=split(//, $pattern);
+
+ while (defined($ch=shift(@chars))) {
+ if (defined($regch{$ch})) {
+ $regch{$ch}->($self, $ch, \@chars, \@string);
+ } elsif ($ch=~/[\$\^\*\(\)\+\{\}\]\|\?]/) {
+ # At least some of these probably should have special meaning.
+ carp "'$ch' not implemented. treating literally.";
+ push(@string, [$ch]);
+ } else {
+ push(@string, [$ch]);
+ }
+ }
+
+ foreach $ch (@string) {
+ $string.=$ch->[int(rand(scalar(@{$ch})))];
+ }
+
+ push(@strings, $string);
+ }
+
+ return wantarray ? @strings : join("", @strings);
+}
+
+# For compatibility with an ancient version, please ignore...
+sub from_pattern {
+ my $self=shift;
+ croak "called without a reference" if (!ref($self));
+
+ return $self->randpattern(@_);
+}
+
+sub randpattern {
+ my $self=shift;
+ croak "called without a reference" if (!ref($self));
+
+ my @strings=();
+
+ while (defined(my $pattern=shift)) {
+ my $string='';
+
+ for my $ch (split(//, $pattern)) {
+ if (defined($self->{$ch})) {
+ $string.=$self->{$ch}->[int(rand(scalar(@{$self->{$ch}})))];
+ } else {
+ croak qq(Unknown pattern character "$ch"!);
+ }
+ }
+ push(@strings, $string);
+ }
+
+ return wantarray ? @strings : join("", @strings);
+}
+
+sub random_regex {
+ my $foo=new String::Random;
+ return $foo->randregex(@_);
+}
+
+sub random_string {
+ my($pattern, at list)=@_;
+
+ my($n,$foo);
+
+ $foo=new String::Random;
+
+ for ($n=0;$n<=$#list;$n++) {
+ @{$foo->{$n}}=@{$list[$n]};
+ }
+
+ return $foo->randpattern($pattern);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+String::Random - Perl module to generate random strings based on a pattern
+
+=head1 SYNOPSIS
+
+ use String::Random;
+ $foo = new String::Random;
+ print $foo->randregex('\d\d\d'); # Prints 3 random digits
+ print $foo->randpattern("..."); # Prints 3 random printable characters
+
+I<or>
+
+ use String::Random qw(random_regex random_string);
+ print random_regex('\d\d\d'); # Also prints 3 random digits
+ print random_string("..."); # Also prints 3 random printable characters
+
+=head1 DESCRIPTION
+
+This module makes it trivial to generate random strings.
+
+As an example, let's say you are writing a script that needs to generate a
+random password for a user. The relevant code might look something like
+this:
+
+ use String::Random;
+ $pass = new String::Random;
+ print "Your password is ", $pass->randpattern("CCcc!ccn"), "\n";
+
+This would output something like this:
+
+ Your password is UDwp$tj5
+
+If you are more comfortable dealing with regular expressions, the following
+code would have a similar result:
+
+ use String::Random;
+ $pass = new String::Random;
+ print "Your password is ",
+ $pass->randregex('[A-Z]{2}[a-z]{2}.[a-z]{2}\d'), "\n";
+
+=head2 Patterns
+
+The pre-defined patterns (for use with C<randpattern()> and C<random_pattern()>)
+are as follows:
+
+ c Any lowercase character [a-z]
+ C Any uppercase character [A-Z]
+ n Any digit [0-9]
+ ! A punctuation character [~`!@$%^&*()-_+={}[]|\:;"'.<>?/#,]
+ . Any of the above
+ s A "salt" character [A-Za-z0-9./]
+ b Any binary data
+
+These can be modified, but if you need a different pattern it is better to
+create another pattern, possibly using one of the pre-defined as a base.
+For example, if you wanted a pattern C<A> that contained all upper and lower
+case letters (C<[A-Za-z]>), the following would work:
+
+ $foo = new String::Random;
+ $foo->{'A'} = [ 'A'..'Z', 'a'..'z' ];
+
+I<or>
+
+ $foo = new String::Random;
+ $foo->{'A'} = [ @{$foo->{'C'}}, @{$foo->{'c'}} ];
+
+The random_string function, described below, has an alternative interface
+for adding patterns.
+
+=head2 Methods
+
+=over 8
+
+=item new
+
+=item new max =E<gt> I<number>
+
+Create a new String::Random object.
+
+Optionally a parameter C<max> can be included to specify the maximum number
+of characters to return for C<*> and other regular expression patters that
+don't return a fixed number of characters.
+
+=item randpattern LIST
+
+The randpattern method returns a random string based on the concatenation
+of all the pattern strings in the list.
+
+It will return a list of random strings corresponding to the pattern
+strings when used in list context.
+
+=item randregex LIST
+
+The randregex method returns a random string that will match the regular
+expression passed in the list argument.
+
+Please note that the arguments to randregex are not real regular
+expressions. Only a small subset of regular expression syntax is actually
+supported. So far, the following regular expression elements are
+supported:
+
+ \w Alphanumeric + "_".
+ \d Digits.
+ \W Printable characters other than those in \w.
+ \D Printable characters other than those in \d.
+ . Printable characters.
+ [] Character classes.
+ {} Repetition.
+ * Same as {0,}.
+ ? Same as {0,1}.
+ + Same as {1,}.
+
+Regular expression support is still somewhat incomplete. Currently special
+characters inside [] are not supported (with the exception of "-" to denote
+ranges of characters). The parser doesn't care for spaces in the "regular
+expression" either.
+
+=back
+
+=head2 Functions
+
+=over 8
+
+=item random_string PATTERN,LIST
+
+=item random_string PATTERN
+
+When called with a single scalar argument, random_string returns a random
+string using that scalar as a pattern. Optionally, references to lists
+containing other patterns can be passed to the function. Those lists will
+be used for 0 through 9 in the pattern (meaning the maximum number of lists
+that can be passed is 10). For example, the following code:
+
+ print random_string("0101",
+ ["a", "b", "c"],
+ ["d", "e", "f"]), "\n";
+
+would print something like this:
+
+ cebd
+
+=back
+
+=head1 BUGS
+
+This is Bug Free(TM) code. (At least until somebody finds one...)
+
+=head1 AUTHOR
+
+Steven Pritchard <steve at silug.org>
+
+=head1 SEE ALSO
+
+perl(1).
+
+=cut
+# vi: set ai et:
Added: branches/upstream/libstring-random-perl/current/t/01_use.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libstring-random-perl/current/t/01_use.t?rev=38019&op=file
==============================================================================
--- branches/upstream/libstring-random-perl/current/t/01_use.t (added)
+++ branches/upstream/libstring-random-perl/current/t/01_use.t Thu Jun 11 18:25:29 2009
@@ -1,0 +1,9 @@
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+# 1: Make sure we can load the module
+BEGIN { use_ok('String::Random'); }
+
+# vi: set ai et syntax=perl:
Added: branches/upstream/libstring-random-perl/current/t/02_new.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libstring-random-perl/current/t/02_new.t?rev=38019&op=file
==============================================================================
--- branches/upstream/libstring-random-perl/current/t/02_new.t (added)
+++ branches/upstream/libstring-random-perl/current/t/02_new.t Thu Jun 11 18:25:29 2009
@@ -1,0 +1,13 @@
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+
+# 1: Make sure we can load the module
+BEGIN { use_ok('String::Random'); }
+
+# 2: Make sure we can create a new object
+my $foo=new String::Random;
+ok(defined($foo), "new()");
+
+# vi: set ai et syntax=perl:
Added: branches/upstream/libstring-random-perl/current/t/03_random_string.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libstring-random-perl/current/t/03_random_string.t?rev=38019&op=file
==============================================================================
--- branches/upstream/libstring-random-perl/current/t/03_random_string.t (added)
+++ branches/upstream/libstring-random-perl/current/t/03_random_string.t Thu Jun 11 18:25:29 2009
@@ -1,0 +1,20 @@
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+
+# 1: Make sure we can load the module
+BEGIN { use_ok('String::Random', ':all'); }
+
+# 2: Make sure we can create a new object
+my $foo=new String::Random;
+ok(defined($foo), "new()");
+
+# 3: Test function interface to randpattern()
+my $abc=random_string("012", ['a'], ['b'], ['c']);
+is($abc, 'abc', "random_string()");
+
+# 4: Make sure the function didn't pollute $foo
+ok(!defined($foo->{'0'}), "pollute object");
+
+# vi: set ai et syntax=perl:
Added: branches/upstream/libstring-random-perl/current/t/04_randpattern.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libstring-random-perl/current/t/04_randpattern.t?rev=38019&op=file
==============================================================================
--- branches/upstream/libstring-random-perl/current/t/04_randpattern.t (added)
+++ branches/upstream/libstring-random-perl/current/t/04_randpattern.t Thu Jun 11 18:25:29 2009
@@ -1,0 +1,56 @@
+use strict;
+use warnings;
+
+use Test::More tests => 37;
+
+# 1: Make sure we can load the module
+BEGIN { use_ok('String::Random'); }
+
+# 2: Make sure we can create a new object
+my $foo=new String::Random;
+my $bar=String::Random->new();
+ok(defined($foo) && defined($bar), "new()");
+
+# 3: Empty pattern shouldn't give undef for result
+ok(my @notempty=$foo->randpattern(''), "randpattern('')");
+
+# Try the object method...
+$foo->{'x'}=['a'];
+$foo->{'y'}=['b'];
+$foo->{'z'}=['c'];
+
+# 4: passing a scalar, in a scalar context
+my $abc=$foo->randpattern("xyz");
+is($abc, 'abc', "randpattern()");
+
+# 5: passing an array, in a scalar context
+my @foo=qw(x y z);
+$abc=$foo->randpattern(@foo);
+is($abc, 'abc', "randpattern() (scalar)");
+
+# 6-8: passing an array, in an array context
+my @bar=$foo->randpattern(@foo);
+for (my $n=0;$n<@foo;$n++) {
+ is($bar[$n], $foo->{$foo[$n]}->[0], "randpattern() (array) ($n)");
+}
+
+# 9-34: Check one of the built-in patterns to make
+# sure it contains what we think it should
+my @upcase=("A".."Z");
+for (my $n=0;$n<26;$n++) {
+ ok(defined($foo->{'C'}->[$n]) && ($upcase[$n] eq $foo->{'C'}->[$n]),
+ "pattern ($n)");
+}
+
+# 35: Test modifying one of the built-in patterns
+$foo->{'C'}=['n'];
+is($foo->randpattern("C"), "n", "modify patterns");
+
+# 36: Make sure we haven't clobbered anything in an existing object
+isnt($bar->randpattern("C"), "n", "pollute pattern");
+
+# 37: Make sure we haven't clobbered anything in a new object
+my $baz=new String::Random;
+ok(defined($baz) && ($baz->randpattern("C") ne "n"), "pollute new object");
+
+# vi: set ai et syntax=perl:
Added: branches/upstream/libstring-random-perl/current/t/05_randregex.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libstring-random-perl/current/t/05_randregex.t?rev=38019&op=file
==============================================================================
--- branches/upstream/libstring-random-perl/current/t/05_randregex.t (added)
+++ branches/upstream/libstring-random-perl/current/t/05_randregex.t Thu Jun 11 18:25:29 2009
@@ -1,0 +1,56 @@
+use strict;
+use warnings;
+
+use vars qw(@patterns);
+
+BEGIN {
+ @patterns=(
+ '\d\d\d',
+ '\w\w\w',
+ '[ABC][abc]',
+ '[012][345]',
+ '...',
+ '[a-z][0-9]',
+ '[aw-zX][123]',
+ '[a-z]{5}',
+ '0{80}',
+ '[a-f][nprt]\d{3}',
+ '\t\n\r\f\a\e',
+ '\S\S\S',
+ '\s\s\s',
+ '\w{5,10}',
+ '\w?',
+ '\w+',
+ '\w*',
+ '',
+ );
+}
+
+use Test::More tests => (3 * @patterns + 3);
+
+# 1: Make sure we can load the module
+BEGIN { use_ok('String::Random'); }
+
+# 2: Make sure we can create a new object
+my $foo=new String::Random;
+ok(defined($foo), "new()");
+
+# Test regex support
+for (@patterns) {
+ my $ret=$foo->randregex($_);
+ ok($ret =~ /^$_$/, "randregex('$_')")
+ or diag "'$_' failed, '$ret' does not match.\n";
+}
+
+# Test regex support, but this time pass an array.
+my @ret=$foo->randregex(@patterns);
+is(@ret, @patterns, "randregex() return")
+ or diag "randregex() returned a different array size!";
+
+for (my $n=0;$n<@patterns;$n++) {
+ ok(defined($ret[$n]), "defined randregex('$patterns[$n]')");
+ ok($ret[$n] =~ /^$patterns[$n]$/, "randregex('$patterns[$n]')")
+ or diag "'$patterns[$n]' failed, '$ret[$n]' does not match.\n";
+}
+
+# vi: set ai et syntax=perl:
Added: branches/upstream/libstring-random-perl/current/t/06_random_regex.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libstring-random-perl/current/t/06_random_regex.t?rev=38019&op=file
==============================================================================
--- branches/upstream/libstring-random-perl/current/t/06_random_regex.t (added)
+++ branches/upstream/libstring-random-perl/current/t/06_random_regex.t Thu Jun 11 18:25:29 2009
@@ -1,0 +1,55 @@
+use strict;
+use warnings;
+
+use vars qw(@patterns);
+
+BEGIN {
+ @patterns=(
+ '\d\d\d',
+ '\w\w\w',
+ '[ABC][abc]',
+ '[012][345]',
+ '...',
+ '[a-z][0-9]',
+ '[aw-zX][123]',
+ '[a-z]{5}',
+ '0{80}',
+ '[a-f][nprt]\d{3}',
+ '\t\n\r\f\a\e',
+ '\S\S\S',
+ '\s\s\s',
+ '\w{5,10}',
+ '\w?',
+ '\w+',
+ '\w*',
+ '',
+ );
+}
+
+use Test::More tests => (3 * @patterns + 3);
+
+# 1: Make sure we can load the module
+BEGIN { use_ok('String::Random'); }
+
+# 2: Test function interface to randregex()
+is(String::Random::random_regex("[a][b][c]"), "abc", "random_regex()");
+
+# Test regex support
+for (@patterns) {
+ my $ret=String::Random::random_regex($_);
+ ok($ret =~ /^$_$/, "random_regex('$_')")
+ or diag "'$_' failed, '$ret' does not match.\n";
+}
+
+# Test random_regex, this time passing an array.
+my @ret=String::Random::random_regex(@patterns);
+is(@ret, @patterns, "random_regex() return")
+ or diag "random_regex() returned a different array size!";
+
+for (my $n=0;$n<@patterns;$n++) {
+ ok(defined($ret[$n]), "defined random_regex('$patterns[$n]')");
+ ok($ret[$n] =~ /^$patterns[$n]$/, "random_regex('$patterns[$n]')")
+ or diag "'$patterns[$n]' failed, '$ret[$n]' does not match.\n";
+}
+
+# vi: set ai et syntax=perl:
More information about the Pkg-perl-cvs-commits
mailing list