File Coverage

blib/lib/Mail/SNCF.pm
Criterion Covered Total %
statement 41 49 83.6
branch 5 6 83.3
condition n/a
subroutine 6 9 66.6
pod 4 4 100.0
total 56 68 82.3


line stmt bran cond sub pod time code
1             package Mail::SNCF;
2              
3 6     6   79654 use warnings;
  6         12  
  6         225  
4 6     6   39 use strict;
  6         10  
  6         225  
5              
6 6     6   5964 use Data::Dump qw/dump/;
  6         55077  
  6         481  
7              
8 6     6   6390 use Email::Folder;
  6         133027  
  6         184  
9 6     6   4592 use MIME::QuotedPrint;
  6         9558  
  6         4489  
10              
11             =head1 NAME
12              
13             Mail::SNCF - A parser for booking messages sent by the French rail company
14              
15             =head1 VERSION
16              
17             Version 0.02
18              
19             =cut
20              
21             our $VERSION = '0.02';
22              
23              
24             =head1 SYNOPSIS
25              
26             This module is not intended to be used directly, instead, use
27             L, L or L.
28              
29             use Mail::SNCF::Backend;
30              
31             my $foo = Mail::SNCF::Backend->parse("Mail/sncf");
32             $foo->print;
33              
34             =head1 FUNCTIONS
35              
36             =head2 parse
37              
38             Parse a mail box (as supported by L) and create the
39             object.
40              
41             =cut
42              
43             sub parse {
44 5     5 1 191 my ($class, $folder_path) = @_;
45 5         62 my $folder = Email::Folder->new($folder_path);
46              
47 5         134787 my $self = [];
48 5         32 bless $self, $class;
49              
50 5         35 while (my $a = $folder->next_message()) {
51 45         78158 my $subject = $a->header("Subject");
52 45 50       2229 next unless $subject =~ /Confirmation.*(commande|voyage).*/;
53 45         164 my @lines = split /\n/, $a->body();
54 45         10287 for(my $i = 0; $i < @lines; $i++) {
55 3695 100       14854 next unless $lines[$i] =~ /=A0------------------------------------------------/;
56 240 100       828 next unless $lines[++$i] =~ /=A0TRAIN/;
57 81         205 while ($lines[$i] !~
58             /=A0------------------------------------------------/)
59             {
60 82         282 $i++;
61             }
62 81         373 my $line_from = decode_qp($lines[++$i]);
63 81         269 my $line_to = decode_qp($lines[++$i]);
64              
65 81         141 my $trip = {};
66            
67 81         596 $line_from =~ m!\s*:\s*((?:\w|\s)*\w)\s*-\s*(\d\d)h(\d\d)\s*-\s*(\d\d)/(\d\d)/(\d\d\d\d)!;
68 81         272 $trip->{from} = $1;
69 81         302 $trip->{start} = [$2, $3];
70 81         315 $trip->{date} = [$4, $5, $6];
71            
72 81         437 $line_to =~ m!\s*:\s*((?:\w|\s)*\w)\s*-\s*(\d\d)h(\d\d)!;
73 81         210 $trip->{to} = $1;
74 81         256 $trip->{end} = [$2, $3];
75              
76 81         105 push @{$self}, $trip;
  81         390  
77             }
78             }
79              
80 5         378 return $self;
81             }
82              
83             =head2 file
84              
85             Output to a file.
86              
87             =cut
88              
89             sub file {
90 0     0 1   my ($self, $file) = @_;
91 0           open FILE, ">", $file;
92 0           print FILE $self->as_string;
93 0           close FILE;
94             }
95              
96             =head2 print
97              
98             Print the data returned by as_string.
99              
100             =cut
101              
102             sub print {
103 0     0 1   my ($self) = @_;
104 0           print $self->as_string;
105             }
106              
107             =head2 as_string
108              
109             Give a string representation of the data.
110              
111             =cut
112              
113             sub as_string {
114 0     0 1   my ($self) = @_;
115 0           dump($self);
116             }
117              
118             =head1 AUTHOR
119              
120             Olivier Schwander, C<< >>
121              
122             =head1 BUGS
123              
124             Please report any bugs or feature requests to C, or through
125             the web interface at
126             L. I will be notified, and then you'll
127             automatically be notified of progress on your bug as I make changes.
128              
129             =head1 SUPPORT
130              
131             You can find documentation for this module with the perldoc command.
132              
133             perldoc Mail::SNCF
134              
135             You can also look for information at:
136              
137             =over 4
138              
139             =item * RT: CPAN's request tracker
140              
141             L
142              
143             =item * AnnoCPAN: Annotated CPAN documentation
144              
145             L
146              
147             =item * CPAN Ratings
148              
149             L
150              
151             =item * Search CPAN
152              
153             L
154              
155             =back
156              
157             =head1 COPYRIGHT & LICENSE
158              
159             Copyright 2009 Olivier Schwander, all rights reserved.
160              
161             This program is free software; you can redistribute it and/or modify it
162             under the same terms as Perl itself.
163              
164              
165             =cut
166              
167             1; # End of Mail::SNCF