| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package String::PerlIdentifier; | 
| 2 | 6 |  |  | 6 |  | 154015 | use 5.006001; | 
|  | 6 |  |  |  |  | 24 |  | 
| 3 | 6 |  |  | 6 |  | 35 | use strict; | 
|  | 6 |  |  |  |  | 10 |  | 
|  | 6 |  |  |  |  | 192 |  | 
| 4 | 6 |  |  | 6 |  | 27 | use base qw(Exporter); | 
|  | 6 |  |  |  |  | 16 |  | 
|  | 6 |  |  |  |  | 1108 |  | 
| 5 |  |  |  |  |  |  | our @EXPORT = qw{ make_varname }; | 
| 6 |  |  |  |  |  |  | our $VERSION = "0.06"; | 
| 7 | 6 |  |  | 6 |  | 37 | use Carp; | 
|  | 6 |  |  |  |  | 17 |  | 
|  | 6 |  |  |  |  | 5740 |  | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | our @lower =  qw(a b c d e f g h i j k l m n o p q r s t u v w x y z); | 
| 10 |  |  |  |  |  |  | our @upper = map { uc($_) } @lower; | 
| 11 |  |  |  |  |  |  | our @alphas = (@upper, @lower); | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | our %forbidden = (); | 
| 14 |  |  |  |  |  |  | our $MIN = 3; | 
| 15 |  |  |  |  |  |  | our $MAX = 20; | 
| 16 |  |  |  |  |  |  | our $DEFAULT = 10; | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | sub make_varname { | 
| 19 | 103 |  |  | 103 | 0 | 133827 | my $length; | 
| 20 | 103 |  |  |  |  | 168 | my (@eligibles, @chars); | 
| 21 | 103 |  |  |  |  | 142 | my $scoresflag = 1; | 
| 22 | 103 | 100 | 100 |  |  | 768 | if (defined $_[0] and ref($_[0]) eq 'HASH') { | 
| 23 | 75 |  |  |  |  | 96 | my $argsref = shift; | 
| 24 | 75 | 100 | 66 |  |  | 264 | if ( (defined $argsref->{underscores}) && | 
| 25 |  |  |  |  |  |  | ($argsref->{underscores} == 0) ) { | 
| 26 | 10 |  |  |  |  | 17 | $scoresflag = 0; | 
| 27 |  |  |  |  |  |  | } | 
| 28 | 75 | 100 |  |  |  | 167 | if (defined $argsref->{min}) { | 
| 29 |  |  |  |  |  |  | croak "Minimum must be all numerals: $!" | 
| 30 | 14 | 100 |  |  |  | 376 | unless $argsref->{min} =~ /^\d+$/; | 
| 31 |  |  |  |  |  |  | croak "Cannot set minimum length less than 2: $!" | 
| 32 | 13 | 100 |  |  |  | 180 | unless $argsref->{min} >= 2; | 
| 33 | 12 |  |  |  |  | 25 | $MIN = $argsref->{min}; | 
| 34 |  |  |  |  |  |  | } | 
| 35 | 73 | 100 |  |  |  | 164 | if (defined $argsref->{max}) { | 
| 36 |  |  |  |  |  |  | croak "Maximum must be all numerals: $!" | 
| 37 | 34 | 100 |  |  |  | 503 | unless $argsref->{max} =~ /^\d+$/; | 
| 38 |  |  |  |  |  |  | croak "Cannot set maximum length less than 3: $!" | 
| 39 | 33 | 100 |  |  |  | 248 | unless $argsref->{max} >= 3; | 
| 40 | 32 |  |  |  |  | 45 | $MAX = $argsref->{max}; | 
| 41 |  |  |  |  |  |  | } | 
| 42 | 71 | 100 |  |  |  | 156 | if (defined $argsref->{default}) { | 
| 43 |  |  |  |  |  |  | croak "Default must be all numerals: $!" | 
| 44 | 24 | 100 |  |  |  | 443 | unless $argsref->{default} =~ /^\d+$/; | 
| 45 | 23 |  |  |  |  | 42 | $DEFAULT = $argsref->{default}; | 
| 46 |  |  |  |  |  |  | } | 
| 47 | 70 | 100 | 100 |  |  | 246 | if ( (defined $argsref->{min}) && | 
| 48 |  |  |  |  |  |  | (defined $argsref->{max}) ) { | 
| 49 |  |  |  |  |  |  | croak "Minimum must be <= Maximum: $!" | 
| 50 | 4 | 100 |  |  |  | 288 | if $argsref->{min} >= $argsref->{max}; | 
| 51 |  |  |  |  |  |  | } | 
| 52 |  |  |  |  |  |  | } else { | 
| 53 | 28 |  |  |  |  | 45 | $length = shift; | 
| 54 |  |  |  |  |  |  | } | 
| 55 | 96 | 100 |  |  |  | 217 | $length = $DEFAULT if ! defined $length; | 
| 56 | 96 | 100 |  |  |  | 220 | $length = $MIN if $length < $MIN; | 
| 57 | 96 | 100 |  |  |  | 438 | $length = $MAX if $length > $MAX; | 
| 58 | 96 | 100 |  |  |  | 1137 | @eligibles = $scoresflag ? (@alphas, q{_}) : (@alphas) ; | 
| 59 | 96 |  |  |  |  | 998 | @chars     = (@eligibles, 0..9); | 
| 60 |  |  |  |  |  |  |  | 
| 61 | 96 |  |  |  |  | 99 | my $varname; | 
| 62 |  |  |  |  |  |  | MKVAR: { | 
| 63 | 96 |  |  |  |  | 100 | $varname = $eligibles[int(rand(@eligibles))]; | 
|  | 96 |  |  |  |  | 581 |  | 
| 64 | 96 |  |  |  |  | 1063 | $varname .= $chars[int(rand(@chars))] for (1 .. ($length - 1)); | 
| 65 | 96 | 50 |  |  |  | 269 | next MKVAR if $forbidden{$varname}; | 
| 66 |  |  |  |  |  |  | } | 
| 67 | 96 |  |  |  |  | 807 | return $varname; | 
| 68 |  |  |  |  |  |  | } | 
| 69 |  |  |  |  |  |  |  | 
| 70 |  |  |  |  |  |  | #################### DOCUMENTATION ################### | 
| 71 |  |  |  |  |  |  |  | 
| 72 |  |  |  |  |  |  | =head1 NAME | 
| 73 |  |  |  |  |  |  |  | 
| 74 |  |  |  |  |  |  | String::PerlIdentifier - Generate a random name for a Perl variable | 
| 75 |  |  |  |  |  |  |  | 
| 76 |  |  |  |  |  |  | =head1 VERSION | 
| 77 |  |  |  |  |  |  |  | 
| 78 |  |  |  |  |  |  | This document refers to version 0.06, released November 14 2016. | 
| 79 |  |  |  |  |  |  |  | 
| 80 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 81 |  |  |  |  |  |  |  | 
| 82 |  |  |  |  |  |  | use String::PerlIdentifier; | 
| 83 |  |  |  |  |  |  |  | 
| 84 |  |  |  |  |  |  | $varname = make_varname();      # defaults to 10 characters | 
| 85 |  |  |  |  |  |  |  | 
| 86 |  |  |  |  |  |  | or | 
| 87 |  |  |  |  |  |  |  | 
| 88 |  |  |  |  |  |  | $varname = make_varname(12);    # min: 3    max: 20 | 
| 89 |  |  |  |  |  |  |  | 
| 90 |  |  |  |  |  |  | or | 
| 91 |  |  |  |  |  |  |  | 
| 92 |  |  |  |  |  |  | $varname = make_varname( {      # set your own attributes | 
| 93 |  |  |  |  |  |  | min     => $minimum, | 
| 94 |  |  |  |  |  |  | max     => $maximum, | 
| 95 |  |  |  |  |  |  | default => $default, | 
| 96 |  |  |  |  |  |  | } ); | 
| 97 |  |  |  |  |  |  |  | 
| 98 |  |  |  |  |  |  | or | 
| 99 |  |  |  |  |  |  |  | 
| 100 |  |  |  |  |  |  | $varname = make_varname( {      # no underscores in strings; | 
| 101 |  |  |  |  |  |  | underscores => 0,           # alphanumerics only | 
| 102 |  |  |  |  |  |  | } ); | 
| 103 |  |  |  |  |  |  |  | 
| 104 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 105 |  |  |  |  |  |  |  | 
| 106 |  |  |  |  |  |  | This module automatically exports a single subroutine, C, | 
| 107 |  |  |  |  |  |  | which returns a string composed of random characters that qualifies as | 
| 108 |  |  |  |  |  |  | the name for a Perl variable.  The characters are limited to upper- and | 
| 109 |  |  |  |  |  |  | lower-case letters in the English alphabet, the numerals from 0 through 9 | 
| 110 |  |  |  |  |  |  | and the underscore character.  The first character may not be a numeral. | 
| 111 |  |  |  |  |  |  |  | 
| 112 |  |  |  |  |  |  | By default, C returns a string of 10 characters, but if a | 
| 113 |  |  |  |  |  |  | numerical argument between 3 and 20 is passed to it, a string of that length | 
| 114 |  |  |  |  |  |  | will be returned.  Arguments smaller than 3 are rounded up to 3; arguments | 
| 115 |  |  |  |  |  |  | greater than 20 are rounded down to 20. | 
| 116 |  |  |  |  |  |  |  | 
| 117 |  |  |  |  |  |  | C can also take as an argument a reference to a hash | 
| 118 |  |  |  |  |  |  | containing one or more of the following keys: | 
| 119 |  |  |  |  |  |  |  | 
| 120 |  |  |  |  |  |  | min | 
| 121 |  |  |  |  |  |  | max | 
| 122 |  |  |  |  |  |  | default | 
| 123 |  |  |  |  |  |  | underscores | 
| 124 |  |  |  |  |  |  |  | 
| 125 |  |  |  |  |  |  | So if you wanted your string to contain a minimum of 15 characters and a | 
| 126 |  |  |  |  |  |  | maximum of 30, you would call: | 
| 127 |  |  |  |  |  |  |  | 
| 128 |  |  |  |  |  |  | $varname = make_varname( { min => 15, max => 30 } ); | 
| 129 |  |  |  |  |  |  |  | 
| 130 |  |  |  |  |  |  | If you try to set C greater than C, you will get an error message | 
| 131 |  |  |  |  |  |  | and C.  But if you set C less than C or greater than | 
| 132 |  |  |  |  |  |  | C, the default value will be raised to the minimum or lowered to the | 
| 133 |  |  |  |  |  |  | maximum as is appropriate. | 
| 134 |  |  |  |  |  |  |  | 
| 135 |  |  |  |  |  |  | =head2 No underscores option | 
| 136 |  |  |  |  |  |  |  | 
| 137 |  |  |  |  |  |  | The only meaningful value for key C is C<0>. | 
| 138 |  |  |  |  |  |  | String::PerlIdentifier, like Perl itself, assumes that underscores are valid | 
| 139 |  |  |  |  |  |  | parts of identifiers, so underscores are ''on'' by default.  So the only time | 
| 140 |  |  |  |  |  |  | you need to worry about the C element in the hash passed by | 
| 141 |  |  |  |  |  |  | reference to C is when you want to I underscores from | 
| 142 |  |  |  |  |  |  | being part of the string being generated -- in which case you set: | 
| 143 |  |  |  |  |  |  |  | 
| 144 |  |  |  |  |  |  | underscores => 0 | 
| 145 |  |  |  |  |  |  |  | 
| 146 |  |  |  |  |  |  | =head2 Non-Perl-identifier usages | 
| 147 |  |  |  |  |  |  |  | 
| 148 |  |  |  |  |  |  | Although the strings returned by C qualify as Perl | 
| 149 |  |  |  |  |  |  | identifiers, they also are a subset of the set of valid directory and file | 
| 150 |  |  |  |  |  |  | names on operating systems such as Unix and Windows.  This is how, for | 
| 151 |  |  |  |  |  |  | instance, this module's author uses C. | 
| 152 |  |  |  |  |  |  |  | 
| 153 |  |  |  |  |  |  | B  String::PerlIdentifier originally appeared on CPAN as | 
| 154 |  |  |  |  |  |  | String::MkVarName.  When I went to register it on F, | 
| 155 |  |  |  |  |  |  | C persuaded me to change the name. | 
| 156 |  |  |  |  |  |  |  | 
| 157 |  |  |  |  |  |  | =head1 TO DO | 
| 158 |  |  |  |  |  |  |  | 
| 159 |  |  |  |  |  |  | Ideally, you should be able to pass the function a list of strings | 
| 160 |  |  |  |  |  |  | forbidden to be returned by C, I a list of all | 
| 161 |  |  |  |  |  |  | Perl variables currently in scope.  String::PerlIdentifier doesn't do that yet. | 
| 162 |  |  |  |  |  |  |  | 
| 163 |  |  |  |  |  |  | =head1 SEE ALSO | 
| 164 |  |  |  |  |  |  |  | 
| 165 |  |  |  |  |  |  | =over 4 | 
| 166 |  |  |  |  |  |  |  | 
| 167 |  |  |  |  |  |  | =item String::MkPasswd | 
| 168 |  |  |  |  |  |  |  | 
| 169 |  |  |  |  |  |  | This CPAN module by Chris Grau was the inspiration for String::PerlIdentifier. | 
| 170 |  |  |  |  |  |  | String::PerlIdentifier evolved as a simplification of String::MkPasswd for | 
| 171 |  |  |  |  |  |  | use in the test suite for my other CPAN module File::Save::Home. | 
| 172 |  |  |  |  |  |  |  | 
| 173 |  |  |  |  |  |  | =item String::Random | 
| 174 |  |  |  |  |  |  |  | 
| 175 |  |  |  |  |  |  | This CPAN module by Steven Pritchard is a more general solution to the problem | 
| 176 |  |  |  |  |  |  | of generating strings composed of random characters.  To generate a | 
| 177 |  |  |  |  |  |  | 10-character string that would qualify as a Perl identifier using | 
| 178 |  |  |  |  |  |  | String::Random, you would proceed as follows: | 
| 179 |  |  |  |  |  |  |  | 
| 180 |  |  |  |  |  |  | use String::Random; | 
| 181 |  |  |  |  |  |  | $rr = String::Random->new(); | 
| 182 |  |  |  |  |  |  | $rr->{'E'} = [ 'A'..'Z', 'a'..'z', '_' ]; | 
| 183 |  |  |  |  |  |  | $rr->{'F'} = [ 'A'..'Z', 'a'..'z', '_', 0..9 ]; | 
| 184 |  |  |  |  |  |  |  | 
| 185 |  |  |  |  |  |  | then | 
| 186 |  |  |  |  |  |  |  | 
| 187 |  |  |  |  |  |  | $rr->randpattern("EFFFFFFFFF"); | 
| 188 |  |  |  |  |  |  |  | 
| 189 |  |  |  |  |  |  | String::Random's greater generality comes at the cost of more typing. | 
| 190 |  |  |  |  |  |  |  | 
| 191 |  |  |  |  |  |  | =item File::Save::Home | 
| 192 |  |  |  |  |  |  |  | 
| 193 |  |  |  |  |  |  | CPAN module by the same author as String::PerlIdentifier which uses | 
| 194 |  |  |  |  |  |  | C in its test suite as of its version 0.05. | 
| 195 |  |  |  |  |  |  | File::Save::Home is used internally within recent versions of | 
| 196 |  |  |  |  |  |  | ExtUtils::ModuleMaker and its test suite. | 
| 197 |  |  |  |  |  |  |  | 
| 198 |  |  |  |  |  |  | =back | 
| 199 |  |  |  |  |  |  |  | 
| 200 |  |  |  |  |  |  | =head1 AUTHOR | 
| 201 |  |  |  |  |  |  |  | 
| 202 |  |  |  |  |  |  | James E Keenan | 
| 203 |  |  |  |  |  |  | CPAN ID: JKEENAN | 
| 204 |  |  |  |  |  |  | jkeenan@cpan.org | 
| 205 |  |  |  |  |  |  | http://search.cpan.org/~jkeenan | 
| 206 |  |  |  |  |  |  |  | 
| 207 |  |  |  |  |  |  | =head1 SUPPORT | 
| 208 |  |  |  |  |  |  |  | 
| 209 |  |  |  |  |  |  | Send email to jkeenan [at] cpan [dot] org.  Please include any of the | 
| 210 |  |  |  |  |  |  | following in the subject line: | 
| 211 |  |  |  |  |  |  |  | 
| 212 |  |  |  |  |  |  | String::PerlIdentifier | 
| 213 |  |  |  |  |  |  | String-PerlIdentifier | 
| 214 |  |  |  |  |  |  | make_varname | 
| 215 |  |  |  |  |  |  |  | 
| 216 |  |  |  |  |  |  | in the subject line.  Please report any bugs or feature requests to | 
| 217 |  |  |  |  |  |  | C, or through the web interface at | 
| 218 |  |  |  |  |  |  | L. | 
| 219 |  |  |  |  |  |  |  | 
| 220 |  |  |  |  |  |  | =head1 COPYRIGHT | 
| 221 |  |  |  |  |  |  |  | 
| 222 |  |  |  |  |  |  | This program is free software; you can redistribute | 
| 223 |  |  |  |  |  |  | it and/or modify it under the same terms as Perl itself. | 
| 224 |  |  |  |  |  |  |  | 
| 225 |  |  |  |  |  |  | The full text of the license can be found in the | 
| 226 |  |  |  |  |  |  | LICENSE file included with this module. | 
| 227 |  |  |  |  |  |  |  | 
| 228 |  |  |  |  |  |  | =cut | 
| 229 |  |  |  |  |  |  |  | 
| 230 |  |  |  |  |  |  | 1; | 
| 231 |  |  |  |  |  |  |  | 
| 232 |  |  |  |  |  |  |  |