aDriv4 website!

Linux web1060.sh.fuk1 4.18.0-425.19.2.lve.el7h.x86_64 #1 SMP Thu Apr 6 13:40:55 UTC 2023 x86_64
Apache
127.0.0.1

File Name : Random.pm

# String::Random - Generates a random string from a pattern
# Copyright (C) 1999-2006 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.
#
# $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.25';

# 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 {
                       if ($tmp =~ /\w/) {
                           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,@list)=@_;

my($n,$foo);

$foo=new String::Random;

for ($n=0;$n<=$#list;$n++) {
        @{$foo->{$n}}=@{$list[$n]};
    }

return $foo->randpattern($pattern);
}

1;
__END__

=encoding utf8

=head1 NAME

String::Random - Perl module to generate random strings based on a pattern

=head1 SYNOPSIS

use String::Random;
    my $string_gen = String::Random->new;
    print $string_gen->randregex('\d\d\d'); # Prints 3 random digits
    # Prints 3 random printable characters
    print $string_gen->randpattern("...");

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;
    my $pass = String::Random->new;
    print "Your password is ", $pass->randpattern("CCcc!ccn"), "\n";

This would output something like this:

Your password is UDwp$tj5

B<NOTE!!!>: currently, String::Random uses Perl's built-in predictable random
number generator so the passwords generated by it are insecure.

If you are more comfortable dealing with regular expressions, the following
code would have a similar result:

use String::Random;
  my $pass = String::Random->new;
  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 Latin lowercase character [a-z]
  C        Any Latin 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:

my $gen = String::Random->new;
  $gen->{'A'} = [ 'A'..'Z', 'a'..'z' ];

I<or>

my $gen = String::Random->new;
  $gen->{'A'} = [ @{$gen->{'C'}}, @{$gen->{'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 patterns that
do not 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™ code.  (At least until somebody finds one…)

Please report bugs here:

L<https://rt.cpan.org/Public/Dist/Display.html?Name=String-Random> .

=head1 AUTHOR

Original Author: Steven Pritchard C<< steve@silug.org >>

Now maintained by: Shlomi Fish ( L<http://www.shlomifish.org/> ).

=head1 SEE ALSO

perl(1).

=cut

# vi: set ai et:

Name	Type	Size	Owner/Group	Permission	Last Modified	Actions
.	dir	-	root/root	0755	2023-08-25 11:53:17
..	dir	-	root/root	0755	2023-08-25 12:05:20
Escape.pm	text/plain	22.5 KB	root/root	0644	2010-02-01 08:09:52
Format.pm	text/plain	7.38 KB	root/root	0644	2009-05-17 10:23:07
Random.pm	text/plain	13.18 KB	root/root	0644	2014-01-15 01:45:57
RewritePrefix.pm	text/plain	2.9 KB	root/root	0644	2013-10-16 02:37:04
ShellQuote.pm	text/plain	4.03 KB	root/root	0644	2010-06-11 08:08:57

For more Private tool come to me!

https://t.me/aDriv4vz