File Coverage

blib/lib/Acme/Daily/Fail.pm
Criterion Covered Total %
statement 65 65 100.0
branch 9 10 90.0
condition 3 5 60.0
subroutine 17 17 100.0
pod 1 1 100.0
total 95 98 96.9


line stmt bran cond sub pod time code
1             package Acme::Daily::Fail;
2             $Acme::Daily::Fail::VERSION = '1.18';
3             #ABSTRACT: generate random newspaper headlines
4              
5 1     1   69513 use strict;
  1         11  
  1         30  
6 1     1   5 use warnings;
  1         1  
  1         24  
7 1     1   619 use Math::Random;
  1         6073  
  1         113  
8              
9             our @ISA = qw[Exporter];
10             our @EXPORT_OK = qw[get_headline];
11              
12 1     1   8 use constant PLURAL => 0;
  1         3  
  1         114  
13 1     1   7 use constant SINGULAR => 1;
  1         3  
  1         46  
14 1     1   5 use constant TENSE => 2;
  1         3  
  1         44  
15              
16 1     1   5 use constant WORD => 0;
  1         2  
  1         53  
17 1     1   7 use constant PERSON => 1;
  1         2  
  1         56  
18 1     1   7 use constant NUMBER => 2;
  1         2  
  1         43  
19              
20 1     1   5 use constant PRESENT => 0;
  1         2  
  1         37  
21 1     1   4 use constant PAST => 1;
  1         2  
  1         49  
22 1     1   6 use constant ACTIVE => 2;
  1         2  
  1         41  
23 1     1   4 use constant OBJECT => 3;
  1         2  
  1         811  
