File Coverage

blib/lib/Email/PST/Win32.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package Email::PST::Win32;
2 1     1   17381 use Moose;
  1         364166  
  1         8  
3 1     1   6038 use namespace::autoclean;
  1         1188  
  1         5  
4 1     1   46 use Try::Tiny;
  1         7  
  1         44  
5 1     1   177 use Win32::OLE;
  0            
  0            
6              
7             has filename => (isa => 'Str', is => 'rw', default => '');
8             has display_name => (isa => 'Str', is => 'rw', default => 'My PST File');
9             has current_folder_path => (isa => 'Str', is => 'rw', default => '');
10             has instance_counter => (isa => 'Int', is => 'rw', default => 0);
11             has count_per_session => (isa => 'Int', is => 'rw', default => 1000);
12              
13             has current_rdo_folder => (
14             isa => 'Win32::OLE',
15             is => 'rw',
16             predicate => 'has_current_rdo_folder',
17             clearer => 'clear_current_rdo_folder'
18             );
19              
20             has rdo_session => (
21             isa => 'Win32::OLE',
22             is => 'rw',
23             lazy => 1,
24             default => sub { $_[0]->new_rdo_session },
25             clearer => 'clear_rdo_session',
26             predicate => 'has_rdo_session'
27             );
28              
29             has rdo_pst_store => (
30             isa => 'Win32::OLE',
31             is => 'rw',
32             lazy => 1,
33             default => sub { $_[0]->logon_rdo_pst_store },
34             clearer => 'clear_rdo_pst_store'
35             );
36              
37             sub relogon_rdo_pst_store {
38             my $self = shift;
39             $self->current_folder_path('');
40             $self->clear_current_rdo_folder;
41             $self->close;
42             $self->rdo_session( $self->new_rdo_session );
43             $self->rdo_pst_store( $self->logon_rdo_pst_store );
44             }
45              
46             sub new_rdo_session {
47             my $self = shift;
48             my $ses;
49             try {$ses = new Win32::OLE('Redemption.RDOSession')};
50             catch {die "caught exception $_"};
51             return $ses;
52             }
53              
54             sub close {
55             my $self = shift;
56             try { $self->rdo_session->Logoff };
57             $self->clear_rdo_session;
58             }
59              
60             sub logon_rdo_pst_store {
61             my $self = shift;
62             my $session = $self->rdo_session;
63             unless ($session) {die};
64             my $pst;
65             try { $pst = $session->LogonPstStore($self->filename, 1, $self->display_name, "", 0); }
66             catch { die "caught exception $_" };
67             return $pst;
68             };
69              
70             sub add_mime_file {
71             my ($self,$file_path,$folder_path,$type) = @_;
72              
73             $self->instance_counter( $self->instance_counter + 1 );
74             if ( $self->count_per_session > 0 ) {
75             $self->relogon_rdo_pst_store if $self->instance_counter % $self->count_per_session == 0;
76             }
77              
78             $folder_path = $self->fix_folder_path($folder_path);
79             $type
80             = $type && (lc $type eq 'note' || lc $type eq 'ipm.note')
81             ? 'IPM.Note' : 'IPM.Post';
82            
83             my $rdo_folder
84             = $folder_path eq $self->current_folder_path && $self->has_current_rdo_folder
85             ? $self->current_rdo_folder
86             : $self->get_rdo_folder_from_path( $folder_path, 1 );
87            
88             if ($rdo_folder) {
89             my $rdo_msg = $rdo_folder->Items->add( $type );
90             $rdo_msg->Import($file_path, 1024); # 1024 = olRFC822
91             $rdo_msg->Save;
92             } else {
93             die "could not get rdo_folder";
94             }
95             }
96              
97             sub fix_folder_path {
98             my ($self,$path) = @_;
99             $path||='';
100             $path =~ s|\\|/|g;
101             $path =~ s|/+|/|g;
102             $path =~ s|\A/||;
103             $path = $path ? "__ROOT__/$path" : '__ROOT__';
104             return $path;
105             }
106              
107             sub get_rdo_folder_from_path {
108             my ($self,$path,$load) = @_;
109              
110             my $pst = $self->rdo_pst_store;
111             unless ($pst && $path) {die};
112              
113             my @folders = map {{folder_name=>$_}} split '/', $path;
114             for my $i (0..$#folders) {
115             if ($i==0) {
116             $folders[0]{rdo_folder} = $pst->IPMRootFolder;
117             next;
118             }
119              
120             die "Could not get parent folder" unless
121             my $parent_folder = $folders[$i - 1]{rdo_folder};
122              
123             die "Could not get folder name" unless
124             my $folder_name = $folders[$i]{folder_name}||'';
125              
126             if (
127             my $folder = $parent_folder->Folders( $folder_name ) ||
128             $parent_folder->Folders->Add( $folder_name )
129             ) {
130             $folders[$i]{rdo_folder} = $folder;
131             } else {
132             die "Could not get folder for path $path";
133             }
134             }
135             if ($load) {
136             $self->current_folder_path( $path );
137             $self->current_rdo_folder( $folders[-1]{rdo_folder} );
138             }
139              
140             return $folders[-1]{rdo_folder};
141             }
142              
143             =head1 NAME
144              
145             Email::PST::Win32 - Simple method of writing and updating PST files using
146             Outlook Redemption on Windows.
147              
148             =head1 SYNOPSIS
149              
150             # Open an existing or new PST file
151              
152             my $pst = Email::PST::Win32->new(
153             filename => 'path/to/file.pst',
154             display_name => 'My PST File',
155             );
156              
157             # Add an MIME file to the PST
158              
159             my $file_path = 'c://path/to/source/Inbox/Important/1.eml';
160             my $folder_path = 'Inbox/Important';
161             my $type = index(lc $file_path, 'drafts')>0 ? 'note' : 'post';
162             $pst->add_mime_file( $file_path, $folder_path, $type );
163              
164             # Errors may occur when high numbers of items are added.
165             # A count_per_session > 0 will determine when to close and
166             # reopen the PST file. The default value is 1000.
167              
168             $pst->count_per_session( 2000 );
169              
170             # Get number of MIME files added
171              
172             my $count = $pst->instance_counter;
173            
174             # Close the PST file
175              
176             $pst->close;
177            
178             =head1 DESCRIPTION
179              
180             This is a simple wrapper for using the Outlook Redemption
181             (http://www.dimastr.com/redemption/) library. However, while Outlook
182             Redemption is a general purpose library, this module is currently limited
183             to creating and updating PST files with MIME files located on the file
184             system. Additional capabilties may be added in the future.
185              
186             =head2 Requirements
187              
188             This module requires Win32::OLE and Outlook Redemption.
189              
190             =head1 SEE ALSO
191              
192             L<http://www.dimastr.com/redemption/> (Outlook Redemption)
193              
194             =head1 AUTHOR
195              
196             John Wang <johncwang@gmail.com>, L<http://johnwang.com>
197              
198             =head1 COPYRIGHT AND LICENSE (The MIT License)
199              
200             Copyright (c) 2009-2015 John Wang
201              
202             Permission is hereby granted, free of charge, to any person obtaining
203             a copy of this software and associated documentation files (the
204             "Software"), to deal in the Software without restriction, including
205             without limitation the rights to use, copy, modify, merge, publish,
206             distribute, sublicense, and/or sell copies of the Software, and to
207             permit persons to whom the Software is furnished to do so, subject to
208             the following conditions:
209              
210             The above copyright notice and this permission notice shall be
211             included in all copies or substantial portions of the Software.
212              
213             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
214             EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
215             MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
216             NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
217             LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
218             OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
219             WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
220              
221             =cut
222              
223             __PACKAGE__->meta->make_immutable;
224             1;