File Coverage

blib/lib/Chicken/Ipsum.pm
Criterion Covered Total %
statement 65 65 100.0
branch 12 12 100.0
condition n/a
subroutine 17 17 100.0
pod 4 4 100.0
total 98 98 100.0


line stmt bran cond sub pod time code
1             package Chicken::Ipsum 1.000000;
2 9     9   145823 use 5.012;
  9         46  
3 9     9   57 use warnings;
  9         17  
  9         369  
4              
5             =head1 NAME
6              
7             Chicken::Ipsum - Generate random chicken noises
8              
9             =head1 SYNOPSIS
10              
11             require Chicken::Ipsum;
12              
13             my $ci = Chicken::Ipsum->new();
14              
15             # Generate a string of text with 5 words
16             $words = $ci->words(5);
17              
18             # Generate a list of 5 words
19             @words = $ci->words(5);
20              
21             # Generate a string of text with 2 sentences
22             $sentences = $ci->sentences(2);
23              
24             # Generate a list of 2 sentences
25             @sentences = $ci->sentences(2);
26              
27             # Generate a string of text with 3 paragraphs
28             $paragraphs = $ci->paragraphs(3);
29              
30             # Generate a list of 3 paragraphs
31             @paragraphs = $ci->paragraphs(3);
32              
33             =head1 DESCRIPTION
34              
35             Often when developing a website or other application, it's important to have
36             placeholders for content. This module generates prescribed amounts of clucking,
37             cawing and other chicken-y noises.
38              
39             =cut
40              
41 9     9   54 use Carp qw/ croak /;
  9         14  
  9         510  
42 9     9   56 use List::Util qw/ sample /;
  9         24  
  9         1106  
43              
44 9         939 use constant WORDS => [qw/
45             puk
46             pukaaak
47             cluck
48             cluck-cluck-cluck
49             cluckity
50             bwak
51             waaak
52             bok
53             bwok
54             cluck-a-buh-gawk
55             cock-a-doodle-doo
56             bwwwaaaaaaaaaak
57             gobble-gobble
58             honk
59 9     9   68 /];
  9         18  
60 9         642 use constant PUNCTUATIONS => [qw/
61             .
62             ...
63             !
64             ?
65 9     9   78 /];
  9         44  
66 9     9   86 use constant MIN_SENTENCE_WORDS => 4;
  9         19  
  9         586  
67 9     9   58 use constant MAX_SENTENCE_WORDS => 10;
  9         19  
  9         447  
68 9     9   62 use constant MIN_PARAGRAPH_SENTENCES => 3;
  9         23  
  9         450  
69 9     9   57 use constant MAX_PARAGRAPH_SENTENCES => 7;
  9         17  
  9         5474  
70              
71             =head1 CONSTRUCTOR
72              
73             =head2 C
74              
75             my $ci = Chicken::Ipsum->new( %options )
76              
77             This method constructs a new L object and returns it. Key/value
78             pair arguments may be provided to set up the initial state. The following
79             options are recognized:
80              
81             KEY DEFAULT
82             ----------- --------------------
83             frantic 0.1
84              
85             =over
86              
87             =item frantic
88              
89             Randomly capitalize words with the given ratio.
90              
91             =back
92              
93             =cut
94              
95             sub new {
96 9     9 1 3403 my ($class, %args) = @_;
97 9         35 my $self = bless {
98             frantic => 0.1,
99             }, $class;
100              
101 9         21 foreach my $opt (keys %{$self}) {
  9         57  
102 9 100       42 if (exists $args{$opt}) {
103 3         9 $self->{$opt} = delete $args{$opt};
104             }
105             }
106             # Ensure all incoming arguments were used
107 9 100       55 if (%args) {
108 1         240 croak('Unrecognized argument(s): ', join ', ', sort keys %args);
109             }
110 8         112 return $self;
111             }
112              
113             =head1 METHODS
114              
115             All methods below will return a string in scalar context or a list in list
116             context.
117              
118             =head2 C
119              
120             Returns INTEGER Chicken words.
121              
122             =cut
123              
124             sub words {
125 710     710 1 24650 my ($self, $num) = @_;
126 710         862 my @words = sample $num, @{+WORDS};
  710         2321  
127 710         1313 foreach my $word (@words) {
128 4641 100       8217 if (rand 1 < $self->{frantic}) {
129 788         1334 $word = uc $word;
130             }
131             }
132 710 100       2471 return wantarray ? @words : "@words";
133             }
134              
135             =head2 C
136              
137             Returns INTEGER sentences in Chicken.
138              
139             =cut
140              
141             sub sentences {
142 137     137 1 223 my ($self, $num) = @_;
143 137         170 my @sentences;
144             # Sentences remaining "goes to" 0, LOL.
145             # (See https://stackoverflow.com/q/1642028/237955)
146 137         249 while ($num --> 0) {
147 703         1235 push @sentences, $self->_get_sentence();
148             }
149 137 100       652 return wantarray ? @sentences : "@sentences";
150             }
151              
152             =head2 C
153              
154             Returns INTEGER paragraphs of Chicken text.
155              
156             =cut
157              
158             sub paragraphs {
159 8     8 1 29 my ($self, $num) = @_;
160 8         12 my @paragraphs;
161 8         25 while ($num --> 0) {
162 129         240 push @paragraphs, $self->_get_paragraph;
163             }
164 8 100       88 return wantarray ? @paragraphs : join "\n\n", @paragraphs;
165             }
166              
167             sub _get_paragraph {
168 129     129   163 my $self = shift;
169 129         291 my $num = MIN_PARAGRAPH_SENTENCES + int rand MAX_PARAGRAPH_SENTENCES - MIN_PARAGRAPH_SENTENCES;
170 129         222 my $paragraph = $self->sentences($num);
171 129         339 return $paragraph;
172             }
173              
174             sub _get_punctuation {
175 703     703   929 return sample 1, @{+PUNCTUATIONS};
  703         3002  
176             }
177              
178             sub _get_sentence {
179 703     703   936 my $self = shift;
180 703         1141 my $num = MIN_SENTENCE_WORDS + int rand MAX_SENTENCE_WORDS - MIN_SENTENCE_WORDS;
181 703         1152 my $words = ucfirst $self->words($num);
182 703         1218 return $words . _get_punctuation();
183             }
184              
185             =head1 AUTHOR
186              
187             Dan Church (h3xxgmxcom)
188              
189             =head1 SEE ALSO
190              
191             L
192              
193             L
194              
195             =head1 LICENSE AND COPYRIGHT
196              
197             Copyright (C) 2023 Dan Church.
198              
199             This library is free software; you can redistribute it and/or modify it under
200             the same terms as Perl itself.
201              
202             =head1 AVAILABILITY
203              
204             The latest version of this library is likely to be available from CPAN as well
205             as:
206              
207             L
208              
209             =head1 THANKS
210              
211             Thanks to Sebastian Carlos's L
212             (L) for the inspiration.
213              
214             =cut
215             1;