File Coverage

blib/lib/Acme/Terror/NL.pm
Criterion Covered Total %
statement 18 33 54.5
branch 0 8 0.0
condition n/a
subroutine 5 8 62.5
pod 4 4 100.0
total 27 53 50.9


line stmt bran cond sub pod time code
1             package Acme::Terror::NL;
2 1     1   25110 use strict;
  1         2  
  1         38  
3 1     1   795 use LWP::Simple;
  1         170769  
  1         9  
4              
5 1     1   451 use vars qw($VERSION);
  1         7  
  1         65  
6             $VERSION = '0.04';
7              
8             use constant {
9 1         438 UNKNOWN => 0,
10             CRITICAL => 1,
11             SUBSTANTIAL => 2,
12             LIMITED => 3,
13             MINIMAL => 4,
14 1     1   5 };
  1         2  
15              
16             sub new {
17 1     1 1 14 my ($class, %args) = @_;
18 1         3 my $self = {};
19 1         3 bless $self, $class;
20 1         8 $self->{_level} = UNKNOWN;
21 1         4 $self->{_level_txt} = "UNKNOWN";
22 1         3 return $self;
23             }
24              
25             sub fetch {
26 0     0 1   my $self = shift;
27 0           my $uri = 'http://english.nctb.nl/';
28 0           my $html = get($uri);
29 0 0         if($html =~ m!href=".+?current_threat_level.+?"[^>]+>\s*(MINIMAL|LIMITED|SUBSTANTIAL|CRITICAL)!is){
30 0           my $lvl = $1;
31 0 0         if($constant::declared{__PACKAGE__."::".$lvl}) {
32 0           $self->{_level} = eval $lvl;
33 0           $self->{_level_txt} = $lvl;
34             }
35             }
36 0           return $self->{_level_txt};
37             }
38              
39             sub text {
40 0     0 1   my $self = shift;
41 0 0         $self->fetch unless($self->{_level});
42 0           return $self->{_level_text};
43             }
44              
45             sub level {
46 0     0 1   my $self = shift;
47 0 0         $self->fetch unless($self->{_level});
48 0           return $self->{_level};
49             }
50              
51             #-------------------------------------------------------------------#
52              
53             =head1 NAME
54              
55             Acme::Terror::NL - Fetch the current NL terror alert level
56              
57             =head1 SYNOPSIS
58              
59             use Acme::Terror::NL;
60              
61             my $t = Acme::Terror::NL->new(); # create new Acme::Terror::NL object
62              
63             my $level = $t->fetch;
64             print "Current terror alert level is: $level\n";
65              
66             =head1 DESCRIPTION
67              
68             Gets the currrent terrorist threat level in the Netherlands.
69              
70             The levels are either...
71              
72             CRITICAL - there are strong indications that an attack will occur
73             SUBSTANTIAL - there is a realistic possibility that an attack will occur
74             LIMITED - it appears that attacks can be prevented.
75             MINIMAL - it is unlikely that attacks are being planned.
76             UNKNOWN - cannot determine threat level
77              
78             There are "only" four levels present in the Netherlands, unlike, e.g. the
79             United Kingdom and the United States of America, where there are five.
80             Thats what you get for being a small country.
81              
82             This module aims to be compatible with the US version, L,
83             the UK version, L and the AU version, L.
84              
85             =head1 METHODS
86              
87             =head2 new()
88              
89             use Acme::Terror::NL;
90             my $t = Acme::Terror::NL->new();
91              
92             Create a new instance of the Acme:Terror::NL class.
93              
94             =head2 fetch()
95              
96             my $threat_level_string = $t->fetch();
97             print $threat_level_string;
98              
99             Return the current threat level as a string.
100              
101             =head2 text()
102              
103             See C, it returns the same.
104              
105             =head2 level()
106              
107             my $level = $t->level();
108             if ($level == Acme::Terror::NL::CRITICAL) {
109             print "too many Ls!";
110             }
111              
112             Return the level of the current terrorist threat as a comparable value.
113              
114             The values to compare against are,
115              
116             Acme::Terror::NL::CRITICAL
117             Acme::Terror::NL::SUBSTANTIAL
118             Acme::Terror::NL::LIMITED
119             Acme::Terror::NL::MINIMAL
120              
121             If it can't retrieve the current level, it will return
122              
123             Acme::Terror::NL::UNKNOWN
124              
125             =head1 BUGS
126              
127             Blame the terrorists! ... or report it to L.
128              
129             =head1 AUTHOR
130              
131             M. Blom,
132             Eblom@cpan.orgE
133             L
134              
135             =head1 COPYRIGHT
136              
137             This program is free software; you can redistribute
138             it and/or modify it under the same terms as Perl itself.
139              
140             The full text of the license can be found in the
141             LICENSE file included with this module.
142              
143              
144             =head1 SEE ALSO
145              
146             =over 4
147              
148             =item * L, L, L
149              
150             =item * L
151              
152             =back
153              
154             =cut
155              
156             1;