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