File: convert_mbox.pl

package info (click to toggle)
claws-mail 4.3.1-1
  • links: PTS, VCS
  • area: main
  • in suites: sid, trixie
  • size: 51,124 kB
  • sloc: ansic: 268,194; cpp: 19,477; xml: 11,269; sh: 5,794; perl: 2,767; makefile: 2,509; yacc: 2,470; python: 334; lex: 293
file content (188 lines) | stat: -rwxr-xr-x 5,540 bytes parent folder | download | duplicates (13)
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
182
183
184
185
186
187
188
#!/usr/bin/perl
# convert_mbox.pl
# perl script to convert mbox file to files in a new MH directory
# aka another mbox -> MH conversion tool
# 29 April 2003  
# Fred Marton <Fred.Marton@uni-bayreuth.de>
# 
# Fixed (hopefully) to account for From lines
# that are of various length and that might have
# time zone info at the end
# 20 January 2004
#
# Note: Running this with the -w flag generates the following warnings:
# Scalar value @word[1] better written as $word[1] at /path/to/convert_mbox.pl line 54
# Scalar value @word[0] better written as $word[1] at /path/to/convert_mbox.pl line 56
# Making these changes requires further changes in the script
# that results in much longer run-times.  
#
# Copyright (c) 2003 Fred Marton
# Copyright (c) 2009 Ricardo Mones, based on the bash script
#                    by Daniel Dickinson [1]
# 
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 3
# of the License, or (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA.
#
# [1] http://bugs.debian.org/cgi-bin/bugreport.cgi?msg=15;filename=convert_mbox.sh;att=1;bug=461435

use File::Path;
use File::Basename;

# check for arguments
&usage if ($#ARGV < 1);
if ($ARGV[0] eq "-R") {
  # recursive, need more args
  &usage if ($#ARGV < 2);
  &usage unless (-d $ARGV[1]);
  &usage unless (-d $ARGV[2]);
  &convert_all ($ARGV[1], $ARGV[2]);
}
else {
  # default behaviour
  &convert_mbox ($ARGV[0], $$ARGV[1]);
}

sub strip_sbd {
  # raw translation of bash, probably doable in real Perl better
  $dirname = shift;
  $nosbddir = "";
  $dirleft = $dirname;
  while ($dirleft ne "." and $dirleft ne "") {
    $enddir = &basename ($dirleft, ['.sbd']);
    if ($nosbddir ne "") {
      $nosbddir = "$enddir/$nosbddir";
    }
    else {
      $nosbddir = $enddir;
    }
    $dirleft = &dirname ($dirleft);
  }
  print "$nosbddir\n";
}

sub convert_all {
  ($mboxdir, $targetdir) = @_;
  $tmpbase = '/tmp/frommbox';
  $tmplist = '/tmp/.convert_mbox.filelist';
  $curdir = qx/pwd/;
  chdir ($mboxdir);
  qx/find * -type -d -a ! -name '*.*'i | sort > $tmplist/;
  open (FLH, "<$tmplist") or die "cannot open $tmplist: $!\n";
  while (<FLH>) {
    chomp;
    &convert_one ($_, $targetdir, $tmpbase);
  }
  close (FLH);
  unlink ($tmplist);
  chdir ($curdir);
}

sub convert_one {
  # targetdir isn't used in the original bash script, maybe a bug?
  ($file, $targetdir, $tmpbase) = @_;
  $dirname = &dirname ($file);
  $filename = &basename ($file);
  if ($dirname eq $filename) {
    $dirname = "";
  }
  $dirname = &strip_sbd ($dirname);
  if ($dirname ne "") {
    $dirname = "/$dirname";
  }
  &mkpath ($tmpbase . $dirname);
  $basefile = &basename ($file);
  $base1 = &basename ($file, ['.cmeta']);
  $base2 = &basename ($base1, ['.ibex.index']);
  $base3 = &basename ($base2, ['.ibex.index.data']);
  $base5 = &basename ($base3, ['.ev-summary']);
  $base4 = &basename ($base5, ['.ev-summary-meta']);
  $subdir = &basename ($dirname);
  $basedir = "/" . &dirname ($dirname);
  if ( $basedir eq '/.' or $basedir eq '/' ) {
    $basedir = $dirname;
    $subdir = "";
  }
  $basedir = $tmpbase . $basedir;
  &mkpath ($basedir);
  $dirisfile = 0;
  if ( -f "$basedir/$subdir" ) {
    $dirisfile = 1;
    qx/mv \"$basedir\/$subdir\" \"$basedir\/$subdir.tmp\"/;
    &mkpath ("$basedir/$subdir");
  }
  if ( ! -d "$basedir/$subdir/$base4" ) {
    print "$basedir/$subdir/$base4\n";
    &convert_mbox ($file, "$basedir/$subdir/$base4", 'quiet');
    if ($dirisfile == 1) {
      qx/mv \"$basedir\/$subdir.tmp\/*\" \"$basedir\/$subdir\/\"/;
    }
  }
}


sub convert_mbox {
  ($mbox, $mh, $quiet) = @_;
  # check to make sure there isn't something named MH already
  if (-e $mh) {
     die (" The directory \"$mh\" already exists.  Exiting.\n");
  }
  else {
     mkdir $mh;
  }
  # start numbering
  $i = 0;
  # open the mbox file
  open (IN, $mbox);
  while ($line = <IN>) {
    # check for the beginning of an e-mail
    @word = split(/ +/m,$line);
    # some lines might start with "From ", so check
    # to see if the [second-to-]last word is a year
    @word2 = split(/:/,$line);
    chomp($word2[$#word2]);
    @word3 = split(/ /,$word2[2]);
    $year = @word3[1];
    # ignore the MAILER-DAEMON message from pine
    if (@word[1] ne "MAILER-DAEMON") {
      # start a new file, assuming $year is > 1970
      if (@word[0] eq "From" && $year > 1970) {
        $i++;
        close (OUT);
        open (OUT, ">$mh/$i");
        print OUT $line;
      }
      else {
        # continue the file
        print OUT $line;
      }
    }
  }
  close (OUT);
  close (IN);
  # and we're done
  if (! defined($quiet)) {
    print "\n If it isn't there already, please move the directory \"$mh\"\n"
          . " into your MH directory and rebuild your folder tree.\n\n";
  }
}

sub usage {
   die ("Usage: convert_mbox.pl MBOX MH_DIR\n"
        . "       convert_mbox.pl -R MBOXDIR MH_DIR\n"
        . "Where: \n"
        . "  -R  Converts recursively a directory of mboxes\n");
}