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