"Fossies" - the Fresh Open Source Software Archive

Member "Mail-Box-3.007/t/113mh-create.t" (15 Feb 2019, 3813 Bytes) of package /linux/privat/Mail-Box-3.007.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 #!/usr/bin/env perl
    2 
    3 #
    4 # Test creation/deletion and listing of folders.
    5 #
    6 
    7 use strict;
    8 use warnings;
    9 
   10 use Mail::Box::Test;
   11 use Mail::Box::Mbox;
   12 use Mail::Box::MH;
   13 use Mail::Message::Construct;
   14 
   15 use Test::More tests => 20;
   16 use File::Copy;
   17 use File::Spec;
   18 
   19 my $top = File::Spec->catfile($folderdir, 'Mail');
   20 clean_dir $top;
   21 
   22 my $mbox = Mail::Box::Mbox->new
   23   ( folder      => $src
   24   , lock_type   => 'NONE'
   25   );
   26 
   27 #
   28 # Create a nice structure which looks like a set of MH folders.
   29 #
   30 
   31 sub folder($;$@)
   32 {   my $dirname = shift;
   33     $dirname = File::Spec->catfile($dirname, shift) if @_;
   34 
   35     die "Cannot create directory $dirname: $!\n"
   36         unless -d $dirname || mkdir $dirname, 0700;
   37 
   38     foreach (@_)
   39     {   my $f = File::Spec->catfile($dirname, $_);
   40         open CREATE, ">$f" or die "Cannot create $f: $!\n";
   41         $mbox->message($_)->print(\*CREATE) if m/^\d+$/;
   42         close CREATE;
   43     }
   44     $dirname;
   45 }
   46 
   47 folder $top;
   48 folder $top, 'f1', qw/a b c/;
   49 folder $top, 'f2', 1, 2, 3;       # only real folder
   50 folder $top, 'f3';                # empty folder
   51 
   52 my $sub1 = folder $top, 'sub1';
   53 folder $sub1, 's1f1';
   54 folder $sub1, 's1f2';
   55 folder $sub1, 's1f3';
   56 folder $top,  'sub2';            # empty dir
   57 my $f4 = folder $top, 'f4', 1, 2, 3;
   58 folder $f4, 'f4f1';
   59 unpack_mbox2mh $src, File::Spec->catfile($f4, 'f4f2');
   60 folder $f4, 'f4f3';
   61 
   62 ok(compare_lists
   63         [ sort Mail::Box::MH->listSubFolders(folderdir => $top) ]
   64       , [ qw/f1 f2 f3 f4 sub1 sub2/ ]
   65   );
   66 
   67 ok(compare_lists
   68         [ sort Mail::Box::MH->listSubFolders(folderdir => $top) ]
   69       , [ qw/f1 f2 f3 f4 sub1 sub2/ ]
   70   );
   71 
   72 ok(compare_lists
   73         [ sort Mail::Box::MH->listSubFolders
   74                ( folderdir  => $top
   75                , skip_empty => 1
   76                ) ]
   77       , [ qw/f2 f4 sub1/ ]
   78   );
   79 
   80 ok(compare_lists
   81         [ sort Mail::Box::MH->listSubFolders
   82                ( folderdir  => $top
   83                , check      => 1
   84                ) ]
   85       , [ qw/f2 f4/ ]
   86   );
   87 
   88 ok(compare_lists
   89       [ sort Mail::Box::MH->listSubFolders
   90                ( folderdir  => $top
   91                , folder     => "=f4"
   92                )
   93       ]
   94       , [ qw/f4f1 f4f2 f4f3/ ]
   95   );
   96 
   97 ok(compare_lists [ sort Mail::Box::MH->listSubFolders(folderdir  => "$top/f4") ]
   98           , [ qw/f4f1 f4f2 f4f3/ ]
   99   );
  100 
  101 #
  102 # Open a folder in a sub-dir which uses the extention.
  103 #
  104 
  105 my $folder = Mail::Box::MH->new
  106   ( folderdir   => $top
  107   , folder      => '=f4/f4f2'
  108   , lock_type   => 'NONE'
  109   );
  110 
  111 ok($folder);
  112 cmp_ok($folder->messages, "==", 45);
  113 $folder->close;
  114 
  115 #
  116 # Open a new folder.
  117 #
  118 
  119 my $newfolder = File::Spec->catfile($f4, 'newfolder');
  120 ok(! -d $newfolder);
  121 Mail::Box::MH->create('=f4/newfolder', folderdir  => $top);
  122 ok(-d $newfolder);
  123 
  124 $folder = Mail::Box::MH->new
  125   ( folderdir   => $top
  126   , folder      => '=f4/newfolder'
  127   , access      => 'rw'
  128   , keep_index  => 1
  129   , lock_type   => 'NONE'
  130   );
  131 
  132 ok($folder);
  133 cmp_ok($folder->messages, "==", 0);
  134 
  135 my $msg = Mail::Message->build
  136   ( From    => 'me@example.com'
  137   , To      => 'you@anywhere.aq'
  138   , Subject => 'Just a try'
  139   , data    => [ "a short message\n", "of two lines.\n" ]
  140   );
  141 
  142 $folder->addMessage($msg);
  143 cmp_ok($folder->messages, "==", 1);
  144 $folder->close;
  145 ok(-f File::Spec->catfile($newfolder, '1'));
  146 
  147 opendir DIR, $newfolder or die "Cannot read directory $newfolder: $!\n";
  148 my @all = grep !/^\./, readdir DIR;
  149 closedir DIR;
  150 cmp_ok(@all, "==", 1);
  151 
  152 my $seq = File::Spec->catfile($newfolder, '.mh_sequences');
  153 open SEQ, $seq or die "Cannot read $seq: $!\n";
  154 my @seq = <SEQ>;
  155 close SEQ;
  156 
  157 cmp_ok(@seq, "==", 1);
  158 is($seq[0],"unseen: 1\n");
  159 
  160 #
  161 # Delete a folder.
  162 #
  163 
  164 $folder = Mail::Box::MH->new
  165   ( folderdir   => $top
  166   , folder      => '=f4'
  167   , access      => 'rw'
  168   , lock_type   => 'NONE'
  169   , keep_index  => 1
  170   );
  171 
  172 ok(-d $f4);
  173 $folder->delete;
  174 ok(1);
  175 $folder->close;
  176 ok(1);
  177 
  178 clean_dir $top;