Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision ab7a995e

Von Tamino Steinert vor mehr als 1 Jahr hinzugefügt

  • ID ab7a995eff257de43fa4963b6525d2cd1488a163
  • Vorgänger 06cb19b2
  • Nachfolger 17c18982

IMAPClient: um Funktionen fürs Synchronisieren und Aufräumen erweitert

Unterschiede anzeigen:

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