Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision 9ea083c2

Von Tamino Steinert vor 6 Monaten hinzugefügt

  • ID 9ea083c2e1e9ef9f78ff9514472267f2f9224040
  • Vorgänger 513eeb7c
  • Nachfolger cc96274a

IMAPClient: validiere Parameter bei der Übergabe

Unterschiede anzeigen:

SL/IMAPClient.pm
5 5
use utf8;
6 6

  
7 7
use Carp;
8
use Params::Validate qw(:all);
9
use List::MoreUtils qw(any);
8 10
use IO::Socket::INET;
9 11
use IO::Socket::SSL;
10 12
use Mail::IMAPClient;
......
19 21
use SL::DB::EmailImport;
20 22
use SL::DB::EmailJournal;
21 23
use SL::DB::EmailJournalAttachment;
24
use SL::DB::Order::TypeData;
22 25

  
23 26
use SL::DB::Order;
24 27

  
25 28
sub new {
26
  my ($class, %params) = @_;
27
  my $config = $::lx_office_conf{imap_client} || {};
29
  my $class = shift;
30
  my %params = validate(@_, {
31
    enabled     => {
32
      type => BOOLEAN,
33
      callbacks => {'is enabled' => sub { !!shift }}
34
    },
35
    hostname    => { type => SCALAR,  },
36
    port        => { type => SCALAR,  optional => 1, },
37
    ssl         => { type => BOOLEAN, },
38
    username    => { type => SCALAR,  },
39
    password    => { type => SCALAR,  },
40
    base_folder => { type => SCALAR, default => 'INBOX', },
41
  });
42

  
43
  # get translation at runtime
44
  my $client_locale = $::locale;
28 45
  my $server_locale = Locale->new($::lx_office_conf{server}->{language});
29
  my %record_type_to_folder = (
30
    sales_quotation => $server_locale->text('Sales Quotations'),
31
    sales_order     => $server_locale->text('Sales Orders'),
32
  );
46
  $::locale = $server_locale;
47
  my %record_type_to_folder =
48
    map { $_ => SL::DB::Order::TypeData->can('get3')->($_, 'text', 'list') }
49
    @{SL::DB::Order::TypeData->valid_types()};
50
  $::locale = $client_locale;
33 51
  my %record_folder_to_type = reverse %record_type_to_folder;
52

  
34 53
  my $self = bless {
35
    enabled     => $config->{enabled},
36
    hostname    => $config->{hostname},
37
    port        => $config->{port},
38
    ssl         => $config->{ssl},
39
    username    => $config->{username},
40
    password    => $config->{password},
41
    base_folder => $config->{base_folder} || 'INBOX',
54
    %params,
42 55
    record_type_to_folder => \%record_type_to_folder,
43 56
    record_folder_to_type => \%record_folder_to_type,
44
    %params,
45 57
  }, $class;
46
  return unless $self->{enabled};
47 58
  $self->_create_imap_client();
48 59
  return $self;
49 60
}
......
56 67
}
57 68

  
58 69
sub store_email_in_email_folder {
59
  my ($self, $email_string, $folder_path) = @_;
60
  $folder_path ||= $self->{base_folder};
70
  my $self = shift;
71
  my %params = validate(@_, {
72
    email_as_string => {
73
      type => SCALAR,
74
      callbacks => {'is not empty' => sub {shift ne ''}},
75
    },
76
    folder          => {
77
      type => SCALAR,
78
      callbacks => {'is not empty' => sub {shift ne ''}},
79
    },
80
  });
61 81

  
62
  my $folder_string = $self->get_folder_string_from_path($folder_path);
63
  $self->{imap_client}->append_string($folder_string, $email_string)
82
  my $folder_string = $self->get_folder_string_from_path(folder_path => $params{folder});
83
  $self->{imap_client}->append_string($folder_string, $params{email_as_string})
64 84
    or die "Could not store email in folder '$folder_string': "
65 85
           . $self->{imap_client}->LastError() . "\n";
66 86
}
67 87

  
68 88
sub set_flag_for_email {
69
  my ($self, $email_journal, $imap_flag) = @_;
70
  return unless $imap_flag;
89
  my $self = shift;
90
  my %params = validate(@_, {
91
    email_journal => { isa => 'SL::DB::EmailJournal', },
92
    flag          => { type => SCALAR, },
93
  });
94
  my $email_journal = $params{email_journal};
95
  my $flag          = $params{flag};
71 96

  
72 97
  my $folder_string = $email_journal->folder;
73 98

  
......
82 107
  }
