File Coverage

blib/lib/Acme/Daily/Fail.pm
Criterion Covered Total %
statement 64 65 98.4
branch 7 10 70.0
condition 3 5 60.0
subroutine 17 17 100.0
pod 1 1 100.0
total 92 98 93.8


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