1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
use strict;
use warnings;
package Email::FolderType;
{
$Email::FolderType::VERSION = '0.814';
}
# ABSTRACT: Email::FolderType - determine the type of a mail folder
use Module::Pluggable search_path => "Email::FolderType",
require => 1,
sub_name => 'matchers';
use Exporter 5.57 'import';
our @EXPORT_OK = qw(folder_type);
our $DEFAULT = 'Mbox';
sub folder_type ($) {
my $folder = shift;
my $package = __PACKAGE__;
no strict 'refs';
foreach my $class ($package->matchers) {
my $type = $class;
$type =~ s!^$package\:\:!!;
next if $type eq $DEFAULT; # delay till later since it's the default
my $return;
eval {
$return = &{"$class\::match"}($folder);
};
return $type if $return;
}
# default
return $DEFAULT if &{"$package\::$DEFAULT\::match"}($folder);
return undef;
}
1;
__END__
=pod
=head1 NAME
Email::FolderType - Email::FolderType - determine the type of a mail folder
=head1 VERSION
version 0.814
=head1 SYNOPSIS
use Email::FolderType qw(folder_type);
print folder_type "~/mymbox"; # prints 'Mbox'
print folder_type "~/a_maildir/"; # prints 'Maildir'
print folder_type "some_mh/."; # prints 'MH'
print folder_type "an_archive//"; # prints 'Ezmlm'
=head1 DESCRIPTION
Provides a utility subroutine for detecting the type of a given mail
folder.
=head1 SUBROUTINES
=head2 folder_type <path>
Automatically detects what type of mail folder the path refers to and
returns the name of that type.
It primarily bases the type on the suffix of the path given.
Suffix | Type
--------+---------
/ | Maildir
/. | MH
// | Ezmlm
In case of no known suffix it checks for a known file structure. If
that doesn't work out it defaults to C<Mbox> although, if the C<Mbox>
matcher has been overridden or the default changed (see B<DEFAULT MATCHER>
below) then it will return undef.
=head2 matchers
Returns a list of all the matchers available to the system.
=head1 DEFAULT MATCHER
Currently the default matcher is C<Mbox> and therefore it is always
checked last and always returns C<1>.
If you really want to change this then you should override C<Email::FolderType::Mbox::match>
and/or change the variable C<$Email::FolderType::DEFAULT> to be something other than C<'Mbox'>.
use Email::FolderType;
use Email::FolderType::Mbox;
$Email::FolderType::DEFAULT = 'NewDefault';
package Email::FolderType::Mbox;
sub match { return (defined $_[0] && -f $_[0]) }
package Email::FolderType::NewDefault;
sub match { return (defined $_[0] && $_[0] =~ m!some crazy pattern!) }
1;
=head1 REGISTERING NEW TYPES
C<Email::FolderType> briefly flirted with a rather clunky C<register_type>
method for registering new matchers but, in retrospect that wasn't a great
idea.
Instead, in this version we've reverted to a C<Module::Pluggable> based system -
any classes in the C<Email::FolderType::> namespace will be interrogated to see
if they have a c<match> method.
If they do then it will be passed the folder name. If the folder matches then
the match function should return C<1>. For example ...
package Email::FolderType::GzippedMbox;
sub match {
my $folder = shift;
return (-f $folder && $folder =~ /.gz$/);
}
1;
These can even be defined inline ...
#!perl -w
use strict;
use Email::Folder;
use Email::LocalDelivery;
# copy all mail from an IMAP folder
my $folder = Email::Folder->new('imap://example.com'); # read INBOX
for ($folder->messages) {
Email::LocalDelivery->deliver($_->as_string, 'local_mbox');
}
package Email::FolderType::IMAP;
sub match {
my $folder = shift;
return $folder =~ m!^imap://!;
}
1;
If there is demand for a compatability shim for the old C<register_type>
method then we can implement one. Really though, this is much better in
the long run.
=head1 AUTHOR
Simon Wistow <simon@thegestalt.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2005 by Simon Wistow.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|