24              
25             sub _getRandom {
26 40   50 40   85 my $array = shift || return;
27 40         52 return $array->[ scalar random_uniform_integer(1,0,$#{ $array }) ];
  40         85  
28             }
29              
30             # Auxiliary verbs (the first word in the sentence)
31             #function Verb(plural, singular, tense) {
32              
33             my $auxiliary_verbs = [
34             ["will", "will", "present"],
35             ["could", "could", "present"],
36             ["are", "is", "active"],
37             ["have", "has", "past"]
38             ];
39              
40             # Subjects (i.e. bad things)
41             #function Noun(word,person,number) {
42              
43             my $subjects = [
44             ["the labour party",3,1],
45             ["brussels",3,1],
46             ["the bbc",3,1],
47             ["the e.u.",3,1],
48             ["the euro",3,1],
49             ["the loony left",3,1],
50             ["the unions",3,2], # May be a bit quaint this one
51             ["channel 4",3,1],
52             ["your local council",3,1],
53             ["the french",3,2],
54             ["the germans",3,2],
55             ["the poles",3,2],
56             ["brussels bureaucrats",3,2],
57             ["muslims",3,2],
58             ["immigrants",3,2], # Except those from the UK to Spain & the Algarve of course
59             ["teachers",3,2],
60             ["the unemployed",3,2],
61             ["gypsies",3,2],
62             ["yobs",3,2],
63             ["hoodies",3,2],
64             ["feral children",3,2], # They hate children *and* paedophiles FFS, make your minds up
65             ["chavs",3,2],
66             ["the p.c. brigade",3,2],
67             ["cyclists",3,2],
68             ["asylum seekers",3,2], # Nicer way of saying 'brown people'
69             ["gays",3,2],
70             ["lesbians",3,2],
71             ["single mothers",3,2],
72             ["working mothers",3,2],
73             ["paedophiles",3,2],
74             ["teenage sex",3,1],
75             ["political correctness",3,1],
76             ["health & safety",3,1],
77             ["feminism",3,1],
78             ["the metric system",3,1], # For fuck's sake
79             ["dumbing-down",3,1],
80             ["rip-off britain",3,1],
81             ["the internet",3,1],
82             ["facebook",3,1], # I CAN'T BELIEVE THE MAIL ACTUALLY SAID FACEBOOK COULD GIVE YOU CANCER, FOR REAL
83             ["filth on television",3,1],
84             ["the human rights act",3,1],
85             ["the nanny state",3,1],
86             ["cancer",3,1], # Could cancer give you cancer?
87             ["binge drinking",3,1],
88             ["the house price crash",3,1],# Hahahaha
89             ["jihadists",3,1], # Topical
90             ["x factor",3,1], # Topical
91             ["foxes",3,2],
92             ["twitter",3,1], # Topical
93             ["the mmr jab",3,1], # Topical
94             ["judges",3,1],
95             ["covid",3,1], # fuck you, 2020
96             ];
97              
98             # Transitive phrases (i.e. bad thing they do)
99             #function Phrase(present, past, active, object) {
100              
101             my $transitive_phrases = [
102             ["give", "given", "giving", "cancer"],
103             ["give", "given", "giving", "cancer"], # Have it twice as they're so bloody obsessed by it
104             ["give", "given", "giving", "covid"],
105             ["infect", "infected", "infecting", "with AIDS"],
106             ["make", "made", "making", "obese"],
107             ["give", "given", "giving", "diabetes"],
108             ["make", "made", "making", "impotent"],
109             ["turn","turned","turning","gay"],
110             ["scrounge off","scrounged off","scrounging off",""],
111             ["tax", "taxed", "taxing", ""],
112             ["cheat", "cheated", "cheating", ""],
113             ["defraud", "defrauded", "defrauding", ""],
114             ["steal from","stolen from","stealing from",""],
115             ["burgle","burgled","burgling",""],
116             ["devalue","devalued","devaluing",""],
117             ["rip off","ripped off","ripping off",""],
118             ["molest","molested","molesting",""],
119             ["have sex with","had sex with","having sex with",""],
120             ["impregnate", "impregnated", "impregnating", ""],
121             ["steal the identity of","stolen the identity of","stealing the identity of",""],
122             ["destroy","destroyed","destroying",""],
123             ["kill","killed", "killing",""],
124             ["ruin","ruined","ruining",""],
125             ["hurt","hurt", "hurting",""]
126             ];
127              
128             # Objects (i.e. saintly, saintly things)
129             my $objects = [
130             "the british people",
131             "the middle class",
132             "middle britain",
133             "england",
134             "hard-working families",
135             "homeowners",
136             "pensioners",
137             "drivers",
138             "taxpayers",
139             "taxpayers' money",
140             "house prices",
141             "property prices", # Hahahahahahahaa
142             "britain's farmers",
143             "britain's fishermen",
144             "the countryside",
145             "british justice",
146             "british sovereignty",
147             "common sense and decency",
148             "the queen", # God bless 'er
149             "the royal family",
150             "the church",
151             "you",
152             "your mortgage",
153             "your pension",
154             "your daughters",
155             "your children",
156             "your house",
157             "your pets",
158             "the conservative party", # FAIL
159             "cliff richard", # Should this be in here?
160             "the memory of diana",
161             "Britain's swans", # This always stays
162             "Brexit",
163             ];
164              
165             # Matches an auxiliary verb with the subject
166             sub _match_verb_and_subject {
167 10     10   20 my ($subject,$verb) = @_;
168              
169 10 100 66     47 if ($subject->[NUMBER] == 1 && $subject->[PERSON] == 3) {
170 3         10 return $verb->[SINGULAR];
171             }
172             else {
173 7         17 return $verb->[PLURAL];
174             }
175             }
176              
177             # Matchs the transitive verb's tense with that of the verb
178             #function Phrase(present, past, active, object) {
179             sub _match_verb_and_tense {
180 10     10   21 my ($verb,$phrase) = @_;
181 10 100       32 if ($verb->[TENSE] eq "present") {
    100          
    50          
182 4         12 return $phrase->[PRESENT];
183             }
184             elsif ($verb->[TENSE] eq "past") {
185 3         9 return $phrase->[PAST];
186             }
187             elsif ($verb->[TENSE] eq "active") {
188 3         21 return $phrase->[ACTIVE];
189             }
190             }
191              
192             # Returns a Daily Mail Headline as a string
193             sub get_headline {
194 10     10 1 5589 my @sentence;
195              
196 10         24 my $subject = _getRandom($subjects);
197 10         171 my $phrase = _getRandom($transitive_phrases);
198 10         132 my $verb = _getRandom($auxiliary_verbs);
199 10         124 my $object = _getRandom($objects);
200              
201 10         130 $sentence[0] = _match_verb_and_subject($subject, $verb);
202 10         18 $sentence[1] = $subject->[WORD];
203 10         16 $sentence[2] = _match_verb_and_tense($verb, $phrase);
204 10         18 $sentence[3] = $object;
205 10 100       25 $sentence[4] = $phrase->[OBJECT] if $phrase->[OBJECT];
206              
207 10         22 my $s = join ' ', map { uc } @sentence;
  42         126  
208 10         30 $s .= '?';
209              
210 10         27 return $s;
211             }
212              
213             qq[BLOODY IMMIGRANTS];
214              
215             __END__