#!/usr/bin/perl
#
# randstring.pl - Generates a random string from a pattern
# Copyright (C) 1998 Steven Pritchard <steve@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.

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

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"}})) ] }]

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 not necessary 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);
    }
}