#!/usr/bin/perl
#
# $Id: randstring,v 1.2 2005/09/12 22:03:58 vogelke Exp $
#
# randstring.pl - Generates a random string from a pattern
# Copyright (C) 1998 Steven Pritchard <steve@silug.org>
# http://www.silug.org/~steve/software/scripts/perl/randstring
#
# 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.
#
# EXAMPLES:
#   me% ./randstring 'Cccnc!ss'
#   Phq7q*rV
#   
#   me% ./randstring 'Cccnc!ss'
#   Nht9g+9b
#   
#   me% ./randstring 'Cccnc!ss'
#   Jrj7x\RS

use strict;
use vars qw($foo $string $rand @upper @lower @digit @punct @any @salt);
use subs qw(seed);

use English;    # For readability
use FileHandle;
use String::Random;

$rand = new String::Random;
if (!defined($rand)) {
    print STDERR "Failed to create new object!\n";
    exit 1;
}

$string = shift;
if (!$string) {
    &usage($rand);
    exit 0;
}

seed();

print $rand->from_pattern($string), "\n";

sub usage {
    my ($rand) = @_;

    my @foo;

    print STDERR <<END;
Usage: @{ [ &basename($0) ] } <pattern>

Characters in pattern must be one of the following:

  c    Any lowercase character [@{ [ &x(join("",@{$rand->{"c"}})) ] }]
  C    Any uppercase character [@{ [ &x(join("",@{$rand->{"C"}})) ] }]
  n    Any digit [@{ [ &x(join("",@{$rand->{"n"}})) ] }]
  !    A punctuation character [@{ [ &x(join("",@{$rand->{"!"}})) ] }]
  .    Any of the above
  s    A "salt" character [@{ [ &x(join("",@{$rand->{"s"}})) ] }]

Example:
   me% randstring 'Cccnc!ss'
   Vsg6s/OP

END
}

sub x {
    my ($string) = @_;

    my $upper = join("", ('A' .. 'Z'));
    my $lower = join("", ('a' .. 'z'));
    my $digit = join("", ('0' .. '9'));

    $string =~ s/$upper/A-Z/;
    $string =~ s/$lower/a-z/;
    $string =~ s/$digit/0-9/;

    return $string;
}

sub basename {
    my ($name) = @_;
    return $name =~ /\//
      ? substr($name, (-1 * length($name)) + (rindex($name, "/") + 1))
      : $name;
}

sub seed {
    if ($OSNAME eq
        "linux")    # Should test for other systems with /dev/*random
    {

        # Read our seed from /dev/urandom
        my $urandom = new FileHandle "</dev/urandom";
        if ($urandom) {
            my ($foo, $seed);

            sysread $urandom, $foo, 4;
            $seed = unpack "L", $foo;
            srand($seed);
        }
        else {
            my @foo;

            print STDERR <<MSG;
You need to upgrade to a newer kernel or create the device /dev/urandom.
Calling srand() with no arguments will result in a @{
    [ ($PERL_VERSION < 5.004) ? "not very" : "somewhat" ]
} random seed.
MSG
            srand;
        }
    }
    elsif ( $PERL_VERSION < 5.004) # Seeding is unnecessary in newer versions.
    {

        # This was chosen very arbitrarily.  It seems
        # to generate some reasonably random numbers.
        # It should probably be tested more thoroughly.
        my $seed = ($BASETIME * $PID) ^ $BASETIME ^ 0xffffffff;

        # Gather up some entropy from the environment, hopefully.
        for (keys(%ENV)) {
            my $foo = $ENV{$_};
            $foo += 0;
            $seed = $seed ^ $foo;
        }
        srand($seed);
    }
}