File Coverage

blib/lib/Mail/Cache.pm
Criterion Covered Total %
statement 12 410 2.9
branch 0 120 0.0
condition n/a
subroutine 4 22 18.1
pod 18 18 100.0
total 34 570 5.9


line stmt bran cond sub pod time code
1             package Mail::Cache;
2              
3 1     1   19632 use warnings;
  1         3  
  1         25  
4 1     1   7 use strict;
  1         2  
  1         35  
5 1     1   804 use File::BaseDir qw/xdg_cache_home/;
  1         1209  
  1         63  
6 1     1   741 use Email::Simple;
  1         5135  
  1         3332  
7              
8              
9             =head1 NAME
10              
11             Mail::Cache - Caches mail info.
12              
13             =head1 VERSION
14              
15             Version 0.1.2
16              
17             =cut
18              
19             our $VERSION = '0.1.2';
20              
21              
22             =head1 SYNOPSIS
23              
24             use Mail::Cache;
25              
26             my $mc = Mail::Cache->new();
27              
28             #init for the module 'ZConf::Mail' for a IMAP account named 'foo@bar' for the box 'INBOX'
29             $mc->init('ZConf::Mail', 'imap', 'foo@bar', 'INBOX');
30              
31             #populate a cache from a Mail::IMAPTalk object
32             $imap->select('INBOX');
33             my $sorted=$imap->sort('(subject)', 'UTF8', 'NOT', 'DELETED');
34             my $int=0;
35             while(defined($sorted->[$int])){
36             my $headers=$imap->fetch($sorted->[$int], 'rfc822.header');
37             my $size=$imap->fetch($sorted->[$int], 'rfc822.size');
38             $mc->setUID($sorted->[$int], $headers->{$sorted->[$int]}{'rfc822.header'},
39             $size->{$sorted->[$int]}{'rfc822.size'});
40             if($mc->{error}){
41             print "Error!\n";
42             }
43             $int++;
44             }
45              
46             =head1 METHODS
47              
48             =head2 new
49              
50             =cut
51              
52             sub new {
53 0     0 1   my $home=xdg_cache_home.'/Mail::Cache/';
54              
55 0           my $self={error=>undef, errorString=>'', inline=>0,
56             home=>xdg_cache_home.'/Mail::Cache/', cache=>'Mail::Cache',
57             account=>'default', type=>'imap', box=>'INBOX'};
58 0           bless $self;
59              
60             #make sure $self->{home} exists and if not try to create it
61 0 0         if (! -e xdg_cache_home) {
62 0 0         if (!mkdir(xdg_cache_home)) {
63 0           $self->{error}=1;
64 0           $self->{errorString}='Could not create xdg_cache_home,"'.xdg_cache_home.'"';
65 0           warn('Mail-Cache new:1: '.$self->{errorString});
66 0           return $self;
67             }
68             }
69 0 0         if (! -e $self->{home}) {
70 0 0         if (!mkdir($self->{home})) {
71 0           $self->{error}=2;
72 0           $self->{errorString}='Could not create xdg_cache_home."Mail::Cache", "'.
73             $self->{home}.'"';
74 0           warn('Mail-Cache new:2: '.$self->{errorString});
75 0           return $self;
76             }
77             }
78              
79 0           return $self;
80             }
81              
82             =head2 getAccount
83              
84             This sets the account that is currently being worked with.
85              
86             my $account=$mc->getAccount;
87              
88             =cut
89              
90             sub getAccount{
91 0     0 1   $_[0]->errorblank;
92 0           return $_[0]->{account};
93             }
94              
95             =head2 getBox
96              
97             This gets the current mail box being used.
98              
99             my $box=$mc->getBox;
100              
101             =cut
102              
103             sub getBox{
104 0     0 1   $_[0]->errorblank;
105 0           return $_[0]->{box};
106             }
107              
108             =head2 getCache
109              
110             This gets the name of the current cache.
111              
112             my $cache=$mc->getCache;
113              
114             =cut
115              
116             sub getCache{
117 0     0 1   $_[0]->errorblank;
118 0           return $_[0]->{cache};
119             }
120              
121             =head2 getDates
122              
123             This fetches a parsed hash of the dates.
124              
125             The returned hash has the UIDs as the keys and the value for
126             each hash entry is the the date from the header.
127              
128             my %dates=$mc->getDates;
129             if($mc->{error}){
130             print "Error!\n";
131             }
132              
133             =cut
134              
135             sub getDates{
136 0     0 1   my $self=$_[0];
137              
138 0           my $dir=$self->{home}.'/'.$self->{cache}.'/'.$self->{type}.'/'.
139             $self->{account}.'/'.$self->{box}.'/';
140              
141             #make sure the directory and the size cache exist
142 0 0         if (! -e $dir) {
143 0           $self->{error}=15;
144 0           $self->{errorString}='"'.$dir.'" does not exist';
145 0           warn('Mail-Cache getDates:15: '.$self->{errorString});
146 0           return undef;
147             }
148 0 0         if (! -e $dir.'.Date') {
149 0           $self->{error}=16;
150 0           $self->{errorString}='"'.$dir.'.Size" does not exist';
151 0           warn('Mail-Cache getDates:16: '.$self->{errorString});
152 0           return undef;
153             }
154              
155             #read it into @dates
156 0           open(GETDATESFH, $dir.'.Date');
157 0           my @dates=;
158 0           close(GETDATESFH);
159              
160             #this is what will be returned
161 0           my %toreturn;
162              
163             #go through each one
164 0           my $int=0;
165 0           while (defined($dates[$int])) {
166 0           chomp($dates[$int]);
167              
168 0           my @linesplit=split(/\|/, $dates[$int], 2);
169              
170             #warn if a line is corrupt
171 0 0         if (!defined($linesplit[1])) {
172 0           warn('Mail-Cache getDates: line "'.$int.'" appears corrupt... '.$dates[$int]);
173             }else {
174 0           $toreturn{$linesplit[0]}=$linesplit[1];
175             }
176              
177 0           $int++;
178             }
179              
180 0           return %toreturn;
181             }
182              
183             =head2 getSizes
184              
185             This fetches a parsed hash of the subjects.
186              
187             The returned hash has the UIDs as the keys and the value for
188             each hash entry is the the subject.
189              
190             my %subjects=$mc->getSizes;
191             if($mc->{error}){
192             print "Error!\n";
193             }
194              
195             =cut
196              
197             sub getSizes{
198 0     0 1   my $self=$_[0];
199              
200 0           my $dir=$self->{home}.'/'.$self->{cache}.'/'.$self->{type}.'/'.
201             $self->{account}.'/'.$self->{box}.'/';
202              
203             #make sure the directory and the size cache exist
204 0 0         if (! -e $dir) {
205 0           $self->{error}=15;
206 0           $self->{errorString}='"'.$dir.'" does not exist';
207 0           warn('Mail-Cache getSizes:15: '.$self->{errorString});
208 0           return undef;
209             }
210 0 0         if (! -e $dir.'.size') {
211 0           $self->{error}=16;
212 0           $self->{errorString}='"'.$dir.'.Size" does not exist';
213 0           warn('Mail-Cache getSizes:16: '.$self->{errorString});
214 0           return undef;
215             }
216              
217             #read it into @sizes
218 0           open(GETSIZES, $dir.'.size');
219 0           my @sizes=;
220 0           close(GETSIZES);
221              
222             #this is what will be returned
223 0           my %toreturn;
224              
225             #go through each one
226 0           my $int=0;
227 0           while (defined($sizes[$int])) {
228 0           chomp($sizes[$int]);
229              
230 0           my @linesplit=split(/\|/, $sizes[$int], 2);
231              
232             #warn if a line is corrupt
233 0 0         if (!defined($linesplit[1])) {
234 0           warn('Mail-Cache getSizes: line "'.$int.'" appears corrupt... '.$sizes[$int]);
235             }else {
236 0           $toreturn{$linesplit[0]}=$linesplit[1];
237             }
238              
239 0           $int++;
240             }
241              
242 0           return %toreturn;
243             }
244              
245             =head2 getFroms
246              
247             This fetches a parsed hash of the froms.
248              
249             The returned hash has the UIDs as the keys and the value for
250             each hash entry is the the froms.
251              
252             my %sizes=$mc->getSizes;
253             if($mc->{error}){
254             print "Error!\n";
255             }
256              
257             =cut
258              
259             sub getFroms{
260 0     0 1   my $self=$_[0];
261              
262 0           my $dir=$self->{home}.'/'.$self->{cache}.'/'.$self->{type}.'/'.
263             $self->{account}.'/'.$self->{box}.'/';
264              
265             #make sure the directory and the size cache exist
266 0 0         if (! -e $dir) {
267 0           $self->{error}=15;
268 0           $self->{errorString}='"'.$dir.'" does not exist';
269 0           warn('Mail-Cache getFroms:15: '.$self->{errorString});
270 0           return undef;
271             }
272 0 0         if (! -e $dir.'.From') {
273 0           $self->{error}=16;
274 0           $self->{errorString}='"'.$dir.'.Size" does not exist';
275 0           warn('Mail-Cache getFroms:16: '.$self->{errorString});
276 0           return undef;
277             }
278              
279             #read it into @froms
280 0           open(GETFROMS, $dir.'.From');
281 0           my @froms=;
282 0           close(GETFROMS);
283              
284             #this is what will be returned
285 0           my %toreturn;
286              
287             #go through each one
288 0           my $int=0;
289 0           while (defined($froms[$int])) {
290 0           chomp($froms[$int]);
291              
292 0           my @linesplit=split(/\|/, $froms[$int], 2);
293              
294             #warn if a line is corrupt
295 0 0         if (!defined($linesplit[1])) {
296 0           warn('Mail-Cache getFroms: line "'.$int.'" appears corrupt... '.$froms[$int]);
297             }else {
298 0           $toreturn{$linesplit[0]}=$linesplit[1];
299             }
300              
301 0           $int++;
302             }
303              
304 0           return %toreturn;
305             }
306              
307             =head2 getSubjects
308              
309             This fetches a parsed hash of the sizes.
310              
311             The returned hash has the UIDs as the keys and the value for
312             each hash entry is the the size.
313              
314             my %sizes=$mc->getSizes;
315             if($mc->{error}){
316             print "Error!\n";
317             }
318              
319             =cut
320              
321             sub getSubjects{
322 0     0 1   my $self=$_[0];
323              
324 0           my $dir=$self->{home}.'/'.$self->{cache}.'/'.$self->{type}.'/'.
325             $self->{account}.'/'.$self->{box}.'/';
326              
327             #make sure the directory and the size cache exist
328 0 0         if (! -e $dir) {
329 0           $self->{error}=15;
330 0           $self->{errorString}='"'.$dir.'" does not exist';
331 0           warn('Mail-Cache getSubjects:15: '.$self->{errorString});
332 0           return undef;
333             }
334 0 0         if (! -e $dir.'.Subject') {
335 0           $self->{error}=16;
336 0           $self->{errorString}='"'.$dir.'.Size" does not exist';
337 0           warn('Mail-Cache getSubjects:16: '.$self->{errorString});
338 0           return undef;
339             }
340              
341             #read it into @subjects
342 0           open(GETSUBJECTS, $dir.'.Subject');
343 0           my @subjects=;
344 0           close(GETSUBJECTS);
345              
346             #this is what will be returned
347 0           my %toreturn;
348              
349             #go through each one
350 0           my $int=0;
351 0           while (defined($subjects[$int])) {
352 0           chomp($subjects[$int]);
353              
354 0           my @linesplit=split(/\|/, $subjects[$int], 2);
355              
356             #warn if a line is corrupt
357 0 0         if (!defined($linesplit[1])) {
358 0           warn('Mail-Cache getSubjects: line "'.$int.'" appears corrupt... '.$subjects[$int]);
359             }else {
360 0           $toreturn{$linesplit[0]}=$linesplit[1];
361             }
362              
363 0           $int++;
364             }
365              
366 0           return %toreturn;
367             }
368              
369             =head2 getType
370              
371             This gets the current type.
372              
373             my $type=$mc->getType;
374              
375             =cut
376              
377             sub getType{
378 0     0 1   $_[0]->errorblank;
379 0           return $_[0]->{type};
380             }
381              
382             =head2 init
383              
384             A short cut to calling the three different set methods.
385              
386             $mc->init($cache, $type, $account, $box);
387             if($mc->{error}){
388             print "Error!\n";
389             }
390              
391             =cut
392              
393             sub init{
394 0     0 1   my $self=$_[0];
395 0           my $cache=$_[1];
396 0           my $type=$_[2];
397 0           my $account=$_[3];
398 0           my $box=$_[4];
399              
400 0           $self->errorblank;
401              
402 0           $self->setCache($cache);
403 0 0         if ($self->{error}) {
404 0           warn('Mail-Cache init: setCache failed');
405 0           return undef;
406             }
407              
408 0           $self->setType($type);
409 0 0         if ($self->{error}) {
410 0           warn('Mail-Cache init: setType failed');
411 0           return undef;
412             }
413              
414 0           $self->setAccount($account);
415 0 0         if ($self->{error}) {
416 0           warn('Mail-Cache init: setAccount failed');
417 0           return undef;
418             }
419              
420 0           $self->setBox($box);
421 0 0         if ($self->{error}) {
422 0           warn('Mail-Cache init: setBox failed');
423 0           return undef;
424             }
425              
426 0           return 1;
427             }
428              
429             =head2 listUIDs
430              
431             This gets a list of UIDs.
432              
433             my @uids=$mc->listUIDs;
434             if($mc->{error}){
435             print "Error!\n";
436             }
437              
438             =cut
439              
440             sub listUIDs{
441 0     0 1   my $self=$_[0];
442              
443 0           $self->errorblank;
444              
445 0           my $dir=$self->{home}.'/'.$self->{cache}.'/'.$self->{type}.'/'.
446             $self->{account}.'/'.$self->{box}.'/';
447              
448 0 0         if (! -e $dir) {
449 0           $self->{error}=15;
450 0           $self->{errorString}='"'.$dir.'" does not exist';
451 0           warn('Mail-Cache listUIDs:15: '.$self->{errorString});
452 0           return undef;
453             }
454              
455 0           opendir(LISTUIDS, $dir);
456 0           my @uids=grep(!/^\./, readdir(LISTUIDS));
457 0           closedir(LISTUIDS);
458              
459 0           return @uids;
460             }
461              
462             =head2 removeUIDs
463              
464             This removes a array of specified UIDs. This is used for cleaning it up.
465             See Mail::IMAPTalk::MailCache for a example of how to use this.
466              
467             $mc->removeUIDs(\@uids);
468              
469             =cut
470              
471             sub removeUIDs{
472 0     0 1   my $self=$_[0];
473 0           my @uids;
474 0 0         if (defined($_[1])) {
475 0           @uids=@{$_[1]};
  0            
476             }
477              
478 0           $self->errorblank;
479              
480             #if nothing is given, no reason to go ahead with the rest
481 0 0         if (!defined($uids[0])) {
482 0           return 1;
483             }
484              
485 0           my $dir=$self->{home}.'/'.$self->{cache}.'/'.$self->{type}.'/'.
486             $self->{account}.'/'.$self->{box}.'/';
487              
488             #gets the subject cache
489 0           open(SUBJECTREAD, '<', $dir.'/.Subject');
490 0           my @subjectcache=;
491 0           close(SUBJECTREAD);
492              
493             #gets the from cache
494 0           open(FROMREAD, '<', $dir.'/.From');
495 0           my @fromcache=;
496 0           close(FROMREAD);
497              
498             #gets the date cache
499 0           open(DATEREAD, '<', $dir.'/.Date');
500 0           my @datecache=;
501 0           close(DATEREAD);
502              
503             #get the size cache
504 0           open(SIZEREAD, '<', $dir.'/.size');
505 0           my @sizecache=;
506 0           close(SIZEREAD);
507              
508             #process each one
509 0           my $int=0;
510 0           while (defined($uids[$int])) {
511 0           my $uid=$uids[$int];
512              
513 0           my $process=1;
514              
515 0 0         if ($uid=~/^\./) {
516 0           $process=0;
517             }
518              
519 0 0         if ($uid=~/\//) {
520 0           $process=0;
521             }
522              
523 0 0         if ($uid=~/\\/) {
524 0           $process=0;
525             }
526              
527             #should never start with a . or match /
528 0 0         if ($process) {
529             #remove the old subject
530 0           my $subjectremove='^'.quotemeta($uid).'\|';
531 0           @subjectcache=grep(!/$subjectremove/, @subjectcache);
532            
533             #remove the old from
534 0           my $fromremove='^'.quotemeta($uid).'\|';
535 0           @fromcache=grep(!/$fromremove/, @subjectcache);
536            
537             #removes the old date
538 0           my $dateremove='^'.quotemeta($uid).'\|';
539 0           @datecache=grep(!/$dateremove/, @datecache);
540            
541             #removes the old size
542 0           my $sizeremove='^'.quotemeta($uid).'\|';
543 0           @sizecache=grep(!/$sizeremove/, @sizecache);
544              
545             #remove the header file if it exists
546 0 0         if (-f $dir.'/'.$uid) {
547 0           unlink($dir.'/'.$uid);
548             }
549             }
550              
551 0           $int++;
552             }
553              
554             #write the subject info out
555 0           open(SUBJECTWRITE, '>', $dir.'/.Subject');
556 0           print SUBJECTWRITE join('', @subjectcache);
557 0           close(SUBJECTWRITE);
558              
559             #write the from cache
560 0           open(FROMWRITE, '>', $dir.'/.From');
561 0           print FROMWRITE join('', @fromcache);
562 0           close(FROMWRITE);
563              
564             #write the date cache
565 0           open(DATEWRITE, '>', $dir.'/.Date');
566 0           print DATEWRITE join('', @datecache);
567 0           close(DATEWRITE);
568              
569             #write the size cache
570 0           open(SIZEWRITE, '>', $dir.'/.size');
571 0           print SIZEWRITE join('', @sizecache);
572 0           close(SIZEWRITE);
573              
574 0           return 1;
575             }
576              
577             =head2 setAccount
578              
579             This sets the account that is currently being worked on. The
580             default is 'default'.
581              
582             A value of '' or undef will set it back to the default.
583              
584             =cut
585              
586             sub setAccount{
587 0     0 1   my $self=$_[0];
588 0           my $account=$_[1];
589              
590 0           $self->errorblank;
591              
592             #handles resetting it if needed
593 0 0         if (!defined($account)) {
594 0           $account='default';
595             }
596 0 0         if ($account eq '') {
597 0           $account='default'
598             }
599              
600             #make sure it does not contain a '/'
601 0 0         if ($account=~/\//) {
602 0           $self->{error}=6;
603 0           $self->{errorString}='Account name, "'.$account.'", contains a "/"';
604 0           warn('Mail-Cache setAccount:6: '.$self->{errorString});
605 0           return undef;
606             }
607              
608             #attempts to create it if it does not exist
609 0           my $dir=$self->{home}.$self->{cache}.'/'.$self->{type}.'/'.$account.'/';
610 0 0         if (! -e $dir) {
611 0 0         if (!mkdir($dir)){
612 0           $self->{error}=7;
613 0           $self->{errorString}='Faile to create the cache, "'.$dir.'/"';
614 0           warn('Mail-Cache setAccount:7: '.$self->{errorString});
615 0           return undef;
616             }
617             }
618              
619 0           $self->{account}=$account;
620              
621 0           return 1;
622             }
623              
624             =head2 setBox
625              
626             This sets the current box in use.
627              
628             A value of '' or undef will set it back to the default,
629             'INBOX'.
630              
631             =cut
632              
633             sub setBox{
634 0     0 1   my $self=$_[0];
635 0           my $box=$_[1];
636              
637 0           $self->errorblank;
638              
639              
640             #handles resetting it if needed
641 0 0         if (!defined($box)) {
642 0           $box='INBOX';
643             }
644 0 0         if ($box eq '') {
645 0           $box='INBOX';
646             }
647              
648             #make sure it does not contain a '/'
649 0 0         if ($box=~/\//) {
650 0           $self->{error}=13;
651 0           $self->{errorString}='Box name, "'.$box.'", contains a "/"';
652 0           warn('Mail-Cache setBox:13: '.$self->{errorString});
653 0           return undef;
654             }
655              
656             #attempts to create it if it does not exist
657 0           my $dir=$self->{home}.$self->{cache}.'/'.$self->{type}.'/'.
658             $self->{account}.'/'.$box.'/';
659 0 0         if (! -e $dir) {
660 0 0         if (!mkdir($dir)){
661 0           $self->{error}=14;
662 0           $self->{errorString}='Faile to create the box, "'.$dir.'/"';
663 0           warn('Mail-Cache setBox:14: '.$self->{errorString});
664 0           return undef;
665             }
666             }
667              
668 0 0         if (! -e $dir.'/.Date') {
669 0           open(CREATEDATE, '>', $dir.'/.Date');
670 0           print CREATEDATE '';
671 0           close(CREATEDATE);
672             }
673 0 0         if (! -e $dir.'/.From') {
674 0           open(CREATEFROM, '>', $dir.'/.From');
675 0           print CREATEFROM '';
676 0           close(CREATEFROM);
677             }
678 0 0         if (! -e $dir.'/.Subject') {
679 0           open(CREATESUBJECT, '>', $dir.'/.Subject');
680 0           print CREATESUBJECT '';
681 0           close(CREATESUBJECT);
682             }
683 0 0         if (! -e $dir.'/.size') {
684 0           open(CREATESIZE, '>', $dir.'/.size');
685 0           print CREATESIZE '';
686 0           close(CREATESIZE);
687             }
688              
689 0           $self->{box}=$box;
690              
691 0           return 1;
692             }
693              
694             =head2 setCache
695              
696             This sets the name cache.
697              
698             A value of '' or undef will set it back to the default,
699             'Mail::Cache'.
700              
701             #set the cache name to ZConf::Mail
702             $mc->setCache('ZConf::Mail');
703             if($mc->{error}){
704             print "Error!\n";
705             }
706              
707             =cut
708              
709             sub setCache{
710 0     0 1   my $self=$_[0];
711 0           my $cache=$_[1];
712              
713 0           $self->errorblank;
714              
715             #handles resettting it if needed
716 0 0         if (!defined($cache)) {
717 0           $cache='Mail::Cache';
718             }
719 0 0         if ($cache eq '') {
720 0           $cache='Mail::Cache';
721             }
722              
723             #make sure it does not contain a '/'
724 0 0         if ($cache=~/\//) {
725 0           $self->{error}=3;
726 0           $self->{errorString}='Cache name, "'.$cache.'", contains a "/"';
727 0           warn('Mail-Cache setCache:3: '.$self->{errorString});
728 0           return undef;
729             }
730              
731             #attempts to create it if it does not exist
732 0 0         if (! -e $self->{home}.$cache) {
733 0 0         if (!mkdir($self->{home}.$cache)){
734 0           $self->{error}=4;
735 0           $self->{errorString}='Faile to create the cache, "'.$self->{home}.$cache.'/"';
736 0           warn('Mail-Cache setCache:4: '.$self->{errorString});
737 0           return undef;
738             }
739             }
740              
741 0           $self->{cache}=$cache;
742              
743 0           return 1;
744             }
745              
746             =head2 setType
747              
748             This sets what source of what is being cached. The default is 'imap'.
749              
750             Regardless of what it is set to, it will be converted to lower case.
751              
752             A value of '' or undef will set it back to the default.
753              
754             $mc->setType('imap');
755             if($mc->{error}){
756             print "Error!\n";
757             }
758              
759             =cut
760              
761             sub setType{
762 0     0 1   my $self=$_[0];
763 0           my $type=$_[1];
764              
765 0           $self->errorblank;
766              
767             #handles resetting it if needed
768 0 0         if (!defined($type)) {
769 0           $type='imap';
770             }
771 0 0         if ($type eq '') {
772 0           $type='imap'
773             }
774              
775             #make sure we have it in lower case
776 0           $type=lc($type);
777              
778             #make sure it does not contain a '/'
779 0 0         if ($type=~/\//) {
780 0           $self->{error}=5;
781 0           $self->{errorString}='Type name, "'.$type.'", contains a "/"';
782 0           warn('Mail-Cache setType:5: '.$self->{errorString});
783 0           return undef;
784             }
785              
786             #attempts to create it if it does not exist
787 0           my $dir=$self->{home}.$self->{cache}.'/'.$type;
788 0 0         if (! -e $dir) {
789 0 0         if (!mkdir($dir)){
790 0           $self->{error}=4;
791 0           $self->{errorString}='Faile to create the cache, "'.$dir.'/"';
792 0           warn('Mail-Cache setType:4: '.$self->{errorString});
793 0           return undef;
794             }
795             }
796              
797 0           $self->{type}=$type;
798              
799 0           return 1;
800             }
801              
802             =head2 setUID
803              
804             This sets the cache for a message. If it does not already exist, it will be
805             added. If it does exist, it will be overwritten.
806              
807             $mc->setUID($uid, $headers, $size);
808             if($mc->{error}){
809             print "Error!\n";
810             }
811              
812             =cut
813              
814             sub setUID{
815 0     0 1   my $self=$_[0];
816 0           my $uid=$_[1];
817 0           my $headers=$_[2];
818 0           my $size=$_[3];
819              
820 0           $self->errorblank;
821              
822             #make sure we have everything :)
823 0 0         if (!defined($uid)) {
824 0           $self->{error}=8;
825 0           $self->{errorString}='No UID specified';
826 0           warn('Mail-Cache setUID:8: '.$self->{errorString});
827 0           return undef;
828             }
829 0 0         if (!defined($headers)) {
830 0           $self->{error}=10;
831 0           $self->{errorString}='No headers specified';
832 0           warn('Mail-Cache setUID:10: '.$self->{errorString});
833 0           return undef;
834             }
835 0 0         if (!defined($size)) {
836 0           $self->{error}=11;
837 0           $self->{errorString}='No UID specified';
838 0           warn('Mail-Cache setUID:11: '.$self->{errorString});
839 0           return undef;
840             }
841              
842             #a UID should be just numberic and should definitely not begin with a /^\./ or /\|/
843 0 0         if ($uid =~ /^\./) {
844 0           $self->{error}=9;
845 0           $self->{errorString}='The UID matches /^\./';
846 0           warn('Mail-Cache setUID:9: '.$self->{errorString});
847 0           return undef;
848             }
849 0 0         if ($uid =~ /^\|/) {
850 0           $self->{error}=12;
851 0           $self->{errorString}='The UID matches /^\|/';
852 0           warn('Mail-Cache setUID:12: '.$self->{errorString});
853 0           return undef;
854             }
855              
856 0           my $es=Email::Simple->new($headers);
857              
858 0           my $subject=$es->header('Subject');
859 0 0         if (!defined($subject)) {
860 0           $subject='';
861             }
862              
863 0           my $from=$es->header('From');
864 0 0         if (!defined($from)) {
865 0           $from='';
866             }
867              
868 0           my $date=$es->header('Date');
869 0 0         if (!defined($date)) {
870 0           $date='';
871             }
872              
873 0           my $dir=$self->{home}.'/'.$self->{cache}.'/'.$self->{type}.'/'.
874             $self->{account}.'/'.$self->{box}.'/';
875              
876             #handles reading the subject cache removing any old entries and readding it
877 0           my $subjectline=$uid.'|'.$subject."\n";
878 0           my $subjectremove='^'.quotemeta($uid).'\|';
879 0           open(SUBJECTREAD, '<', $dir.'/.Subject');
880 0           my @subjectcache=grep(!/$subjectremove/, );
881 0           close(SUBJECTREAD);
882 0           push(@subjectcache, $subjectline);
883 0           open(SUBJECTWRITE, '>', $dir.'/.Subject');
884 0           print SUBJECTWRITE join('', @subjectcache);
885 0           close(SUBJECTWRITE);
886              
887             #handles reading the from cache reming any old entries and readding it
888 0           my $fromline=$uid.'|'.$from."\n";
889 0           my $fromremove='^'.quotemeta($uid).'\|';
890 0           open(FROMREAD, '<', $dir.'/.From');
891 0           my @fromcache=grep(!/$fromremove/, );
892 0           close(FROMREAD);
893 0           push(@fromcache, $fromline);
894 0           open(FROMWRITE, '>', $dir.'/.From');
895 0           print FROMWRITE join('', @fromcache);
896 0           close(FROMWRITE);
897              
898             #handles reading the date cache reming any old entries and readding it
899 0           my $dateline=$uid.'|'.$date."\n";
900 0           my $dateremove='^'.quotemeta($uid).'\|';
901 0           open(DATEREAD, '<', $dir.'/.Date');
902 0           my @datecache=grep(!/$dateremove/, );
903 0           close(DATEREAD);
904 0           push(@datecache, $dateline);
905 0           open(DATEWRITE, '>', $dir.'/.Date');
906 0           print DATEWRITE join('', @datecache);
907 0           close(DATEWRITE);
908              
909             #handles reading the date cache reming any old entries and readding it
910 0           my $sizeline=$uid.'|'.$size."\n";
911 0           my $sizeremove='^'.quotemeta($uid).'\|';
912 0           open(SIZEREAD, '<', $dir.'/.size');
913 0           my @sizecache=grep(!/$sizeremove/, );
914 0           close(SIZEREAD);
915 0           push(@sizecache, $sizeline);
916 0           open(SIZEWRITE, '>', $dir.'/.size');
917 0           print SIZEWRITE join('', @sizecache);
918 0           close(SIZEWRITE);
919              
920             #writes the headers to a file
921 0           open(HEADERWRITE, '>', $dir.'/'.$uid);
922 0           print HEADERWRITE $headers;
923 0           close(HEADERWRITE);
924              
925 0           return 1;
926             }
927              
928             =head2 errorblank
929              
930             A internal functions that blanks any previous error.
931              
932             =cut
933              
934             sub errorblank{
935 0     0 1   $_[0]->{error}=undef;
936 0           $_[0]->{errorString}='';
937             }
938              
939             =head1 CACHE LAYOUT
940              
941             The cache exists under "xdg_cache_home.'/Mail::Cache/'". So the default
942             location would be "~/.cache/Mail::Cache/".
943              
944             Under the cache home directory is the directories representing various caches.
945             If none is specified it is 'Mail::Cache'. This would make the directory,
946             "xdg_cache_home.'/Mail::Cache/Mail::Cache/'".
947              
948             Under the cache directory is the type directory. The type should also always
949             be lower case. Any upper case characters will be converted to lowercase. The
950             default is 'imap', making the directory
951             "xdg_cache_home.'/Mail::Cache/Mail::Cache/imap/'".
952              
953             Under the account directory is the type directory. The default is 'default',
954             making the directory "xdg_cache_home.'/Mail::Cache/Mail::Cache/imap/default/'".
955              
956             Under the box directory is the account directory. The default is 'INBOX',
957             making the directory
958             "xdg_cache_home.'/Mail::Cache/Mail::Cache/imap/default/INBOX/'".
959              
960             =head1 ERROR CODES
961              
962             The error codes are stored in '$mc->{error}'. Any time it is true, an error is present. When
963             no error is present, it is undefined.
964              
965             A description of the error can be found in '$mc->{errorString}'.
966              
967             =head2 1
968              
969             Could not create xdg_cache_home.
970              
971             =head2 2
972              
973             Could not create xdg_cache_home.'/Mail::Cache/'.
974              
975             =head2 3
976              
977             Cache name contains a '/'.
978              
979             =head2 4
980              
981             Failed to create xdg_cache_home.'/'.$cache.'/'.
982              
983             =head2 5
984              
985             Type contains a '/'.
986              
987             =head2 6
988              
989             Account contains a '/'.
990              
991             =head2 7
992              
993             Failed to create create xdg_cache_home.'/'.$cache.'/'.$account.'/'.
994              
995             =head2 8
996              
997             No UID specified.
998              
999             =head2 9
1000              
1001             UID matches /^\./.
1002              
1003             =head2 10
1004              
1005             No headers given.
1006              
1007             =head2 11
1008              
1009             Size is not specified.
1010              
1011             =head2 12
1012              
1013             UID matches /\|/.
1014              
1015             =head2 13
1016              
1017             Box name matches /\//.
1018              
1019             =head2 14
1020              
1021             Failed to create create xdg_cache_home.'/'.$cache.'/'.$account.'/'.$box.'/'.
1022              
1023             =head2 15
1024              
1025             "xdg_cache_home.'/'.$cache.'/'.$account.'/'.$box.'/'" does not exist.
1026              
1027             =head2 16
1028              
1029             "xdg_cache_home.'/'.$cache.'/'.$account.'/'.$box.'/.Size'" does not exist.
1030              
1031             =head2 17
1032              
1033             The passed value for the headers was something other than a reference or a hash.
1034              
1035             =head1 AUTHOR
1036              
1037             Zane C. Bowers, C<< >>
1038              
1039             =head1 BUGS
1040              
1041             Please report any bugs or feature requests to C, or through
1042             the web interface at L. I will be notified, and then you'll
1043             automatically be notified of progress on your bug as I make changes.
1044              
1045              
1046              
1047              
1048             =head1 SUPPORT
1049              
1050             You can find documentation for this module with the perldoc command.
1051              
1052             perldoc Mail::Cache
1053              
1054              
1055             You can also look for information at:
1056              
1057             =over 4
1058              
1059             =item * RT: CPAN's request tracker
1060              
1061             L
1062              
1063             =item * AnnoCPAN: Annotated CPAN documentation
1064              
1065             L
1066              
1067             =item * CPAN Ratings
1068              
1069             L
1070              
1071             =item * Search CPAN
1072              
1073             L
1074              
1075             =back
1076              
1077              
1078             =head1 ACKNOWLEDGEMENTS
1079              
1080              
1081             =head1 COPYRIGHT & LICENSE
1082              
1083             Copyright 2009 Zane C. Bowers, all rights reserved.
1084              
1085             This program is free software; you can redistribute it and/or modify it
1086             under the same terms as Perl itself.
1087              
1088              
1089             =cut
1090              
1091             1; # End of Mail::Cache