File Coverage

blib/lib/ThreatNet/Topic.pm
Criterion Covered Total %
statement 25 25 100.0
branch 11 14 78.5
condition 7 9 77.7
subroutine 9 9 100.0
pod 4 4 100.0
total 56 61 91.8


line stmt bran cond sub pod time code
1             package ThreatNet::Topic;
2              
3             =pod
4              
5             =head1 NAME
6              
7             ThreatNet::Topic - An object representation of a ThreatNet channel topic
8              
9             =head1 DESCRIPTION
10              
11             ThreatNet is an evolving idea. This standalone module defines a topic format
12             and an object to hold it. ThreatNet itself is not yet available.
13              
14             A proposal generally defining what it B be is available at:
15              
16             L
17              
18             =head1 METHODS
19              
20             =cut
21              
22 2     2   30307 use strict;
  2         6  
  2         74  
23 2     2   11100 use URI ();
  2         19735  
  2         116  
24             use overload 'bool' => sub () { 1 },
25 2     2   20 '""' => 'topic';
  2         6  
  2         13  
26              
27 2     2   170 use vars qw{$VERSION};
  2         5  
  2         159  
28             BEGIN {
29 2     2   893 $VERSION = '0.20';
30             }
31              
32              
33              
34              
35              
36             #####################################################################
37             # Constructor and Accessors
38              
39             =pod
40              
41             =head2 new $topic
42              
43             The C constructor takes a new ThreatNet topic string and creates an
44             object that represents it.
45              
46             A ThreatNet topic should look like the following
47              
48             threatnet://host/path configuration
49              
50             That is, it should start with a 'threatnet' URI identifier in the same
51             style as XML namespace URIs, containing at least the host and path
52             components, following an arbitrary string most likely representing the
53             configuration and rules of the channel, with a format defined by the
54             protocol.
55              
56             Returns a new ThreatNet::Topic object or C if the string is not a
57             valid ThreatNet topic string.
58              
59             =cut
60              
61             sub new {
62 12 50   12 1 13018 my $class = ref $_[0] ? ref shift : shift;
63 12 50       34 my $string = defined $_[0] ? shift : return undef;
64              
65             # Create the object
66 12         63 my $self = bless {
67             topic => $string,
68             config => $string,
69             }, $class;
70              
71             # Extract the header URI
72 12 100       136 $self->{config} =~ s/^(\S+)\s*// or return undef;
73 9 50       61 $self->{URI} = URI->new("$1") or return undef;
74              
75             # Check the URI
76 9 100 100     17511 $self->{URI}->scheme and $self->{URI}->scheme eq 'threatnet' or return undef;
77 4 100 66     698 $self->{URI}->authority and $self->{URI}->authority or return undef;
78 3 100 66     143 $self->{URI}->path and $self->{URI}->path or return undef;
79              
80 2         56 $self;
81             }
82              
83             =pod
84              
85             =head2 topic
86              
87             Accessor method that returns the Topic as a topic string.
88              
89             =cut
90              
91 4     4 1 2518 sub topic { $_[0]->{topic} }
92              
93             =pod
94              
95             =head2 URI
96              
97             Accessor method that returns the protocol identifier as a URI object
98              
99             =cut
100              
101 4     4 1 36 sub URI { $_[0]->{URI} }
102              
103             =pod
104              
105             =head2 config
106              
107             Accessor method that returns the non-required protocol-specific part of
108             the topic, which is assumed to hold the channel configuration.
109              
110             =cut
111              
112 2     2 1 13 sub config { $_[0]->{config} }
113              
114             1;
115              
116             =pod
117              
118             =head1 SUPPORT
119              
120             All bugs should be filed via the bug tracker at
121              
122             L
123              
124             For other issues, or commercial enhancement and support, contact the author
125              
126             =head1 AUTHORS
127              
128             Adam Kennedy Eadamk@cpan.orgE
129              
130             =head1 SEE ALSO
131              
132             L
133              
134             =head1 COPYRIGHT
135              
136             Copyright (c) 2004 Adam Kennedy. All rights reserved.
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             =cut