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.20';
3             #ABSTRACT: generate random newspaper headlines
4              
5 1     1   67859 use strict;
  1         12  
  1         29  
6 1     1   6 use warnings;
  1         2  
  1         25  
7 1     1   559 use Math::Random;
  1         5997  
  1         105  
8              
9             our @ISA = qw[Exporter];
10             our @EXPORT_OK = qw[get_headline];
11              
12 1     1   10 use constant PLURAL => 0;
  1         2  
  1         113  
13 1     1   7 use constant SINGULAR => 1;
  1         2  
  1         57  
14 1     1   6 use constant TENSE => 2;
  1         2  
  1         42  
15              
16 1     1   6 use constant WORD => 0;
  1         2  
  1         54  
17 1     1   6 use constant PERSON => 1;
  1         2  
  1         48  
18 1     1   7 use constant NUMBER => 2;
  1         3  
  1         57  
19              
20 1     1   7 use constant PRESENT => 0;
  1         2  
  1         51  
21 1     1   6 use constant PAST => 1;
  1         2  
  1         39  
22 1     1   5 use constant ACTIVE => 2;
  1         2  
  1         52  
23 1     1   7 use constant OBJECT => 3;
  1         2  
  1         818  
24              
25             sub _getRandom {
26 40   50 40   74 my $array = shift || return;
27 40         56 return $array->[ scalar random_uniform_integer(1,0,$#{ $array }) ];
  40         76  
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,2],
95             ["covid",3,1], # fuck you, 2020
96             ['meghan markle',3,1],
97             ];
98              
99             # Transitive phrases (i.e. bad thing they do)
100             #function Phrase(present, past, active, object) {
101              
102             my $transitive_phrases = [
103             ["give", "given", "giving", "cancer"],
104             ["give", "given", "giving", "cancer"], # Have it twice as they're so bloody obsessed by it
105             ["give", "given", "giving", "covid"],
106             ["infect", "infected", "infecting", "with AIDS"],
107             ["make", "made", "making", "obese"],
108             ["give", "given", "giving", "diabetes"],
109             ["make", "made", "making", "impotent"],
110             ["turn","turned","turning","gay"],
111             ["scrounge off","scrounged off","scrounging off",""],
112             ["tax", "taxed", "taxing", ""],
113             ["cheat", "cheated", "cheating", ""],
114             ["defraud", "defrauded", "defrauding", ""],
115             ["steal from","stolen from","stealing from",""],
116             ["burgle","burgled","burgling",""],
117             ["devalue","devalued","devaluing",""],
118             ["rip off","ripped off","ripping off",""],
119             ["molest","molested","molesting",""],
120             ["have sex with","had sex with","having sex with",""],
121             ["impregnate", "impregnated", "impregnating", ""],
122             ["steal the identity of","stolen the identity of","stealing the identity of",""],
123             ["destroy","destroyed","destroying",""],
124             ["kill","killed", "killing",""],
125             ["ruin","ruined","ruining",""],
126             ["hurt","hurt", "hurting",""]
127             ];
128              
129             # Objects (i.e. saintly, saintly things)
130             my $objects = [
131             "the british people",
132             "the middle class",
133             "middle britain",
134             "england",
135             "hard-working families",
136             "homeowners",
137             "pensioners",
138             "drivers",
139             "taxpayers",
140             "taxpayers' money",
141             "house prices",
142             "property prices", # Hahahahahahahaa
143             "britain's farmers",
144             "britain's fishermen",
145             "the countryside",
146             "british justice",
147             "british sovereignty",
148             "common sense and decency",
149             "the queen", # God bless 'er
150             "the royal family",
151             "the church",
152             "you",
153             "your mortgage",
154             "your pension",
155             "your daughters",
156             "your children",
157             "your house",
158             "your pets",
159             "the conservative party", # FAIL
160             "cliff richard", # Should this be in here?
161             "the memory of diana",
162             "Britain's swans", # This always stays
163             "Brexit",
164             ];
165              
166             # Matches an auxiliary verb with the subject
167             sub _match_verb_and_subject {
168 10     10   16 my ($subject,$verb) = @_;
169              
170 10 100 66     45 if ($subject->[NUMBER] == 1 && $subject->[PERSON] == 3) {
171 7         18 return $verb->[SINGULAR];
172             }
173             else {
174 3         10 return $verb->[PLURAL];
175             }
176             }
177              
178             # Matchs the transitive verb's tense with that of the verb
179             #function Phrase(present, past, active, object) {
180             sub _match_verb_and_tense {
181 10     10   17 my ($verb,$phrase) = @_;
182 10 100       29 if ($verb->[TENSE] eq "present") {
    100          
    50          
183 4         10 return $phrase->[PRESENT];
184             }
185             elsif ($verb->[TENSE] eq "past") {
186 3         35 return $phrase->[PAST];
187             }
188             elsif ($verb->[TENSE] eq "active") {
189 3         7 return $phrase->[ACTIVE];
190             }
191             }
192              
193             # Returns a Daily Mail Headline as a string
194             sub get_headline {
195 10     10 1 5674 my @sentence;
196              
197 10         23 my $subject = _getRandom($subjects);
198 10         159 my $phrase = _getRandom($transitive_phrases);
199 10         125 my $verb = _getRandom($auxiliary_verbs);
200 10         120 my $object = _getRandom($objects);
201              
202 10         127 $sentence[0] = _match_verb_and_subject($subject, $verb);
203 10         18 $sentence[1] = $subject->[WORD];
204 10         17 $sentence[2] = _match_verb_and_tense($verb, $phrase);
205 10         19 $sentence[3] = $object;
206 10 100       19 $sentence[4] = $phrase->[OBJECT] if $phrase->[OBJECT];
207              
208 10         19 my $s = join ' ', map { uc } @sentence;
  43         97  
209 10         28 $s .= '?';
210              
211 10         28 return $s;
212             }
213              
214             qq[BLOODY IMMIGRANTS];
215              
216             __END__