equal
deleted
inserted
replaced
24 $DATA{fn}{$self} = $arg{file}; |
24 $DATA{fn}{$self} = $arg{file}; |
25 $DATA{fh}{$self} = my $fh = IO::File->new($DATA{fn}{$self}) |
25 $DATA{fh}{$self} = my $fh = IO::File->new($DATA{fn}{$self}) |
26 or die "Can't open $DATA{fn}{$self}: $!\n"; |
26 or die "Can't open $DATA{fn}{$self}: $!\n"; |
27 |
27 |
28 local $/ = ""; |
28 local $/ = ""; |
29 chomp($DATA{header}{$self} = <$fh>); |
29 chomp($DATA{header}{$self} = <$fh>); |
30 $DATA{body_pos}{$self} = tell($fh); |
30 $DATA{body_pos}{$self} = tell($fh); |
31 |
31 |
32 return $self; |
32 return $self; |
33 } |
33 } |
34 |
34 |
39 } |
39 } |
40 |
40 |
41 sub header_lines { |
41 sub header_lines { |
42 my $self = shift; |
42 my $self = shift; |
43 my $field = shift // qr/.*/; |
43 my $field = shift // qr/.*/; |
44 my @r = grep /$field/i => $DATA{header}{$self} =~ /(^\S+?[: ]\s*.*?\n)(?=^\S|\Z)/imsg; |
44 my @r = |
|
45 grep /$field/i => $DATA{header}{$self} =~ |
|
46 /(^\S+?[: ]\s*.*?\n)(?=^\S|\Z)/imsg; |
45 return @r if wantarray; |
47 return @r if wantarray; |
46 |
48 |
47 foreach (@r) { s/\s*?\n\s+/ /mg; } |
49 foreach (@r) { s/\s*?\n\s+/ /mg; } |
48 return join "" => @r; |
50 return join "" => @r; |
49 } |
51 } |
53 # my $pattern = shift // die "Need a pattern!"; |
55 # my $pattern = shift // die "Need a pattern!"; |
54 # $DATA{header}{$self} =~ s/^$pattern.*?(?=^\S|\Z)//imsg; |
56 # $DATA{header}{$self} =~ s/^$pattern.*?(?=^\S|\Z)//imsg; |
55 #} |
57 #} |
56 |
58 |
57 #sub add_header_line { |
59 #sub add_header_line { |
58 #my $self = shift; |
60 #my $self = shift; |
59 #my $_ = shift; |
61 #my $_ = shift; |
60 #$_ .= "\n" unless /\n$/; |
62 #$_ .= "\n" unless /\n$/; |
61 #$DATA{header}{$self} .= $_; |
63 #$DATA{header}{$self} .= $_; |
62 #} |
64 #} |
63 |
65 |
64 sub header_contents { |
66 sub header_contents { |
65 my $self = shift; |
67 my $self = shift; |
66 my $field = shift // qr/.*/; |
68 my $field = shift // qr/.*/; |
67 |
69 |
68 my @r = map { (split /[: ]/, $_, 2)[1] } $self->header_lines($field); |
70 my @r = map { (split /[: ]/, $_, 2)[1] } $self->header_lines($field); |
69 return @r if wantarray; |
71 return @r if wantarray; |
70 |
72 |
71 foreach (@r) { s/\s*?\n\s+/ /mg; } |
73 foreach (@r) { s/\s*?\n\s+/ /mg; } |
72 return join "" => @r; |
74 return join "" => @r; |
73 } |
75 } |
74 |
|
75 |
76 |
76 sub orig_header { |
77 sub orig_header { |
77 my $self = shift; |
78 my $self = shift; |
78 my $fh = $DATA{fh}{$self}; |
79 my $fh = $DATA{fh}{$self}; |
79 seek($fh, 0, 0); |
80 seek($fh, 0, 0); |
119 This is a simple parser for RFC2822 messages. I'm sure, such parsers |
120 This is a simple parser for RFC2822 messages. I'm sure, such parsers |
120 exists already about one million times. Here is yet another one. |
121 exists already about one million times. Here is yet another one. |
121 |
122 |
122 =head1 METHODS |
123 =head1 METHODS |
123 |
124 |
|
125 B<Note:> Whenever we mention a I<pattern>, you may pass the pattern |
|
126 as "qr/pattern/", giving you any freedom in choosing modifiers and so on, or |
|
127 you may pass the pattern simply as a string "pattern", this well then |
|
128 silently converted to "qr/pattern/i". |
|
129 |
124 =over |
130 =over |
125 |
131 |
126 =item B<new>(file => I<file>) |
132 =item B<new>(file => I<file>) |
127 |
133 |
128 The construcor. The file is opened r/o and read. The file will not be |
134 The construcor. The file is opened r/o and read. The file will not be |