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