SL/IMAPClient.pm

   1 package SL::IMAPClient;
   2
   3 use strict;
   4 use warnings;
   5 use utf8;
   6
   7 use Carp;
   8 use Params::Validate qw(:all);
   9 use List::MoreUtils qw(any);
  10 use IO::Socket::INET;
  11 use IO::Socket::SSL;
  12 use Mail::IMAPClient;
  13 use Email::MIME;
  14 use File::MimeInfo::Magic;
  15 use Encode qw(encode decode);
  16 use Encode::IMAPUTF7;
  17 use SL::Locale;
  18
  19 use SL::SessionFile;
  20 use SL::Locale::String qw(t8);
  21 use SL::DB::EmailImport;
  22 use SL::DB::EmailJournal;
  23 use SL::DB::EmailJournalAttachment;
  24 use SL::DB::Order::TypeData;
  25
  26 use SL::DB::Order;
  27
  28 sub new {
  29   my $class = shift;
  30   my %params = validate(@_, {
  31     enabled     => {
  32       type      => BOOLEAN,
  33       callbacks => {'is enabled' => sub { !!shift }},
  34       optional  => 1,
  35     },
  36     hostname    => { type => SCALAR,  },
  37     port        => { type => SCALAR,  optional => 1, },
  38     ssl         => { type => BOOLEAN, },
  39     username    => { type => SCALAR,  },
  40     password    => { type => SCALAR,  },
  41     base_folder => { type => SCALAR, default => 'INBOX', },
  42   });
  43
  44   # get translation at runtime
  45   my $client_locale = $::locale;
  46   my $server_locale = Locale->new($::lx_office_conf{server}->{language});
  47   $::locale = $server_locale;
  48   my %record_type_to_folder =
  49     map { $_ => SL::DB::Order::TypeData->can('get3')->($_, 'text', 'list') }
  50     @{SL::DB::Order::TypeData->valid_types()};
  51   $::locale = $client_locale;
  52   my %record_folder_to_type = reverse %record_type_to_folder;
  53
  54   my $self = bless {
  55     %params,
  56     record_type_to_folder => \%record_type_to_folder,
  57     record_folder_to_type => \%record_folder_to_type,
  58   }, $class;
  59   $self->_create_imap_client();
  60   return $self;
  61 }
  62
  63 sub DESTROY {
  64   my ($self) = @_;
  65   if ($self->{imap_client}) {
  66     $self->{imap_client}->logout();
  67   }
  68 }
  69
  70 sub store_email_in_email_folder {
  71   my $self = shift;
  72   my %params = validate(@_, {
  73     email_as_string => {
  74       type => SCALAR,
  75       callbacks => {'is not empty' => sub {shift ne ''}},
  76     },
  77     folder          => {
  78       type => SCALAR,
  79       callbacks => {'is not empty' => sub {shift ne ''}},
  80     },
  81   });
  82
  83   my $folder_string = $self->get_folder_string_from_path(folder_path => $params{folder});
  84   $self->{imap_client}->append_string($folder_string, $params{email_as_string})
  85     or die "Could not store email in folder '$folder_string': "
  86            . $self->{imap_client}->LastError() . "\n";
  87 }
  88
  89 sub set_flag_for_email {
  90   my $self = shift;
  91   my %params = validate(@_, {
  92     email_journal => { isa => 'SL::DB::EmailJournal', },
  93     flag          => { type => SCALAR, },
  94   });
  95   my $email_journal = $params{email_journal};
  96   my $flag          = $params{flag};
  97
  98   my $folder_string = $email_journal->folder;
  99
 100   $self->{imap_client}->select($folder_string)
 101     or die "Could not select IMAP folder '$folder_string': $@\n";
 102
 103   my $folder_uidvalidity = $self->{imap_client}->uidvalidity($folder_string)
 104     or die "Could not get UIDVALIDITY for folder '$folder_string': $@\n";
 105
 106   if ($folder_uidvalidity != $email_journal->folder_uidvalidity) {
 107     die "Folder has changed: $folder_string\n"
 108   }
 109
 110   my $uid = $email_journal->uid;
 111   $self->{imap_client}->set_flag($flag, [$uid])
 112     or die "Could not add flag '$flag' to message '$uid': "
 113            . $self->{imap_client}->LastError() . "\n";
 114 }
 115
 116 sub update_emails_from_folder {
 117   my $self = shift;
 118   my %params = validate(@_, {
 119     folder               => {
 120       type     => SCALAR | UNDEF,
 121       optional => 1,
 122     },
 123     email_journal_params => {
 124       type     => HASHREF | UNDEF,
 125       optional => 1,
 126     },
 127   });
 128   my $folder_path = $params{folder} || $self->{base_folder};
 129
 130   my $folder_string = $self->get_folder_string_from_path(folder_path => $folder_path);
 131   my $email_import =
 132     $self->_update_emails_from_folder_strings(
 133       base_folder_path     => $folder_path,
 134       folder_strings       => [$folder_string],
 135       email_journal_params => $params{email_journal_params},
 136     );
 137
 138   return $email_import;
 139 }
 140
 141 sub update_emails_from_subfolders {
 142   my $self = shift;
 143   my %params = validate(@_, {
 144     base_folder           => {
 145       type     => SCALAR,
 146       optional => 1,
 147     },
 148     email_journal_params => {
 149       type     => HASHREF | UNDEF,
 150       optional => 1,
 151     },
 152   });
 153   my $base_folder_path = $params{base_folder} || $self->{base_folder};
 154
 155   my $base_folder_string = $self->get_folder_string_from_path(folder_path => $base_folder_path);
 156   my @subfolder_strings = $self->{imap_client}->folders($base_folder_string)
 157     or die "Could not get subfolders via IMAP: $@\n";
 158   @subfolder_strings = grep { $_ ne $base_folder_string } @subfolder_strings;
 159
 160   my $email_import =
 161     $self->_update_emails_from_folder_strings(
 162       base_folder_path     => $base_folder_path,
 163       folder_strings       => \@subfolder_strings,
 164       email_journal_params => $params{email_journal_params},
 165     );
 166
 167   return $email_import;
 168 }
 169
 170 sub _update_emails_from_folder_strings {
 171   my $self = shift;
 172   my %params = validate(@_, {
 173     base_folder_path => { type => SCALAR,   },
 174     folder_strings   => { type => ARRAYREF, },
 175     email_journal_params => {
 176       type     => HASHREF | UNDEF,
 177       optional => 1,
 178     },
 179   });
 180
 181   my $dbh = SL::DB->client->dbh;
 182
 183   my $email_import;
 184   SL::DB->client->with_transaction(sub {
 185     foreach my $folder_string (@{$params{folder_strings}}) {
 186       $self->{imap_client}->select($folder_string)
 187         or die "Could not select IMAP folder '$folder_string': $@\n";
 188
 189       my $folder_uidvalidity = $self->{imap_client}->uidvalidity($folder_string)
 190         or die "Could not get UIDVALIDITY for folder '$folder_string': $@\n";
 191
 192       my $msg_uids = $self->{imap_client}->messages
 193         or die "Could not get messages via IMAP: $@\n";
 194
 195       my $query = <<SQL;
 196         SELECT uid
 197         FROM email_imports ei
 198         LEFT JOIN email_journal ej
 199           ON ej.email_import_id = ei.id
 200         WHERE ei.host_name = ?
 201           AND ei.user_name = ?
 202           AND ej.folder = ?
 203           AND ej.folder_uidvalidity = ?
 204 SQL
 205
 206       my $existing_uids = $dbh->selectall_hashref($query, 'uid', undef,
 207         $self->{hostname}, $self->{username}, $folder_string, $folder_uidvalidity);
 208
 209       my @new_msg_uids = grep { !$existing_uids->{$_} } @$msg_uids;
 210
 211       next unless @new_msg_uids;
 212
 213       $email_import ||= $self->_create_email_import(folder_path => $params{base_folder_path})->save();
 214
 215       foreach my $new_uid (@new_msg_uids) {
 216         my $new_email_string = $self->{imap_client}->message_string($new_uid);
 217         my $email = Email::MIME->new($new_email_string);
 218         my $email_journal = $self->_create_email_journal(
 219           email                => $email,
 220           email_import         => $email_import,
 221           uid                  => $new_uid,
 222           folder_string        => $folder_string,
 223           folder_uidvalidity   => $folder_uidvalidity,
 224           email_journal_params => $params{email_journal_params},
 225         );
 226         $email_journal->save();
 227       }
 228     }
 229   });
 230
 231   return $email_import;
 232 }
 233
 234 sub _create_email_import {
 235   my $self = shift;
 236   my %params = validate(@_, {
 237     folder_path => { type => SCALAR, },
 238   });
 239   my $email_import = SL::DB::EmailImport->new(
 240     host_name => $self->{hostname},
 241     user_name => $self->{username},
 242     folder    => $params{folder_path},
 243   );
 244   return $email_import;
 245 }
 246
 247 sub _create_email_journal {
 248   my $self = shift;
 249   my %params = validate(@_, {
 250     email                => { isa => 'Email::MIME', },
 251     email_import         => { isa => 'SL::DB::EmailImport', },
 252     uid                  => { type => SCALAR, },
 253     folder_string        => { type => SCALAR, },
 254     folder_uidvalidity   => { type => SCALAR, },
 255     email_journal_params => { type => HASHREF | UNDEF, optional => 1},
 256   });
 257
 258   my $email = $params{email};
 259   if ($email->content_type) { # decode header
 260     my $charset = $email->content_type =~ /charset="([A-Z0-9!#$%&'+-^_`{}~]+)"/i ? $1 : undef;
 261     if ($charset) {
 262       map { $email->header_str_set($_ => decode($charset, $email->header($_))) }
 263         $email->header_names;
 264     }
 265   }
 266
 267   my $text_part;
 268   my %text_parts;
 269   my @parts = $email->parts;
 270   _find_text_parts(
 271     text_parts => \%text_parts,
 272     parts      => \@parts,
 273   );
 274   my @accepted_text_content_types = ('text/html', 'text/plain', '');
 275   $text_part ||= $text_parts{$_} for @accepted_text_content_types;
 276   my $body_text = $text_part ? $text_part->body_str : '';
 277
 278   my %header_map = map { $_ => $email->header_str($_) } $email->header_names;
 279   # We need to store the Content-Type header for the text part
 280   $header_map{'Content-Type'} = $text_part ? $text_part->content_type : 'text/plain';
 281   my $header_string = join "\r\n",
 282     (map { $_ . ': ' . $header_map{$_} } keys %header_map);
 283
 284   my $date = _parse_date($email->header_str('Date'));
 285
 286   my $recipients = $email->header_str('To');
 287   $recipients .= ', ' . $email->header_str('Cc')  if ($email->header_str('Cc'));
 288   $recipients .= ', ' . $email->header_str('Bcc') if ($email->header_str('Bcc'));
 289
 290   my @attachments = ();
 291   $email->walk_parts(sub {
 292     my ($part) = @_;
 293     my $filename = $part->filename;
 294     if ($filename) {
 295       my $mime_type = _cleanup_content_type($part->content_type);
 296       my $content = $part->body;
 297       my $attachment = SL::DB::EmailJournalAttachment->new(
 298         name      => $filename,
 299         content   => $content,
 300         mime_type => $mime_type,
 301       );
 302       push @attachments, $attachment;
 303     }
 304   });
 305
 306   my $email_journal = SL::DB::EmailJournal->new(
 307     email_import_id    => $params{email_import}->id,
 308     folder             => $params{folder_string},
 309     folder_uidvalidity => $params{folder_uidvalidity},
 310     uid                => $params{uid},
 311     status             => 'imported',
 312     extended_status    => '',
 313     from               => $email->header_str('From') || '',
 314     recipients         => $recipients,
 315     sent_on            => $date,
 316     subject            => $email->header_str('Subject') || '',
 317     body               => $body_text,
 318     headers            => $header_string,
 319     attachments        => \@attachments,
 320     %{$params{email_journal_params}},
 321   );
 322
 323   return $email_journal;
 324 }
 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
 353 sub _cleanup_content_type {
 354   my ($content_type) = @_;
 355   $content_type =~ s/\A\s+//; # Remove whitespaces at begin
 356   $content_type =~ s/\s+\z//; # Remove whitespaces at end
 357   $content_type =~ s/;.+//;   # For S/MIME, etc.
 358   return $content_type;
 359 };
 360
 361 sub _parse_date {
 362   my ($date) = @_;
 363   return '' unless $date;
 364   my $parse_date = $date;
 365   # replace whitespaces with single space
 366   $parse_date =~ s/\s+/ /g;
 367   # remove leading and trailing whitespaces
 368   $parse_date =~ s/^\s+|\s+$//g;
 369   # remove day-name
 370   $parse_date =~ s/^[A-Z][a-z][a-z], //;
 371   # add missing seconds
 372   $parse_date =~ s/( \d\d:\d\d) /$1:00 /;
 373   my $strp = DateTime::Format::Strptime->new(
 374     pattern   => '%d %b %Y %H:%M:%S %z',
 375     time_zone => 'UTC',
 376   );
 377   my $dt = $strp->parse_datetime($parse_date)
 378     or die "Could not parse date: $date\n";
 379   return $dt->strftime('%Y-%m-%d %H:%M:%S');
 380 }
 381
 382 sub update_email_files_for_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);
 392   return unless $self->{imap_client}->exists($folder_string);
 393   $self->{imap_client}->select($folder_string)
 394     or die "Could not select IMAP folder '$folder_string': $@\n";
 395
 396   my $msg_uids = $self->{imap_client}->messages
 397     or die "Could not get messages via IMAP: $@\n";
 398
 399   my $dbh = $record->dbh;
 400   my $query = <<SQL;
 401     SELECT uid
 402     FROM files
 403     WHERE object_id = ?
 404       AND object_type = ?
 405       AND source = 'uploaded'
 406       AND file_type = 'attachment'
 407 SQL
 408   my $existing_uids = $dbh->selectall_hashref($query, 'uid', undef,
 409                                               $record->id, $record->type);
 410   my @new_msg_uids = grep { !$existing_uids->{$_} } @$msg_uids;
 411
 412   foreach my $msg_uid (@new_msg_uids) {
 413     my $sess_fname = "mail_download_" . $record->type . "_" . $record->id . "_" . $msg_uid;
 414
 415     my $file_name =
 416       decode('MIME-Header', $self->{imap_client}->subject($msg_uid)) . '.eml';
 417     my $sfile      = SL::SessionFile->new($sess_fname, mode => 'w');
 418     $self->{imap_client}->message_to_file($sfile->fh, $msg_uid)
 419       or die "Could not fetch message $msg_uid from IMAP: $@\n";
 420     $sfile->fh->close;
 421
 422     my $mime_type = File::MimeInfo::Magic::magic($sfile->file_name);
 423     my $fileobj = SL::File->save(
 424       object_id        => $record->id,
 425       object_type      => $record->type,
 426       mime_type        => $mime_type,
 427       source           => 'uploaded',
 428       uid              => "$msg_uid",
 429       file_type        => 'attachment',
 430       file_name        => $file_name,
 431       file_path        => $sfile->file_name
 432     );
 433     unlink($sfile->file_name);
 434   }
 435 }
 436
 437 sub update_email_subfolders_and_files_for_records {
 438   my ($self) = @_;
 439   my $base_folder_path = $self->{base_folder};
 440   my $base_folder_string = $self->get_folder_string_from_path(folder_path => $base_folder_path);
 441
 442   my $folder_strings = $self->{imap_client}->folders($base_folder_string)
 443     or die "Could not get folders via IMAP: $@\n";
 444   my @subfolder_strings = grep { $_ ne $base_folder_string } @$folder_strings;
 445
 446   # Store the emails to the records
 447   foreach my $subfolder_string (@subfolder_strings) {
 448     my $ilike_folder_path = $self->get_ilike_folder_path_from_string(folder_string => $subfolder_string);
 449     my (
 450       $ilike_record_folder_path, # is greedily matched
 451       $ilike_customer_number, # no spaces allowed
 452       $ilike_customer_name,
 453       $record_folder,
 454       $ilike_record_number
 455     ) = $ilike_folder_path =~ m|^(.+)/([^\s]+) (.+)/(.+)/(.+)|;
 456
 457     my $record_type = $self->{record_folder_to_type}->{$record_folder};
 458     next unless $record_type;
 459
 460     my $number_field = SL::DB::Order::TypeData->can('get3')->(
 461       $record_type, 'properties', 'nr_key');
 462     my $record = SL::DB::Manager::Order->get_first(
 463       query => [
 464         and => [
 465           record_type => $record_type,
 466           $number_field => { ilike => $ilike_record_number },
 467         ],
 468     ]);
 469     next unless $record;
 470     $self->update_email_files_for_record(record => $record);
 471   }
 472
 473   return \@subfolder_strings;
 474 }
 475
 476 sub create_folder {
 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";
 487   return;
 488 }
 489
 490 sub get_folder_string_from_path {
 491   my $self = shift;
 492   my %params = validate(@_, {
 493     folder_path => {type => SCALAR},
 494   });
 495   my $folder_path = $params{folder_path};
 496   my $separator = $self->{imap_client}->separator();
 497   if ($separator ne '/') {
 498     my $replace_sep = $separator ne '_' ? '_' : '-';
 499     $folder_path =~ s|\Q${separator}|$replace_sep|g; # \Q -> escape special chars
 500     $folder_path =~ s|/|${separator}|g; # replace / with separator
 501   }
 502   my $folder_string = encode('IMAP-UTF-7', $folder_path);
 503   return $folder_string;
 504 }
 505
 506 sub get_ilike_folder_path_from_string {
 507   my $self = shift;
 508   my %params = validate(@_, {
 509     folder_string => {type => SCALAR},
 510   });
 511   my $folder_string = $params{folder_string};
 512   my $separator = $self->{imap_client}->separator();
 513   my $folder_path = decode('IMAP-UTF-7', $folder_string);
 514   $folder_path =~ s|\Q${separator}|/|g; # \Q -> escape special chars
 515   $folder_path =~ s|-|_|g; # for ilike matching
 516   return $folder_path;
 517 }
 518
 519 sub create_folder_for_record {
 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);
 529   return;
 530 }
 531
 532 sub clean_up_imported_emails_from_folder {
 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);
 539   $self->_clean_up_imported_emails_from_folder_strings([$folder_string]);
 540 }
 541
 542
 543 sub _clean_up_imported_emails_from_folder_strings {
 544   my $self = shift;
 545   my %params = validate(@_, {
 546     folder_strings => {type => ARRAYREF},
 547   });
 548   my $folder_strings = $params{folder_strings};
 549   my $dbh = SL::DB->client->dbh;
 550
 551   foreach my $folder_string (@$folder_strings) {
 552     $self->{imap_client}->select($folder_string)
 553       or die "Could not select IMAP folder '$folder_string': $@\n";
 554
 555     my $folder_uidvalidity = $self->{imap_client}->uidvalidity($folder_string)
 556       or die "Could not get UIDVALIDITY for folder '$folder_string': $@\n";
 557
 558     my $msg_uids = $self->{imap_client}->messages
 559       or die "Could not get messages via IMAP: $@\n";
 560
 561     my $query = <<SQL;
 562       SELECT uid
 563       FROM email_imports ei
 564       LEFT JOIN email_journal ej
 565         ON ej.email_import_id = ei.id
 566       WHERE ei.host_name = ?
 567         AND ei.user_name = ?
 568         AND ej.folder = ?
 569         AND ej.folder_uidvalidity = ?
 570 SQL
 571
 572     my $existing_uids = $dbh->selectall_hashref($query, 'uid', undef,
 573       $self->{hostname}, $self->{username}, $folder_string, $folder_uidvalidity);
 574
 575     my @imported_msg_uids = grep { $existing_uids->{$_} } @$msg_uids;
 576
 577     next unless scalar @imported_msg_uids;
 578
 579     $self->{imap_client}->delete_message(\@imported_msg_uids)
 580       or die "Could not delete messages via IMAP: $@\n";
 581   }
 582 }
 583
 584 sub clean_up_record_subfolders {
 585   my $self = shift;
 586   my %params = validate(@_, {
 587     active_records => {type => ARRAYREF},
 588   });
 589   my $active_records = $params{active_records};
 590
 591   my $subfolder_strings =
 592     $self->update_email_subfolders_and_files_for_records();
 593
 594   my @active_folder_strings = map { $self->_get_folder_string_for_record(record => $_) }
 595     @$active_records;
 596
 597   my %keep_folder = map { $_ => 1 } @active_folder_strings;
 598   my @folders_to_delete = grep { !$keep_folder{$_} } @$subfolder_strings;
 599
 600   foreach my $folder (@folders_to_delete) {
 601     $self->{imap_client}->delete($folder)
 602       or die "Could not delete IMAP folder '$folder': $@\n";
 603   }
 604 }
 605
 606 sub _get_folder_string_for_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};
 615
 616   my $customer_vendor = $record->customervendor;
 617
 618   #repalce / with _
 619   my %string_parts = ();
 620   $string_parts{cv_number}     = $customer_vendor->number;
 621   $string_parts{cv_name}       = $customer_vendor->name;
 622   $string_parts{record_number} = $record->number;
 623   foreach my $key (keys %string_parts) {
 624     $string_parts{$key} =~ s|/|_|g;
 625   }
 626
 627   my $record_folder_path =
 628     $self->{base_folder} . '/' .
 629     $string_parts{cv_number} . ' ' . $string_parts{cv_name} . '/' .
 630     $self->{record_type_to_folder}->{$record->record_type} . '/' .
 631     $string_parts{record_number};
 632   my $folder_string = $self->get_folder_string_from_path(folder_path => $record_folder_path);
 633   return $folder_string;
 634 }
 635
 636 sub _create_imap_client {
 637   my ($self) = @_;
 638
 639   my $socket;
 640   if ($self->{ssl}) {
 641     $socket = IO::Socket::SSL->new(
 642       Proto    => 'tcp',
 643       PeerAddr => $self->{hostname},
 644       PeerPort => $self->{port} || 993,
 645     );
 646   } else {
 647     $socket = IO::Socket::INET->new(
 648       Proto    => 'tcp',
 649       PeerAddr => $self->{hostname},
 650       PeerPort => $self->{port} || 143,
 651     );
 652   }
 653   if (!$socket) {
 654     die "Failed to create socket for IMAP client: $@\n";
 655   }
 656
 657   my $imap_client = Mail::IMAPClient->new(
 658     Socket   => $socket,
 659     User     => $self->{username},
 660     Password => $self->{password},
 661     Uid      => 1,
 662     peek     => 1, # Don't change the \Seen flag
 663   ) or do {
 664     die "Failed to create IMAP Client: $@\n"
 665   };
 666
 667   $imap_client->IsAuthenticated() or do {
 668     die "IMAP Client login failed: " . $imap_client->LastError() . "\n";
 669   };
 670
 671   $self->{imap_client} = $imap_client;
 672   return $imap_client;
 673 }
 674
 675 1;
 676
 677
 678 __END__
 679
 680 =pod
 681
 682 =encoding utf8
 683
 684 =head1 NAME
 685
 686 SL::IMAPClient - Base class for interacting with email server from kivitendo
 687
 688 =head1 SYNOPSIS
 689
 690   use SL::IMAPClient;
 691
 692   # uses the config in config/kivitendo.conf
 693   my $imap_client = SL::IMAPClient->new(%{$::lx_office_conf{imap_client}});
 694
 695   # can also be used with a custom config
 696   my %config = (
 697     enabled     => 1,
 698     hostname    => 'imap.example.com',
 699     username    => 'test_user',
 700     password    => 'test_password',
 701     ssl         => 1,
 702     base_folder => 'INBOX',
 703   );
 704   my $imap_client = SL::IMAPClient->new(%config);
 705
 706   # create email folder for record
 707   # folder structure: base_folder/customer_vendor_number customer_vendor_name/type/record_number
 708   # e.g. INBOX/1234 Testkunde/Angebot/123
 709   # if the folder already exists, nothing happens
 710   $imap_client->create_folder_for_record($record);
 711
 712   # update emails for record
 713   # fetches all emails from the IMAP server and saves them as attachments
 714   $imap_client->update_email_files_for_record(record => $record);
 715
 716 =head1 OVERVIEW
 717
 718 Mail can be sent from kivitendo via the sendmail command or the smtp protocol.
 719
 720
 721 =head1 INTERNAL DATA TYPES
 722
 723 =over 2
 724
 725 =item C<%$self->{record_type_to_folder}>
 726
 727   Due to the lack of a single global mapping for $record->type,
 728   type is mapped to the corresponding translation. All types which
 729   use this module are currently mapped and should be mapped.
 730
 731 =item C<%$self->record_folder_to_type>
 732
 733   The reverse mapping of C<%$self->{record_type_to_folder}>.
 734
 735 =back
 736
 737 =head1 FUNCTIONS
 738
 739 =over 4
 740
 741 =item C<new>
 742
 743   Creates a new SL::IMAPClient object with the given config.
 744
 745 =item C<DESTROY>
 746
 747   Destructor. Disconnects from the IMAP server.
 748
 749 =item C<update_emails_from_folder>
 750
 751   Updates the emails for a folder. Checks which emails are missing and
 752   fetches these from the IMAP server. Returns the created email import object.
 753
 754 =item C<update_emails_from_subfolders>
 755
 756   Updates the emails for all subfolders of a folder. Checks which emails are
 757   missing and fetches these from the IMAP server. Returns the created email
 758   import object.
 759
 760 =item C<_update_emails_from_folder_strings>
 761
 762   Updates the emails for a list of folder strings. Checks which emails are
 763   missing and fetches these from the IMAP server. Returns the created
 764   email import object.
 765
 766 =item C<update_email_files_for_record>
 767
 768   Updates the email files for a record. Checks which emails are missing and
 769   fetches these from the IMAP server.
 770
 771 =item C<update_email_subfolders_and_files_for_records>
 772
 773     Updates all subfolders and the email files for all records.
 774
 775 =item C<create_folder>
 776
 777   Creates a folder on the IMAP server. If the folder already exists, nothing
 778   happens.
 779
 780 =item C<get_folder_string_from_path>
 781
 782   Converts a folder path to a folder string. The folder path is like path
 783   on unix filesystem. The folder string is the path on the IMAP server.
 784   The folder string is encoded in IMAP-UTF-7.
 785
 786 =item C<get_ilike_folder_path_from_string>
 787
 788   Converts a folder string to a folder path. The folder path is like path
 789   on unix filesystem. The folder string is the path on the IMAP server.
 790   The folder string is encoded in IMAP-UTF-7. It can happend that
 791   C<get_folder_string_from_path> and C<get_ilike_folder_path_from_string>
 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
 794   ILIKE query on the database works.
 795
 796 =item C<create_folder_for_record>
 797
 798   Creates a folder for a record on the IMAP server. The folder structure
 799   is like this: base_folder/customer_vendor_number customer_vendor_name/type/record_number
 800   e.g. INBOX/1234 Testkunde/Angebot/123
 801   If the folder already exists, nothing happens.
 802
 803 =item C<clean_up_record_subfolders>
 804
 805   Gets a list of acitve records. Syncs all subfolders and add email files to
 806   the records. Then deletes all subfolders which are not corresponding to an
 807   active record.
 808
 809 =item C<_get_folder_string_for_record>
 810
 811   Returns the folder string for a record. The folder structure is like this:
 812   base_folder/customer_vendor_number customer_vendor_name/type/record_number
 813   e.g. INBOX/1234 Testkunde/Angebot/123. This is passed through
 814   C<get_folder_string_from_path>.
 815
 816 =item C<_create_imap_client>
 817
 818   Creates a new IMAP client and logs in. The IMAP client is stored in
 819   $self->{imap_client}.
 820
 821 =back
 822
 823 =head1 BUGS
 824
 825 The mapping from record to email folder is not bijective. If the record or
 826 customer number has special characters, the mapping can fail. Read
 827 C<get_ilike_folder_path_from_string> for more information.
 828
 829 =head1 AUTHOR
 830
 831 Tamino Steinert E<lt>tamino.steinert@tamino.stE<gt>
 832
 833 =cut