File Coverage

blib/lib/Test/QuickGen.pm
Criterion Covered Total %
statement 61 62 98.3
branch 15 20 75.0
condition 9 17 52.9
subroutine 16 16 100.0
pod 10 10 100.0
total 111 125 88.8


line stmt bran cond sub pod time code
1             package Test::QuickGen;
2              
3 3     3   311069 use v5.16;
  3         11  
4 3     3   13 use strict;
  3         14  
  3         79  
5 3     3   11 use warnings;
  3         3  
  3         127  
6 3     3   10 use Carp qw(croak);
  3         4  
  3         161  
7 3     3   12 use Scalar::Util qw(looks_like_number);
  3         3  
  3         133  
8 3     3   17 use Exporter 'import';
  3         3  
  3         2336  
9              
10             our $VERSION = '0.1.2';
11              
12             our @EXPORT_OK = qw(
13             ascii_string alphanumeric_string between id string_of pick nullable words
14             utf8_string utf8_sanitized
15             );
16             our %EXPORT_TAGS = (
17             all => \@EXPORT_OK,
18             ascii => [qw(ascii_string alphanumeric_string)],
19             utf8 => [qw(utf8_string utf8_sanitized)],
20             basic => [qw(id between pick nullable)],
21             );
22              
23             =head1 NAME
24              
25             Test::QuickGen - Utilities for generating random test data
26              
27             =head1 SYNOPSIS
28              
29             use Test::QuickGen qw(:all);
30              
31             my $id = id();
32             my $ascii = ascii_string(10);
33             my $alphanum = alphanumeric_string(10);
34             my $utf8 = utf8_string(20);
35             my $clean = utf8_sanitized(15);
36              
37             my $rand = between(1, 100);
38             my $opt = nullable("value");
39             my $item = pick(qw(a b c));
40              
41             my $words = words(\&ascii_string, 5);
42              
43             =head1 DESCRIPTION
44              
45             C provides a set of utility functions for generating random
46             data, primarily intended for testing purposes. These generators are simple,
47             fast, and have minimal dependencies.
48              
49             =head1 COMMAND LINE TOOL
50              
51             This module comes bundled with an optional test runner, see L for
52             more details.
53              
54             =head1 IMPORTING
55              
56             Nothing is exported by default.
57              
58             Import functions explicitly:
59              
60             use Test::QuickGen qw(id ascii_string);
61              
62             Import groups of functions using tags:
63              
64             use Test::QuickGen qw(:all);
65             use Test::QuickGen qw(:ascii);
66             use Test::QuickGen qw(:utf8);
67             use Test::QuickGen qw(:basic);
68              
69             =over 4
70              
71             =item * C<:all>
72              
73             All available functions.
74              
75             =item * C<:ascii>
76              
77             ASCII specific functions.
78              
79             =item * C<:utf8>
80              
81             UTF-8 specific functions.
82              
83             =item * C<:basic>
84              
85             Simple utils like C or C.
86              
87             =back
88              
89             See source for exact composition of the imports.
90              
91             =head1 FUNCTIONS
92              
93             =head2 id
94              
95             my $id1 = id();
96             my $id2 = id();
97              
98             # $id1 != $id2
99              
100             Returns a monotonically increasing integer starting from 0.
101              
102             The counter is process-local and resets each time the program runs.
103              
104             =cut
105             sub id {
106 6     6 1 207806 state $id = 0;
107 6         16 $id++;
108             }
109              
110             =head2 string_of($n, @chars)
111              
112             my $str = string_of(10, qw(a b c));
113              
114             Generates a random string of length C<$n> using the provided list of characters C<@chars>.
115              
116             =over 4
117              
118             =item *
119              
120             C<$n> must be a non-negative integer.
121              
122             =item *
123              
124             At least one character must be provided.
125              
126             =back
127              
128             =cut
129             sub string_of {
130 19     19 1 9608 my ($n, @chars) = @_;
131              
132 19 100       229 croak 'string_of: empty character set' unless @chars;
133            
134 18         29 my $str = '';
135 18         51 for (1..$n) {
136 525         903 $str .= $chars[rand @chars];
137             }
138 18         173 $str;
139             }
140              
141             =head2 ascii_string($n)
142              
143             my $str = ascii_string(10);
144              
145             Generates a random ASCII string length C<$n>.
146              
147             The character set includes all visible ASCII symbols and characters (in the
148             range 33 to 126).
149              
150             =cut
151             sub ascii_string {
152 7     7 1 15186 my ($n) = @_;
153             # all visible ASCII characters
154 7         21 my @chars = map { chr($_) } 33..126;
  658         1012  
155 7         25 string_of($n, @chars);
156             }
157              
158             =head2 alphanumeric_string($n)
159              
160             my $str = alphanumeric_string($n);
161              
162             Generates a random ASCII string of only alphanumericeric characters of
163             length C<$n>.
164              
165             =cut
166             sub alphanumeric_string {
167 7     7 1 15366 my ($n) = @_;
168 7         134 string_of($n, 'a'..'z', 'A'..'Z', '0'..'9');
169             }
170              
171             =head2 utf8_string($n)
172              
173             my $str = utf8_string(10);
174              
175             Generates a random UTF-8 string of C<$n> characters.
176              
177             The generator:
178              
179             =over 4
180              
181             =item *
182              
183             Includes visible Unicode characters up to code point C<0x2FFF>.
184              
185             =item *
186              
187             Excludes control characters and invalid Unicode ranges.
188              
189             =item *
190              
191             Skips surrogate pairs and non-characters.
192              
193             =back
194              
195             Note: Because characters may vary in byte length, this function targets
196             character count (not byte length).
197              
198             =cut
199             sub utf8_string {
200 14     14 1 98352 my ($n) = @_;
201 14         34 my $str = '';
202 14         60 while (length($str) < $n) {
203             # skip non-visible ASCII characters (0x00-0x19)
204             # include everything up to 0x2FFF (extended UTF-8)
205 200         406 my $code_point = between(0x20, 0x2FFF);
206              
207             # skip problematic unicode points
208 200 50 33     513 next if ($code_point >= 0xD800 && $code_point <= 0xDFFF); # surrogate pairs
209 200 50 33     485 next if ($code_point >= 0xFDD0 && $code_point <= 0xFDEF); # non characters
210             # also non characters
211 200 50 33     741 next if ($code_point % 0x10000 == 0xFFFE || $code_point % 0x10000 == 0xFFFF);
212 200 50 66     658 next if ($code_point >= 0x7F && $code_point <= 0x9F); # control characters
213              
214 200         635 $str .= chr($code_point);
215             }
216 14         57 $str;
217             }
218              
219             =head2 utf8_sanitized($n)
220              
221             my $clean = utf8_sanitized(10);
222              
223             Generates a UTF-8 string of length C<$n> and removes all non-alphanumericeric
224             characters, retaining only:
225              
226             =over 4
227              
228             =item *
229              
230             Unicode letters (C<\p{L}>)
231              
232             =item *
233              
234             Unicode numbers (C<\p{N}>)
235              
236             =item *
237              
238             Whitespace
239              
240             =back
241              
242             If all characters are filtered out, the function retries until a non-empty
243             string is produced.
244              
245             =cut
246             sub utf8_sanitized {
247 7     7 1 47742 my ($n) = @_;
248 7         21 my $s = utf8_string($n);
249             # exit early before stripping if the intended result is an empty string
250 7 100       35 return $s if $s eq '';
251              
252 5         99 $s =~ s/[^\p{L}\p{N}\s]//gu;
253              
254             # sometimes all characters get filtered, try again and hope for the best
255 5 50       20 if ($s eq '') {
256 0         0 return utf8_sanitized($n);
257             }
258              
259 5         20 $s;
260             }
261              
262             =head2 words($gen, $n, $max_len = 70)
263              
264             my $str = words(\&string_generator, 5);
265              
266             Generates a string made up of C<$n> space-separated "words".
267              
268             Each word is produced by calling the generator function C<$gen>.
269              
270             =over 4
271              
272             =item * C<$gen>
273              
274             A coderef that is called once per word.
275              
276             It accepts a single integer argument (the desired length), and returns a string.
277              
278             For example:
279              
280             sub string_generator {
281             my ($len) = @_;
282             # return a string of length $len
283             }
284              
285             =item * C<$max_len>
286              
287             An optional parameter to set the maximum length (inclusive) of a word.
288             Defaults to 70. Must be a positive number.
289              
290             =item * Word generation
291              
292             For each of the C<$n> words, a random length between 1 and C<$max_len> is
293             chosen. That length is passed to C<$gen>, which returns the word.
294              
295             =item * Output format
296              
297             The generated words are joined together with a single space.
298              
299             =back
300              
301             Example:
302              
303             words(\&ascii_string, 3);
304             # might return: "aZ3 kLm92 Q"
305              
306             =cut
307             sub words {
308 4     4 1 6567 my ($gen, $n, $max_len) = @_;
309              
310 4   100     23 $max_len //= 70;
311 4 100 66     222 croak '$max_len must be a positive number'
312             unless looks_like_number($max_len) && $max_len > 0;
313              
314 3         49 my @words = map { $gen->(between(1, $max_len)) } (1..$n);
  7         36  
315 3         30 join ' ', @words;
316             }
317              
318             =head2 between($min, $max)
319              
320             my $n = between(1, 10);
321              
322             Returns a random integer between C<$min> and C<$max> (inclusive).
323              
324             C<$min> must be <= C<$max>.
325              
326             =cut
327             sub between {
328 224     224 1 14343 my ($min, $max) = @_;
329 224 100       692 croak "between: max must be larger or equal to min" if $max < $min;
330 223         635 $min + int(rand($max - $min + 1));
331             }
332              
333             =head2 nullable($val)
334              
335             my $value = nullable("data");
336              
337             Returns either the given value or C.
338              
339             25% chance of returning C, 75% chance of returning the original value.
340             Useful for testing optional fields.
341              
342             =cut
343             sub nullable {
344 16     16 1 6308 my ($val) = @_;
345 16 100       36 if (rand() < 0.25) {
346 1         5 undef;
347             } else {
348 15         31 $val;
349             }
350             }
351              
352             =head2 pick(@items)
353              
354             my $item = pick(qw(a b c));
355              
356             Returns a random element from the provided list.
357              
358             If provided an empty list, will return C.
359              
360             =cut
361 22     22 1 11804 sub pick { $_[rand @_] }
362              
363             =head1 NOTES
364              
365             =over 4
366              
367             =item *
368              
369             These functions are not cryptographically secure.
370              
371             =item *
372              
373             Randomness uses the builtin function L, so all limitations
374             that apply to that also apply here. Randomness in this module's functions is
375             uniform in its distribution unless specified otherwise.
376              
377             =item *
378              
379             They are intended for testing, fuzzing, and data generation only.
380              
381             =back
382              
383             =head1 AUTHOR
384              
385             Antonis Kalou Ekalouantonis@protonmail.comE
386              
387             =head1 CONTRIBUTORS
388              
389             B: L
390              
391             B: Mike Whitaker Ependfold@cpan.orgE
392              
393             =head1 LICENSE
394              
395             This library is free software; you can redistribute it and/or modify it under
396             the same terms as Perl itself. See F for details.
397              
398             =cut
399              
400             1;