83 108

  
84 109
  my $uid = $email_journal->uid;
85
  $self->{imap_client}->set_flag($imap_flag, [$uid])
86
    or die "Could not add flag '$imap_flag' to message '$uid': "
110
  $self->{imap_client}->set_flag($flag, [$uid])
111
    or die "Could not add flag '$flag' to message '$uid': "
87 112
           . $self->{imap_client}->LastError() . "\n";
88 113
}
89 114

  
90 115
sub update_emails_from_folder {
91
  my ($self, $folder_path, $params) = @_;
92
  $folder_path ||= $self->{base_folder};
116
  my $self = shift;
117
  my %params = validate(@_, {
118
    folder               => {
119
      type     => SCALAR | UNDEF,
120
      optional => 1,
121
    },
122
    email_journal_params => {
123
      type     => HASHREF | UNDEF,
124
      optional => 1,
125
    },
126
  });
127
  my $folder_path = $params{folder} || $self->{base_folder};
93 128

  
94
  my $folder_string = $self->get_folder_string_from_path($folder_path);
129
  my $folder_string = $self->get_folder_string_from_path(folder_path => $folder_path);
95 130
  my $email_import =
96
    _update_emails_from_folder_strings($self, $folder_path, [$folder_string], $params);
131
    $self->_update_emails_from_folder_strings(
132
      base_folder_path     => $folder_path,
133
      folder_strings       => [$folder_string],
134
      email_journal_params => $params{email_journal_params},
135
    );
97 136

  
98 137
  return $email_import;
99 138
}
100 139

  
101 140
sub update_emails_from_subfolders {
102
  my ($self, $base_folder_path, $params) = @_;
103
  $base_folder_path ||= $self->{base_folder};
104
  my $base_folder_string = $self->get_folder_string_from_path($base_folder_path);
141
  my $self = shift;
142
  my %params = validate(@_, {
143
    base_folder           => {
144
      type     => SCALAR,
145
      optional => 1,
146
    },
147
    email_journal_params => {
148
      type     => HASHREF | UNDEF,
149
      optional => 1,
150
    },
151
  });
152
  my $base_folder_path = $params{base_folder} || $self->{base_folder};
105 153

  
154
  my $base_folder_string = $self->get_folder_string_from_path(folder_path => $base_folder_path);
106 155
  my @subfolder_strings = $self->{imap_client}->folders($base_folder_string)
107 156
    or die "Could not get subfolders via IMAP: $@\n";
108 157
  @subfolder_strings = grep { $_ ne $base_folder_string } @subfolder_strings;
109 158

  
110 159
  my $email_import =
111
    _update_emails_from_folder_strings($self, $base_folder_path, \@subfolder_strings, $params);
160
    $self->_update_emails_from_folder_strings(
161
      base_folder_path     => $base_folder_path,
162
      folder_strings       => \@subfolder_strings,
163
      email_journal_params => $params{email_journal_params},
164
    );
112 165

  
113 166
  return $email_import;
114 167
}
115 168

  
116 169
sub _update_emails_from_folder_strings {
117
  my ($self, $base_folder_path, $folder_strings, $params) = @_;
170
  my $self = shift;
171
  my %params = validate(@_, {
172
    base_folder_path => { type => SCALAR,   },
173
    folder_strings   => { type => ARRAYREF, },
174
    email_journal_params => {
175
      type     => HASHREF | UNDEF,
176
      optional => 1,
177
    },
178
  });
118 179

  
119 180
  my $dbh = SL::DB->client->dbh;
120 181

  
121 182
  my $email_import;
122 183
  SL::DB->client->with_transaction(sub {
123
    foreach my $folder_string (@$folder_strings) {
184
    foreach my $folder_string (@{$params{folder_strings}}) {
124 185
      $self->{imap_client}->select($folder_string)
125 186
        or die "Could not select IMAP folder '$folder_string': $@\n";
126 187

  
......
148 209

  
149 210
      next unless @new_msg_uids;
150 211

  
151
      $email_import ||= $self->_create_email_import($base_folder_path)->save();
212
      $email_import ||= $self->_create_email_import(folder_path => $params{base_folder_path})->save();
152 213

  
153 214
      foreach my $new_uid (@new_msg_uids) {
154 215
        my $new_email_string = $self->{imap_client}->message_string($new_uid);
155 216
        my $email = Email::MIME->new($new_email_string);
156 217
        my $email_journal = $self->_create_email_journal(
157
          $email, $email_import, $new_uid, $folder_string, $folder_uidvalidity, $params->{email_journal}
218
          email                => $email,
219
          email_import         => $email_import,
220
          uid                  => $new_uid,
221
          folder_string        => $folder_string,
222
          folder_uidvalidity   => $folder_uidvalidity,
223
          email_journal_params => $params{email_journal_params},
158 224
        );
159 225
        $email_journal->save();
160 226
      }
......
165 231
}
166 232

  
167 233
sub _create_email_import {
168
  my ($self, $folder_path) = @_;
234
  my $self = shift;
235
  my %params = validate(@_, {
236
    folder_path => { type => SCALAR, },
237
  });
169 238
  my $email_import = SL::DB::EmailImport->new(
170 239
    host_name => $self->{hostname},
171 240
    user_name => $self->{username},
172
    folder    => $folder_path,
241
    folder    => $params{folder_path},
173 242
  );
174 243
  return $email_import;
175 244
}
176 245

  
177 246
sub _create_email_journal {
178
  my ($self, $email, $email_import, $uid, $folder_string, $folder_uidvalidity, $params) = @_;
247
  my $self = shift;
248
  my %params = validate(@_, {
249
    email                => { isa => 'Email::MIME', },
250
    email_import         => { isa => 'SL::DB::EmailImport', },
251
    uid                  => { type => SCALAR, },
252
    folder_string        => { type => SCALAR, },
253
    folder_uidvalidity   => { type => SCALAR, },
254
    email_journal_params => { type => HASHREF | UNDEF, optional => 1},
255
  });
179 256

  
257
  my $email = $params{email};
180 258
  if ($email->content_type) { # decode header
181 259
    my $charset = $email->content_type =~ /charset="(.+)"/ ? $1 : undef;
182 260
    if ($charset) {
......
187 265

  
188 266
  my $text_part;
189 267
  my %text_parts;
190
  _find_text_parts(\%text_parts, $email->parts);
268
  my @parts = $email->parts;
269
  _find_text_parts(
270
    text_parts => \%text_parts,
271
    parts      => \@parts,
272
  );
191 273
  my @accepted_text_content_types = ('text/html', 'text/plain', '');
192 274
  $text_part ||= $text_parts{$_} for @accepted_text_content_types;
193 275
  confess "can't find body text in email" unless $text_part;
......
199 281
  my $header_string = join "\r\n",
200 282
    (map { $_ . ': ' . $header_map{$_} } keys %header_map);
201 283

  
202
  my $date = $self->_parse_date($email->header_str('Date'));
284
  my $date = _parse_date($email->header_str('Date'));
203 285

  
204 286
  my $recipients = $email->header_str('To');
205 287
  $recipients .= ', ' . $email->header_str('Cc')  if ($email->header_str('Cc'));
......
222 304
  });
223 305

  
224 306
  my $email_journal = SL::DB::EmailJournal->new(
225
    email_import_id    => $email_import->id,
226
    folder             => $folder_string,
227
    folder_uidvalidity => $folder_uidvalidity,
228
    uid                => $uid,
307
    email_import_id    => $params{email_import}->id,
308
    folder             => $params{folder_string},
309
    folder_uidvalidity => $params{folder_uidvalidity},
310
    uid                => $params{uid},
229 311
    status             => 'imported',
230 312
    extended_status    => '',
231 313
    from               => $email->header_str('From') || '',
......
235 317
    body               => $body_text,
236 318
    headers            => $header_string,
237 319
    attachments        => \@attachments,
238
    %$params,
320
    %{$params{email_journal_params}},
239 321
  );
240 322

  
241 323
  return $email_journal;
242 324
}
243 325

  
326
sub _find_text_parts {
327
  my %params = validate(@_,{
328
    text_parts => {type => HASHREF,},
329
    parts      => {
330
      type => ARRAYREF,
331
      callbacks => {
332
        "contains only 'Email::MIME'" => sub {
333
          !scalar grep {ref $_ ne 'Email::MIME'} @{$_[0]}
334
        },
335
      },
336
    },
337
  });
338
  for my $part (@{$params{parts}}) {
339
    my $content_type = _cleanup_content_type($part->content_type);
340
    if ($content_type =~ m!^text/! or $content_type eq '') {
341
      $params{text_parts}->{$content_type} ||= $part;
342
    }
343
    my @subparts = $part->subparts;
344
    if (scalar @subparts) {
345
      _find_text_parts(
346
        text_parts => $params{text_parts},
347
        parts      => \@subparts,
348
      );
349
    }
350
  }
351
};
352

  
244 353
sub _cleanup_content_type {
245 354
  my ($content_type) = @_;
246 355
  $content_type =~ s/\A\s+//; # Remove whitespaces at begin
......
249 358
  return $content_type;
250 359
};
251 360

  
252
sub _find_text_parts {
253
  my ($text_parts, @parts) = @_;
254
  for my $part (@parts) {
255
    my $content_type = _cleanup_content_type($part->content_type);
256
    if ($content_type =~ m!^text/! or $content_type eq '') {
257
      $text_parts->{$content_type} ||= $part;
258
    }
259
    _find_text_parts($text_parts, $part->subparts);
260
  }
261
};
262

  
263 361
sub _parse_date {
264
  my ($self, $date) = @_;
362
  my ($date) = @_;
265 363
  return '' unless $date;
266 364
  my $parse_date = $date;
267 365
  # replace whitespaces with single space
......
282 380
}
283 381

  
284 382
sub update_email_files_for_record {
285
  my ($self, $record) = @_;
286

  
287
  my $folder_string = $self->_get_folder_string_for_record($record);
383
  my $self = shift;
384
  my %params = validate(@_,{
385
    record => {
386
      isa => [qw(SL::DB::Order)],
387
      can => ['id', 'type'],
388
    },
389
  });
390
  my $record = $params{record};
391
  my $folder_string = $self->_get_folder_string_for_record(record => $record);
288 392
  return unless $self->{imap_client}->exists($folder_string);
289 393
  $self->{imap_client}->select($folder_string)
290 394
    or die "Could not select IMAP folder '$folder_string': $@\n";
......
333 437
sub update_email_subfolders_and_files_for_records {
334 438
  my ($self) = @_;
335 439
  my $base_folder_path = $self->{base_folder};
336
  my $base_folder_string = $self->get_folder_string_from_path($base_folder_path);
440
  my $base_folder_string = $self->get_folder_string_from_path(folder_path => $base_folder_path);
337 441

  
338 442
  my $folder_strings = $self->{imap_client}->folders($base_folder_string)
339 443
    or die "Could not get folders via IMAP: $@\n";
......
341 445

  
342 446
  # Store the emails to the records
343 447
  foreach my $subfolder_string (@subfolder_strings) {
344
    my $ilike_folder_path = $self->get_ilike_folder_path_from_string($subfolder_string);
448
    my $ilike_folder_path = $self->get_ilike_folder_path_from_string(folder_string => $subfolder_string);
345 449
    my (
346 450
      $ilike_record_folder_path, # is greedily matched
347 451
      $ilike_customer_number, # no spaces allowed
......
353 457
    my $record_type = $self->{record_folder_to_type}->{$record_folder};
354 458
    next unless $record_type;
355 459

  
356
    # TODO make it generic for all records
357
    my $is_quotation = $record_type eq 'sales_quotation' ? 1 : 0;
358
    my $number_field = $is_quotation ? 'quonumber' : 'ordnumber';
460
    my $number_field = SL::DB::Order::TypeData->can('get3')->(
461
      $record_type, 'properties', 'nr_key');
359 462
    my $record = SL::DB::Manager::Order->get_first(
360 463
      query => [
361 464
        and => [
362
          vendor_id => undef,
363
          quotation => $is_quotation,
465
          record_type => $record_type,
364 466
          $number_field => { ilike => $ilike_record_number },
365 467
        ],
366 468
    ]);
367 469
    next unless $record;
368
    $self->update_email_files_for_record($record);
470
    $self->update_email_files_for_record(record => $record);
369 471
  }
370 472

  
371 473
  return \@subfolder_strings;
372 474
}
373 475

  
374 476
sub create_folder {
375
  my ($self, $folder_name) = @_;
376
  return if $self->{imap_client}->exists($folder_name);
377
  $self->{imap_client}->create($folder_name)
378
    or die "Could not create IMAP folder '$folder_name': $@\n";
379
  $self->{imap_client}->subscribe($folder_name)
380
    or die "Could not subscribe to IMAP folder '$folder_name': $@\n";
477
  my $self = shift;
478
  my %params = validate(@_, {
479
    folder_string => {type => SCALAR},
480
  });
481
  my $folder_string = $params{folder_string};
482
  return if $self->{imap_client}->exists($folder_string);
483
  $self->{imap_client}->create($folder_string)
484
    or die "Could not create IMAP folder '$folder_string': $@\n";
485
  $self->{imap_client}->subscribe($folder_string)
486
    or die "Could not subscribe to IMAP folder '$folder_string': $@\n";
381 487
  return;
382 488
}
383 489

  
384 490
sub get_folder_string_from_path {
385
  my ($self, $folder_path) = @_;
491
  my $self = shift;
492
  my %params = validate(@_, {
493
    folder_path => {type => SCALAR},
494
  });
495
  my $folder_path = $params{folder_path};
386 496
  my $separator = $self->{imap_client}->separator();
387 497
  if ($separator ne '/') {
388 498
    my $replace_sep = $separator ne '_' ? '_' : '-';
......
394 504
}
395 505

  
396 506
sub get_ilike_folder_path_from_string {
397
  my ($self, $folder_string) = @_;
507
  my $self = shift;
508
  my %params = validate(@_, {
509
    folder_string => {type => SCALAR},
510
  });
511
  my $folder_string = $params{folder_string};
398 512
  my $separator = $self->{imap_client}->separator();
399 513
  my $folder_path = decode('IMAP-UTF-7', $folder_string);
400 514
  $folder_path =~ s|\Q${separator}|/|g; # \Q -> escape special chars
......
403 517
}
404 518

  
405 519
sub create_folder_for_record {
406
  my ($self, $record) = @_;
407
  my $folder_string = $self->_get_folder_string_for_record($record);
408
  $self->create_folder($folder_string);
520
  my $self = shift;
521
  my %params = validate(@_,{
522
    record => {
523
      isa => [qw(SL::DB::Order)],
524
    },
525
  });
526
  my $record = $params{record};
527
  my $folder_string = $self->_get_folder_string_for_record(record => $record);
528
  $self->create_folder(folder_string => $folder_string);
409 529
  return;
410 530
}
411 531

  
412 532
sub clean_up_imported_emails_from_folder {
413
  my ($self, $folder_path) = @_;
414
  $folder_path ||= $self->{base_folder};
415

  
416
  my $folder_string = $self->get_folder_string_from_path($folder_path);
533
  my $self = shift;
534
  my %params = validate(@_, {
535
    folder_path => {type => SCALAR},
536
  });
537
  my $folder_path = $params{folder_path};
538
  my $folder_string = $self->get_folder_string_from_path(folder_path => $folder_path);
417 539
  $self->_clean_up_imported_emails_from_folder_strings([$folder_string]);
418 540
}
419 541

  
420 542

  
421 543
sub _clean_up_imported_emails_from_folder_strings {
422
  my ($self, $folder_strings) = @_;
544
  my $self = shift;
545
  my %params = validate(@_, {
546
    folder_strings => {type => ARRAYREF},
547
  });
548
  my $folder_strings = $params{folder_strings};
423 549
  my $dbh = SL::DB->client->dbh;
424 550

  
425 551
  foreach my $folder_string (@$folder_strings) {
......
456 582
}
457 583

  
458 584
sub clean_up_record_subfolders {
459
  my ($self, $active_records) = @_;
585
  my $self = shift;
586
  my %params = validate(@_, {
587
    active_records => {type => ARRAYREF},
588
  });
589
  my $active_records = $params{active_records};
460 590

  
461 591
  my $subfolder_strings =
462 592
    $self->update_email_subfolders_and_files_for_records();
463 593

  
464
  my @active_folder_strings = map { $self->_get_folder_string_for_record($_) }
594
  my @active_folder_strings = map { $self->_get_folder_string_for_record(record => $_) }
465 595
    @$active_records;
466 596

  
467 597
  my %keep_folder = map { $_ => 1 } @active_folder_strings;
......
474 604
}
475 605

  
476 606
sub _get_folder_string_for_record {
477
  my ($self, $record) = @_;
607
  my $self = shift;
608
  my %params = validate(@_, {
609
    record => {
610
      isa => [qw(SL::DB::Order)],
611
      can => ['record_type', 'customervendor', 'number'],
612
    },
613
  });
614
  my $record = $params{record};
478 615

  
479 616
  my $customer_vendor = $record->customervendor;
480 617

  
......
490 627
  my $record_folder_path =
491 628
    $self->{base_folder} . '/' .
492 629
    $string_parts{cv_number} . ' ' . $string_parts{cv_name} . '/' .
493
    $self->{record_type_to_folder}->{$record->type} . '/' .
630
    $self->{record_type_to_folder}->{$record->record_type} . '/' .
494 631
    $string_parts{record_number};
495
  my $folder_string = $self->get_folder_string_from_path($record_folder_path);
632
  my $folder_string = $self->get_folder_string_from_path(folder_path => $record_folder_path);
496 633
  return $folder_string;
497 634
}
498 635

  
......
553 690
  use SL::IMAPClient;
554 691

  
555 692
  # uses the config in config/kivitendo.conf
556
  my $imap_client = SL::IMAPClient->new();
693
  my $imap_client = SL::IMAPClient->new(%{$::lx_office_conf{imap_client}});
557 694

  
558
  # can also be used with a custom config, overriding the global config
695
  # can also be used with a custom config
559 696
  my %config = (
560 697
    enabled     => 1,
561 698
    hostname    => 'imap.example.com',
......
574 711

  
575 712
  # update emails for record
576 713
  # fetches all emails from the IMAP server and saves them as attachments
577
  $imap_client->update_email_files_for_record($record);
714
  $imap_client->update_email_files_for_record(record => $record);
578 715

  
579 716
=head1 OVERVIEW
580 717

  
......
603 740

  
604 741
=item C<new>
605 742

  
606
  Creates a new SL::IMAPClient object. If no config is passed, the config
607
  from config/kivitendo.conf is used. If a config is passed, the global
608
  config is overridden.
743
  Creates a new SL::IMAPClient object with the given config.
609 744

  
610 745
=item C<DESTROY>
611 746

  
......
654 789
  on unix filesystem. The folder string is the path on the IMAP server.
655 790
  The folder string is encoded in IMAP-UTF-7. It can happend that
656 791
  C<get_folder_string_from_path> and C<get_ilike_folder_path_from_string>
657
  don't cancel each other out. This is because the IMAP server can has a
658
  different Ieparator than the unix filesystem. The changes are made so that a
792
  don't cancel each other out. This is because the IMAP server can have a
793
  different separator than the unix filesystem. The changes are made so that a
659 794
  ILIKE query on the database works.
660 795

  
661 796
=item C<create_folder_for_record>

Auch abrufbar als: Unified diff