File Coverage

blib/lib/WWW/Topica/Mail.pm
Criterion Covered Total %
statement 23 26 88.4
branch 1 2 50.0
condition 3 8 37.5
subroutine 8 9 88.8
pod 8 8 100.0
total 43 53 81.1


line stmt bran cond sub pod time code
1             package WWW::Topica::Mail;
2              
3 1     1   6 use strict;
  1         1  
  1         399  
4              
5             =pod
6              
7             =head1 NAME
8              
9             WWW::Topica::Mail - parse a single Topica mailing list mail
10              
11             =head1 SYNOPSIS
12              
13             my $index = WWW::Topic::Index->new($index_html);
14            
15             foreach my $mess_id ($index->message_ids) {
16             # the mail has some information and also provides a link to the reply ...
17             my $mail = WWW::Topica::Mail->new($topica->fetch_mail($mess_id), $mess_id);
18             # which has other information (like the un-htmled mail and the email address) ...
19             my $reply = WWW::Topica::Reply->new($topica->fetch_reply($mail->id, $mail->eto), $mail->id, $mail->eto);
20             }
21            
22             print "Next offset is ".$index->next."\n";
23             print "Previous offset is ".$index->prev."\n";
24              
25             =head1 DESCRIPTION
26              
27             Used to parse a single message page from Topica.com's mailing list indexes.
28              
29             Message pages have the subject and the date and time of the mail being sent as
30             well as a full name of each sender.
31              
32             =head1 METHODS
33              
34             =cut
35              
36              
37             =head2 new
38              
39             Takes the page html and the message-id and parses the html.
40              
41             =cut
42              
43              
44             sub new {
45 300     300 1 1048 my ($class, $html, $id) = @_;
46            
47 300         2985 my $self = { id => $id };
48            
49 300         6101 bless $self, $class;
50            
51 300         2001 $self->parse($html);
52            
53 300         1163 return $self;
54             }
55              
56              
57             =head2 parse
58              
59             Parse the html to get message ids and next & prev offsets.
60              
61             =cut
62              
63             sub parse {
64 300     300 1 931 my ($self, $html) = @_;
65              
66            
67 300         13587 ($self->{eto},undef,$self->{from}) = ($html =~ m!window.open\('/lists/[^/]+/read/post.html\?mode\=replytosender\&mid=\d+\&eto\=([^']+)'(.+?)return true">(.+?)!s);
68 300 50       1677 if (!defined $self->{eto}) {
69 0         0 ($self->{from}) = ($html =~ m! ([^<]+)!s);
70             }
71 300         6226 (undef,$self->{date}) = ($html =~ m!http://lists.topica.com/lists/read/images/icon_clock.gif(.+?)(.+?) <\/NOBR>!s);
72 300         8196 (undef, $self->{subject}) = ($html =~ m!(.+?)!s);
73 300         6470 ($self->{body}) = ($html =~ m! (.+?)!s);
74              
75             }
76              
77             =head2 id
78              
79             Get the id of this mail
80              
81             =cut
82              
83             sub id {
84 300     300 1 1568 return $_[0]->{id};
85             }
86              
87             =head2 eto
88              
89             Get the eto of the next reply we need to get
90              
91             =cut
92              
93             sub eto {
94 1200     1200 1 2492 my $self = shift;
95            
96 1200         10918 return $self->{eto};
97              
98             }
99              
100             =head2 date
101              
102             Get the date of this mail
103              
104             =cut
105              
106             sub date {
107 300   50 300 1 1380 my $date = $_[0]->{date} || "";
108            
109 300         6133 return $date;
110             }
111              
112             =head2 subject
113              
114             The subject of the mail
115              
116             =cut
117              
118             sub subject {
119 300   50 300 1 1239 my $subject = $_[0]->{subject} || "";
120 300         1159 return $subject;
121             }
122              
123             =head2 from
124              
125             Get the name of the person it was from
126              
127             =cut
128              
129             sub from {
130 300   50 300 1 1583 my $from = $_[0]->{from} || "";
131 300         2695 return $from;
132             }
133              
134             =head2 body
135              
136             Get the body of the mail.
137              
138             =cut
139              
140             sub body {
141 0   0 0 1   my $body = $_[0]->{body} || "";
142 0           return $body;
143             }
144              
145             1;
146              
147             =head1 AUTHOR
148              
149             Simon Wistow
150              
151             =head1 COPYRIGHT
152              
153             Copyright (c) 2004, Simon Wistow
154              
155             =cut
156              
157              
158