Revision ab7a995e
Von Tamino Steinert vor mehr als 1 Jahr hinzugefügt
SL/IMAPClient.pm | ||
---|---|---|
16 | 16 |
use SL::Locale::String qw(t8); |
17 | 17 |
use SL::DB::EmailImport; |
18 | 18 |
use SL::DB::EmailJournal; |
19 |
use SL::DB::EmailJournalAttachment; |
|
19 | 20 |
|
20 |
my %TYPE_TO_FOLDER = ( |
|
21 |
use SL::DB::Order; |
|
22 |
|
|
23 |
my %RECORD_TYPE_TO_FOLDER = ( |
|
21 | 24 |
sales_quotation => t8('Sales Quotations'), |
22 | 25 |
sales_order => t8('Sales Orders'), |
23 | 26 |
); |
27 |
my %RECORD_FOLDER_TO_TYPE = reverse %RECORD_TYPE_TO_FOLDER; |
|
24 | 28 |
|
25 | 29 |
sub new { |
26 | 30 |
my ($class, %params) = @_; |
... | ... | |
49 | 53 |
|
50 | 54 |
sub update_emails_from_folder { |
51 | 55 |
my ($self, $folder_path) = @_; |
56 |
$folder_path ||= $self->{base_folder}; |
|
52 | 57 |
|
53 | 58 |
my $folder_string = $self->get_folder_string_from_path($folder_path); |
59 |
my $email_import = |
|
60 |
_update_emails_from_folder_strings($self, $folder_path, [$folder_string]); |
|
54 | 61 |
|
55 |
$self->{imap_client}->select($folder_string)
|
|
56 |
or die "Could not select IMAP folder '$folder_string': $@\n";
|
|
62 |
return $email_import;
|
|
63 |
}
|
|
57 | 64 |
|
58 |
my $msg_uids = $self->{imap_client}->messages |
|
59 |
or die "Could not messages via IMAP: $@\n"; |
|
65 |
sub update_emails_from_subfolders { |
|
66 |
my ($self, $base_folder_path) = @_; |
|
67 |
$base_folder_path ||= $self->{base_folder}; |
|
68 |
my $base_folder_string = $self->get_folder_string_from_path($base_folder_path); |
|
60 | 69 |
|
61 |
my $query = <<SQL; |
|
62 |
SELECT uid |
|
63 |
FROM email_imports ei |
|
64 |
LEFT JOIN email_journal ej |
|
65 |
ON ej.email_import_id = ei.id |
|
66 |
WHERE ei.host_name = ? |
|
67 |
AND ei.user_name = ? |
|
68 |
AND ej.folder = ? |
|
69 |
SQL |
|
70 |
my $dbh = SL::DB->client->dbh; |
|
71 |
my $existing_uids = $dbh->selectall_hashref($query, 'uid', undef, |
|
72 |
$self->{hostname}, $self->{username}, $folder_path); |
|
70 |
my @subfolder_strings = $self->{imap_client}->folders($base_folder_string) |
|
71 |
or die "Could not get subfolders via IMAP: $@\n"; |
|
72 |
@subfolder_strings = grep { $_ ne $base_folder_string } @subfolder_strings; |
|
73 | 73 |
|
74 |
my @new_msg_uids = grep { !$existing_uids->{$_} } @$msg_uids; |
|
74 |
my $email_import = |
|
75 |
_update_emails_from_folder_strings($self, $base_folder_path, \@subfolder_strings); |
|
76 |
|
|
77 |
return $email_import; |
|
78 |
} |
|
75 | 79 |
|
76 |
return unless @new_msg_uids; |
|
80 |
sub _update_emails_from_folder_strings { |
|
81 |
my ($self, $base_folder_path, $folder_strings) = @_; |
|
77 | 82 |
|
83 |
my $dbh = SL::DB->client->dbh; |
|
84 |
|
|
85 |
my $email_import; |
|
78 | 86 |
SL::DB->client->with_transaction(sub { |
79 |
my $email_import = $self->_create_email_import($folder_path); |
|
80 |
$email_import->save(); # save to get id |
|
81 |
|
|
82 |
foreach my $new_uid (@new_msg_uids) { |
|
83 |
my $new_email_string = $self->{imap_client}->message_string($new_uid); |
|
84 |
my $email = Email::MIME->new($new_email_string); |
|
85 |
my $email_journal = $self->_create_email_journal( |
|
86 |
$email, $email_import, $new_uid, $folder_path |
|
87 |
); |
|
88 |
$email_journal->save(); |
|
87 |
foreach my $folder_string (@$folder_strings) { |
|
88 |
$self->{imap_client}->select($folder_string) |
|
89 |
or die "Could not select IMAP folder '$folder_string': $@\n"; |
|
90 |
|
|
91 |
my $msg_uids = $self->{imap_client}->messages |
|
92 |
or die "Could not get messages via IMAP: $@\n"; |
|
93 |
|
|
94 |
my $query = <<SQL; |
|
95 |
SELECT uid |
|
96 |
FROM email_imports ei |
|
97 |
LEFT JOIN email_journal ej |
|
98 |
ON ej.email_import_id = ei.id |
|
99 |
WHERE ei.host_name = ? |
|
100 |
AND ei.user_name = ? |
|
101 |
AND ej.folder = ? |
|
102 |
SQL |
|
103 |
|
|
104 |
my $existing_uids = $dbh->selectall_hashref($query, 'uid', undef, |
|
105 |
$self->{hostname}, $self->{username}, $folder_string); |
|
106 |
|
|
107 |
my @new_msg_uids = grep { !$existing_uids->{$_} } @$msg_uids; |
|
108 |
|
|
109 |
next unless @new_msg_uids; |
|
110 |
|
|
111 |
$email_import ||= $self->_create_email_import($base_folder_path)->save(); |
|
112 |
|
|
113 |
foreach my $new_uid (@new_msg_uids) { |
|
114 |
my $new_email_string = $self->{imap_client}->message_string($new_uid); |
|
115 |
my $email = Email::MIME->new($new_email_string); |
|
116 |
my $email_journal = $self->_create_email_journal( |
|
117 |
$email, $email_import, $new_uid, $folder_string |
|
118 |
); |
|
119 |
$email_journal->save(); |
|
120 |
} |
|
89 | 121 |
} |
90 | 122 |
}); |
91 | 123 |
|
92 |
return; |
|
124 |
return $email_import;
|
|
93 | 125 |
} |
94 | 126 |
|
95 | 127 |
sub _create_email_import { |
... | ... | |
106 | 138 |
my ($self, $email, $email_import, $uid, $folder_path) = @_; |
107 | 139 |
|
108 | 140 |
my @email_parts = $email->parts; # get parts or self |
109 |
my $text_part = $email_parts[0]; # TODO: check if its allways the first part
|
|
141 |
my $text_part = $email_parts[0]; |
|
110 | 142 |
my $body = $text_part->body; |
111 | 143 |
|
112 | 144 |
my $header_string = join "\r\n", |
... | ... | |
163 | 195 |
return $dt->strftime('%Y-%m-%d %H:%M:%S'); |
164 | 196 |
} |
165 | 197 |
|
166 |
sub update_emails_for_record { |
|
198 |
sub update_email_files_for_record {
|
|
167 | 199 |
my ($self, $record) = @_; |
168 | 200 |
|
169 | 201 |
my $folder_string = $self->_get_folder_string_for_record($record); |
... | ... | |
172 | 204 |
or die "Could not select IMAP folder '$folder_string': $@\n"; |
173 | 205 |
|
174 | 206 |
my $msg_uids = $self->{imap_client}->messages |
175 |
or die "Could not messages via IMAP: $@\n"; |
|
207 |
or die "Could not get messages via IMAP: $@\n";
|
|
176 | 208 |
|
177 | 209 |
my $dbh = $record->dbh; |
178 | 210 |
my $query = <<SQL; |
... | ... | |
210 | 242 |
); |
211 | 243 |
unlink($sfile->file_name); |
212 | 244 |
} |
245 |
} |
|
213 | 246 |
|
247 |
sub update_email_files_for_all_records { |
|
248 |
my ($self) = @_; |
|
249 |
my $record_folder_path = $self->{base_folder}; |
|
250 |
|
|
251 |
my $subfolder_strings = $self->{imap_client}->folders($record_folder_path) |
|
252 |
or die "Could not get folders via IMAP: $@\n"; |
|
253 |
my @record_folder_strings = grep { $_ ne $record_folder_path } |
|
254 |
@$subfolder_strings; |
|
255 |
|
|
256 |
foreach my $record_folder_string (@record_folder_strings) { |
|
257 |
my $ilike_folder_path = $self->get_ilike_folder_path_from_string($record_folder_string); |
|
258 |
my ( |
|
259 |
$ilike_record_folder_path, # is greedily matched |
|
260 |
$ilike_customer_number, # no spaces allowed |
|
261 |
$ilike_customer_name, |
|
262 |
$record_folder, |
|
263 |
$ilike_record_number |
|
264 |
) = $ilike_folder_path =~ m|^(.+)/([^\s]+) (.+)/(.+)/(.+)|; |
|
265 |
|
|
266 |
my $record_type = $RECORD_FOLDER_TO_TYPE{$record_folder}; |
|
267 |
next unless $record_type; |
|
268 |
|
|
269 |
my $is_quotation = $record_type eq 'sales_quotation' ? 1 : 0; |
|
270 |
my $number_field = $is_quotation ? 'quonumber' : 'ordnumber'; |
|
271 |
my $order = SL::DB::Manager::Order->get_first( |
|
272 |
query => [ |
|
273 |
and => [ |
|
274 |
vendor_id => undef, |
|
275 |
quotation => $is_quotation, |
|
276 |
$number_field => { ilike => $ilike_record_number }, |
|
277 |
], |
|
278 |
]); |
|
279 |
next unless $order; |
|
280 |
|
|
281 |
$self->update_email_files_for_record($order); |
|
282 |
} |
|
214 | 283 |
} |
215 | 284 |
|
216 | 285 |
sub create_folder { |
... | ... | |
224 | 293 |
sub get_folder_string_from_path { |
225 | 294 |
my ($self, $folder_path) = @_; |
226 | 295 |
my $separator = $self->{imap_client}->separator(); |
227 |
my $replace_sep = $separator eq '_' ? '-' : '_'; |
|
228 |
$folder_path =~ s|\Q${separator}|$replace_sep|g; # \Q -> escape special chars |
|
229 |
$folder_path =~ s|/|${separator}|g; # replace / with separator |
|
296 |
if ($separator ne '/') { |
|
297 |
my $replace_sep = $separator ne '_' ? '_' : '-'; |
|
298 |
$folder_path =~ s|\Q${separator}|$replace_sep|g; # \Q -> escape special chars |
|
299 |
$folder_path =~ s|/|${separator}|g; # replace / with separator |
|
300 |
} |
|
230 | 301 |
my $folder_string = encode('IMAP-UTF-7', $folder_path); |
231 | 302 |
return $folder_string; |
232 | 303 |
} |
233 | 304 |
|
305 |
sub get_ilike_folder_path_from_string { |
|
306 |
my ($self, $folder_string) = @_; |
|
307 |
my $separator = $self->{imap_client}->separator(); |
|
308 |
my $folder_path = decode('IMAP-UTF-7', $folder_string); |
|
309 |
$folder_path =~ s|\Q${separator}|/|g; # \Q -> escape special chars |
|
310 |
$folder_path =~ s|-|_|g; # for ilike matching |
|
311 |
return $folder_path; |
|
312 |
} |
|
313 |
|
|
234 | 314 |
sub create_folder_for_record { |
235 | 315 |
my ($self, $record) = @_; |
236 | 316 |
my $folder_string = $self->_get_folder_string_for_record($record); |
... | ... | |
238 | 318 |
return; |
239 | 319 |
} |
240 | 320 |
|
321 |
sub clean_up_record_folders { |
|
322 |
my ($self, $active_records) = @_; |
|
323 |
my $record_folder_path = $self->{base_folder}; |
|
324 |
|
|
325 |
$self->update_email_files_for_all_records(); |
|
326 |
|
|
327 |
my $base_folder_string = $self->get_folder_string_from_path($record_folder_path); |
|
328 |
my @folders = $self->{imap_client}->folders($base_folder_string) |
|
329 |
or die "Could not get folders via IMAP: $@\n"; |
|
330 |
|
|
331 |
my @active_folders = map { $self->_get_folder_string_for_record($_) } |
|
332 |
@$active_records; |
|
333 |
push @active_folders, $base_folder_string; |
|
334 |
|
|
335 |
my %keep_folder = map { $_ => 1 } @active_folders; |
|
336 |
my @folders_to_delete = grep { !$keep_folder{$_} } @folders; |
|
337 |
|
|
338 |
foreach my $folder (@folders_to_delete) { |
|
339 |
$self->{imap_client}->delete($folder) |
|
340 |
or die "Could not delete IMAP folder '$folder': $@\n"; |
|
341 |
} |
|
342 |
} |
|
343 |
|
|
241 | 344 |
sub _get_folder_string_for_record { |
242 | 345 |
my ($self, $record) = @_; |
243 | 346 |
|
244 | 347 |
my $customer_vendor = $record->customervendor; |
348 |
|
|
349 |
#repalce / with _ |
|
350 |
my %string_parts = (); |
|
351 |
$string_parts{cv_number} = $customer_vendor->number; |
|
352 |
$string_parts{cv_name} = $customer_vendor->name; |
|
353 |
$string_parts{record_number} = $record->number; |
|
354 |
foreach my $key (keys %string_parts) { |
|
355 |
$string_parts{$key} =~ s|/|_|g; |
|
356 |
} |
|
357 |
|
|
245 | 358 |
my $record_folder_path = |
246 | 359 |
$self->{base_folder} . '/' . |
247 |
$customer_vendor->number . ' ' . $customer_vendor->name . '/' .
|
|
248 |
$TYPE_TO_FOLDER{$record->type} . '/' . |
|
249 |
$record->number;
|
|
360 |
$string_parts{cv_number} . ' ' . $string_parts{cv_name} . '/' .
|
|
361 |
$RECORD_TYPE_TO_FOLDER{$record->type} . '/' .
|
|
362 |
$string_parts{record_number};
|
|
250 | 363 |
my $folder_string = $self->get_folder_string_from_path($record_folder_path); |
251 | 364 |
return $folder_string; |
252 | 365 |
} |
... | ... | |
329 | 442 |
|
330 | 443 |
# update emails for record |
331 | 444 |
# fetches all emails from the IMAP server and saves them as attachments |
332 |
$imap_client->update_emails_for_record($record); |
|
445 |
$imap_client->update_email_files_for_record($record);
|
|
333 | 446 |
|
334 | 447 |
=head1 OVERVIEW |
335 | 448 |
|
... | ... | |
340 | 453 |
|
341 | 454 |
=over 2 |
342 | 455 |
|
343 |
=item C<%TYPE_TO_FOLDER> |
|
456 |
=item C<%RECORD_TYPE_TO_FOLDER>
|
|
344 | 457 |
|
345 | 458 |
Due to the lack of a single global mapping for $record->type, |
346 | 459 |
type is mapped to the corresponding translation. All types which |
347 | 460 |
use this module are currently mapped and should be mapped. |
348 | 461 |
|
462 |
=item C<%RECORD_FOLDER_TO_TYPE> |
|
463 |
|
|
464 |
The reverse mapping of %RECORD_TYPE_TO_FOLDER. |
|
465 |
|
|
349 | 466 |
=back |
350 | 467 |
|
351 | 468 |
=head1 FUNCTIONS |
... | ... | |
362 | 479 |
|
363 | 480 |
Destructor. Disconnects from the IMAP server. |
364 | 481 |
|
365 |
=item C<update_emails_for_record> |
|
482 |
=item C<update_emails_from_folder> |
|
483 |
|
|
484 |
Updates the emails for a folder. Checks which emails are missing and |
|
485 |
fetches these from the IMAP server. Returns the created email import object. |
|
486 |
|
|
487 |
=item C<update_emails_from_subfolders> |
|
488 |
|
|
489 |
Updates the emails for all subfolders of a folder. Checks which emails are |
|
490 |
missing and fetches these from the IMAP server. Returns the created email |
|
491 |
import object. |
|
492 |
|
|
493 |
=item C<_update_emails_from_folder_strings> |
|
366 | 494 |
|
367 |
Updates the emails for a record. Checks which emails are missing and |
|
495 |
Updates the emails for a list of folder strings. Checks which emails are |
|
496 |
missing and fetches these from the IMAP server. Returns the created |
|
497 |
email import object. |
|
498 |
|
|
499 |
=item C<update_email_files_for_record> |
|
500 |
|
|
501 |
Updates the email files for a record. Checks which emails are missing and |
|
368 | 502 |
fetches these from the IMAP server. |
369 | 503 |
|
504 |
=item C<update_email_files_for_all_records> |
|
505 |
|
|
506 |
Updates the email files for all records. Checks which emails are missing and |
|
507 |
fetches these from the IMAP server. |
|
508 |
|
|
370 | 509 |
=item C<create_folder> |
371 | 510 |
|
372 | 511 |
Creates a folder on the IMAP server. If the folder already exists, nothing |
... | ... | |
378 | 517 |
on unix filesystem. The folder string is the path on the IMAP server. |
379 | 518 |
The folder string is encoded in IMAP-UTF-7. |
380 | 519 |
|
520 |
=item C<get_ilike_folder_path_from_string> |
|
521 |
|
|
522 |
Converts a folder string to a folder path. The folder path is like path |
|
523 |
on unix filesystem. The folder string is the path on the IMAP server. |
|
524 |
The folder string is encoded in IMAP-UTF-7. It can happend that |
|
525 |
C<get_folder_string_from_path> and C<get_ilike_folder_path_from_string> |
|
526 |
don't cancel each other out. This is because the IMAP server has a different |
|
527 |
separator than the unix filesystem. The changes are made so that a ILIKE |
|
528 |
query on the database works. |
|
529 |
|
|
381 | 530 |
=item C<create_folder_for_record> |
382 | 531 |
|
383 | 532 |
Creates a folder for a record on the IMAP server. The folder structure |
... | ... | |
385 | 534 |
e.g. INBOX/1234 Testkunde/Angebot/123 |
386 | 535 |
If the folder already exists, nothing happens. |
387 | 536 |
|
537 |
=item C<clean_up_record_folders> |
|
538 |
|
|
539 |
Gets a list of acitve records. First syncs the folders on the IMAP server with |
|
540 |
the corresponding record, by creating email files. Then deletes all folders |
|
541 |
which are not corresponding to an active record. |
|
542 |
|
|
388 | 543 |
=item C<_get_folder_string_for_record> |
389 | 544 |
|
390 | 545 |
Returns the folder string for a record. The folder structure is like this: |
Auch abrufbar als: Unified diff
IMAPClient: um Funktionen fürs Synchronisieren und Aufräumen erweitert