| 1 |
package Torus::Driver::mapi; |
| 2 |
|
| 3 |
use strict; |
| 4 |
use warnings; |
| 5 |
|
| 6 |
# load configuration-data from ini-file |
| 7 |
BEGIN { |
| 8 |
use loadConfig; |
| 9 |
} |
| 10 |
|
| 11 |
# we need OLE to access Outlook's Contacts via MAPI |
| 12 |
#use Win32::OLE::Strict; |
| 13 |
use Win32::OLE; |
| 14 |
use Win32::OLE::NLS qw(:LOCALE :DATE); |
| 15 |
|
| 16 |
use Data::Storage::Handler::File qw( s2f ); |
| 17 |
|
| 18 |
# dumping data? of course! |
| 19 |
use Data::Dumper; |
| 20 |
|
| 21 |
# AppConfig-object from "main"-scope |
| 22 |
#my $config = $main::config; |
| 23 |
|
| 24 |
# debugging? |
| 25 |
my $DEBUGLEVEL = $config->get("debug_level"); |
| 26 |
my $DEBUG = ($config->get("debug_level") > 0); |
| 27 |
|
| 28 |
# some values (constants) needed for accessing outlook-folders |
| 29 |
my $olFolderList = 2; |
| 30 |
my $olFolderDeletedItems = 3; |
| 31 |
my $olFolderOutbox = 4; |
| 32 |
my $olFolderSentMail = 5; |
| 33 |
my $olFolderInbox = 6; |
| 34 |
my $olFolderCalendar = 9; |
| 35 |
my $olFolderContacts = 10; |
| 36 |
my $olFolderJournal = 11; |
| 37 |
my $olFolderNotes = 12; |
| 38 |
my $olFolderTasks = 13; |
| 39 |
my $olFolderDrafts = 16; |
| 40 |
|
| 41 |
|
| 42 |
# main vars |
| 43 |
my $map; |
| 44 |
my $map_ldap; |
| 45 |
|
| 46 |
my $mailer; |
| 47 |
my $bool_mailerAlreadyRunning; |
| 48 |
|
| 49 |
sub debugLevel { |
| 50 |
my $level_compare = shift; |
| 51 |
return 1 if ($DEBUGLEVEL > $level_compare); |
| 52 |
} |
| 53 |
|
| 54 |
|
| 55 |
|
| 56 |
|
| 57 |
sub mailerCheckRunning { |
| 58 |
my $tmp; |
| 59 |
# error-handling |
| 60 |
#$tmp = $mailer->ActiveExplorer->WindowState; |
| 61 |
#If Err.Number = 0 Then mailerCheckRunning = True |
| 62 |
#On Error GoTo 0 |
| 63 |
return 0; |
| 64 |
} |
| 65 |
|
| 66 |
sub start { |
| 67 |
|
| 68 |
slog("creating mailer-object"); |
| 69 |
$mailer = Win32::OLE->new('Outlook.Application') or die "oops - could not instantiate Outlook.Application"; |
| 70 |
|
| 71 |
$mailer->Uninitialize(); |
| 72 |
#sleep 2; |
| 73 |
|
| 74 |
$mailer->Initialize(); |
| 75 |
|
| 76 |
$bool_mailerAlreadyRunning = mailerCheckRunning(); |
| 77 |
|
| 78 |
if ($bool_mailerAlreadyRunning) { |
| 79 |
slog("*not* logging on, using running mailer"); |
| 80 |
} else { |
| 81 |
if ($config->get("mapi_showProfileChooser")) { |
| 82 |
slog("logging in (using Profile-Chooser), this may take some seconds!"); |
| 83 |
$mailer->Session->Logon ('', '', 1); |
| 84 |
} else { |
| 85 |
slog("logging in (auto-selecting profile " . $config->get("mapi_ProfileName") . "), this may take some seconds!"); |
| 86 |
$mailer->Session->Logon($config->get("mapi_ProfileName"), $config->get("mapi_ProfilePass"), 0); |
| 87 |
} |
| 88 |
} |
| 89 |
|
| 90 |
} |
| 91 |
|
| 92 |
sub stop { |
| 93 |
|
| 94 |
slog("logging off"); |
| 95 |
$mailer->Session->Logoff; |
| 96 |
|
| 97 |
if ($bool_mailerAlreadyRunning || $config->get("mapi_neverCloseOutlook")) { |
| 98 |
slog("*not* quitting running mailer!"); |
| 99 |
} else { |
| 100 |
slog("closing active mail-explorer"); |
| 101 |
$mailer->ActiveExplorer->Close; |
| 102 |
slog("quitting mailer"); |
| 103 |
$mailer->Quit; |
| 104 |
} |
| 105 |
|
| 106 |
$mailer->Uninitialize(); |
| 107 |
|
| 108 |
slog("destroying mailer-object"); |
| 109 |
undef $mailer; |
| 110 |
|
| 111 |
} |
| 112 |
|
| 113 |
|
| 114 |
# TODO: add functionality to address arbitrary deep folders anywhere in outlook-scope |
| 115 |
# TODO: move 'test' to configuration-scope |
| 116 |
sub getContactFolder { |
| 117 |
my $foldername = shift; |
| 118 |
slog("getting contacts"); |
| 119 |
my $folder; |
| 120 |
if ($foldername) { |
| 121 |
|
| 122 |
# check if it's a expression describing a hierarchical reference |
| 123 |
if (my @address = split(/\./, $foldername)) { |
| 124 |
print "trying to find folder: $foldername", "\n"; |
| 125 |
return findFolderByAddress(\@address); |
| 126 |
} |
| 127 |
|
| 128 |
my $rootFolder = $mailer->Session->Folders->GetFirst(); |
| 129 |
my $folderlist = $rootFolder->Folders; |
| 130 |
#print Dumper($folderlist); |
| 131 |
for (my $i = 1; $i <= $folderlist->Count; $i++) { |
| 132 |
my $tmpFolder = $folderlist->Item($i); |
| 133 |
#print "folder: ", $tmpFolder->Name, "\n"; |
| 134 |
my $name = $tmpFolder->Name; |
| 135 |
if ($name && $name eq $foldername) { |
| 136 |
$folder = $tmpFolder; |
| 137 |
last; |
| 138 |
} |
| 139 |
} |
| 140 |
#exit; |
| 141 |
} else { |
| 142 |
$folder = $mailer->Session->GetDefaultFolder($olFolderContacts); |
| 143 |
} |
| 144 |
return $folder; |
| 145 |
} |
| 146 |
|
| 147 |
sub findFolderByAddress { |
| 148 |
my $rootFolder = $mailer->Session->Folders->GetFirst(); |
| 149 |
my $folderAddress = shift; |
| 150 |
while (my $levelAddress = shift @$folderAddress) { |
| 151 |
print "diving into: $levelAddress", "\n"; |
| 152 |
$rootFolder = findFolder($rootFolder, $levelAddress); |
| 153 |
} |
| 154 |
return $rootFolder; |
| 155 |
} |
| 156 |
|
| 157 |
sub findFolder { |
| 158 |
my $parentFolder = shift; |
| 159 |
my $findFolderName = shift; |
| 160 |
my $folderlist = $parentFolder->Folders; |
| 161 |
#print Dumper($folderlist); |
| 162 |
for (my $i = 1; $i <= $folderlist->Count; $i++) { |
| 163 |
my $tmpFolder = $folderlist->Item($i); |
| 164 |
#print "folder: ", $tmpFolder->Name, "\n"; |
| 165 |
my $name = $tmpFolder->Name; |
| 166 |
if ($name && $name eq $findFolderName) { |
| 167 |
return $tmpFolder; |
| 168 |
} |
| 169 |
} |
| 170 |
} |
| 171 |
|
| 172 |
sub readMapiFolder { |
| 173 |
slog("reading mapi folder"); |
| 174 |
my $myFolder = shift; |
| 175 |
my $sourceFolderName = shift; |
| 176 |
my $callback = shift; |
| 177 |
my $options = shift; |
| 178 |
my $maxCount = $myFolder->Items->Count; |
| 179 |
print "Entries: $maxCount", "\n" if (debugLevel(1)); |
| 180 |
for (my $i = 1; $i <= $maxCount; $i++) { |
| 181 |
#print "Index: $i", "\n"; |
| 182 |
my $contactItem = $myFolder->Items->Item($i); |
| 183 |
#print $contactItem->{NickName}, "\n"; |
| 184 |
my $item_raw = readContactItem($contactItem); |
| 185 |
undef $contactItem; |
| 186 |
if ($options->{mapidump}) { |
| 187 |
s2f('../log/mapi_attributes', join("\n", sort keys %$item_raw)); |
| 188 |
} |
| 189 |
&$callback($sourceFolderName, $item_raw); |
| 190 |
} |
| 191 |
undef $myFolder; |
| 192 |
} |
| 193 |
|
| 194 |
sub readContactItem { |
| 195 |
|
| 196 |
# we get a real OLE MAPI object here, actually an entry from a MAPI ContactFolder |
| 197 |
my $mapiContactObject = shift; |
| 198 |
|
| 199 |
#print Dumper($mapiContactObject); |
| 200 |
|
| 201 |
# build a list of all MAPI field names |
| 202 |
my @mapiFieldNames = sort keys %{$mapiContactObject}; |
| 203 |
|
| 204 |
# OLE -> hash - conversion |
| 205 |
# hash to hold all attributes of the MAPI object |
| 206 |
my $contactItem; |
| 207 |
|
| 208 |
foreach my $mapi_fieldname (@mapiFieldNames) { |
| 209 |
|
| 210 |
#print "mapi-field: $mapi_fieldname", "\n"; |
| 211 |
|
| 212 |
# retrieve value of attribute |
| 213 |
my $value = $mapiContactObject->{$mapi_fieldname}; |
| 214 |
#my $value; |
| 215 |
#eval('$value = $mapiContactObject->{$mapi_fieldname};'); |
| 216 |
|
| 217 |
# skip empty fields |
| 218 |
next if !$value; |
| 219 |
|
| 220 |
# patches to values |
| 221 |
# bring all date- and time-fields to unified format |
| 222 |
if ($mapi_fieldname eq 'Anniversary' || $mapi_fieldname eq 'Birthday' || $mapi_fieldname eq 'CreationTime') { |
| 223 |
$value = $value->Date('yyyy-MM-dd') . ' ' . $value->Time('HH:mm'); |
| 224 |
} |
| 225 |
if ($mapi_fieldname eq 'UserProperties') { |
| 226 |
# ... do more stuff like this here ... |
| 227 |
#my %hash = %{$value}; |
| 228 |
#print "====: ", keys %hash, "\n"; |
| 229 |
#print Dumper(%hash); |
| 230 |
} |
| 231 |
|
| 232 |
# TODO: convert Win32::OLE - Variants to perlable variables |
| 233 |
|
| 234 |
# filter any (still existing) real Win32::OLE - variables from object, they would make problems in later processing |
| 235 |
next if ($value =~ m/^Win32::OLE/); |
| 236 |
|
| 237 |
# add attribute from object to hash |
| 238 |
$contactItem->{$mapi_fieldname} = $value; |
| 239 |
|
| 240 |
} |
| 241 |
|
| 242 |
if ( debugLevel(3) ) { |
| 243 |
print Dumper($contactItem); |
| 244 |
} |
| 245 |
|
| 246 |
return $contactItem; |
| 247 |
|
| 248 |
} |
| 249 |
|
| 250 |
sub slog { |
| 251 |
my $string = shift; |
| 252 |
print $string, "\n" if ( debugLevel(1) ); |
| 253 |
} |
| 254 |
|
| 255 |
|
| 256 |
1; |
Parent Directory
| 
Revision Log
