Projekt

Allgemein

Profil

Herunterladen (24,9 KB) Statistiken
| Zweig: | Markierung: | Revision:

kivitendo/SL/IMAPClient.pm @ 68748667

a992797b Tamino Steinert
package SL::IMAPClient;

use strict;
use warnings;
use utf8;

360dbe68 Tamino Steinert
use Carp;
9ea083c2 Tamino Steinert
use Params::Validate qw(:all);
use List::MoreUtils qw(any);
a992797b Tamino Steinert
use IO::Socket::INET;
use IO::Socket::SSL;
use Mail::IMAPClient;
794df533 Tamino Steinert
use Email::MIME;
a992797b Tamino Steinert
use File::MimeInfo::Magic;
use Encode qw(encode decode);
use Encode::IMAPUTF7;
67e51032 Tamino Steinert
use SL::Locale;
a992797b Tamino Steinert
use SL::SessionFile;
use SL::Locale::String qw(t8);
794df533 Tamino Steinert
use SL::DB::EmailImport;
use SL::DB::EmailJournal;
ab7a995e Tamino Steinert
use SL::DB::EmailJournalAttachment;
9ea083c2 Tamino Steinert
use SL::DB::Order::TypeData;
a992797b Tamino Steinert
ab7a995e Tamino Steinert
use SL::DB::Order;

a992797b Tamino Steinert
sub new {
9ea083c2 Tamino Steinert
my $class = shift;
my %params = validate(@_, {
enabled => {
91abb12b Tamino Steinert
type => BOOLEAN,
callbacks => {'is enabled' => sub { !!shift }},
optional => 1,
9ea083c2 Tamino Steinert
},
hostname => { type => SCALAR, },
port => { type => SCALAR, optional => 1, },
ssl => { type => BOOLEAN, },
username => { type => SCALAR, },
password => { type => SCALAR, },
base_folder => { type => SCALAR, default => 'INBOX', },
});

# get translation at runtime
my $client_locale = $::locale;
67e51032 Tamino Steinert
my $server_locale = Locale->new($::lx_office_conf{server}->{language});
9ea083c2 Tamino Steinert
$::locale = $server_locale;
my %record_type_to_folder =
map { $_ => SL::DB::Order::TypeData->can('get3')->($_, 'text', 'list') }
@{SL::DB::Order::TypeData->valid_types()};
$::locale = $client_locale;
67e51032 Tamino Steinert
my %record_folder_to_type = reverse %record_type_to_folder;
9ea083c2 Tamino Steinert
a992797b Tamino Steinert
my $self = bless {
9ea083c2 Tamino Steinert
%params,
67e51032 Tamino Steinert
record_type_to_folder => \%record_type_to_folder,
record_folder_to_type => \%record_folder_to_type,
a992797b Tamino Steinert
}, $class;
$self->_create_imap_client();
return $self;
}

sub DESTROY {
my ($self) = @_;
if ($self->{imap_client}) {
$self->{imap_client}->logout();
}
}

0572a0b8 Tamino Steinert
sub store_email_in_email_folder {
9ea083c2 Tamino Steinert
my $self = shift;
my %params = validate(@_, {
email_as_string => {
type => SCALAR,
callbacks => {'is not empty' => sub {shift ne ''}},
},
folder => {
type => SCALAR,
callbacks => {'is not empty' => sub {shift ne ''}},
},
});
0572a0b8 Tamino Steinert
9ea083c2 Tamino Steinert
my $folder_string = $self->get_folder_string_from_path(folder_path => $params{folder});
$self->{imap_client}->append_string($folder_string, $params{email_as_string})
0572a0b8 Tamino Steinert
or die "Could not store email in folder '$folder_string': "
. $self->{imap_client}->LastError() . "\n";
}

70b4058b Tamino Steinert
sub set_flag_for_email {
9ea083c2 Tamino Steinert
my $self = shift;
my %params = validate(@_, {
email_journal => { isa => 'SL::DB::EmailJournal', },
flag => { type => SCALAR, },
});
my $email_journal = $params{email_journal};
my $flag = $params{flag};
70b4058b Tamino Steinert
my $folder_string = $email_journal->folder;

$self->{imap_client}->select($folder_string)
or die "Could not select IMAP folder '$folder_string': $@\n";

my $folder_uidvalidity = $self->{imap_client}->uidvalidity($folder_string)
or die "Could not get UIDVALIDITY for folder '$folder_string': $@\n";

if ($folder_uidvalidity != $email_journal->folder_uidvalidity) {
die "Folder has changed: $folder_string\n"
}

my $uid = $email_journal->uid;
9ea083c2 Tamino Steinert
$self->{imap_client}->set_flag($flag, [$uid])
or die "Could not add flag '$flag' to message '$uid': "
70b4058b Tamino Steinert
. $self->{imap_client}->LastError() . "\n";
}

794df533 Tamino Steinert
sub update_emails_from_folder {
9ea083c2 Tamino Steinert
my $self = shift;
my %params = validate(@_, {
folder => {
type => SCALAR | UNDEF,
optional => 1,
},
email_journal_params => {
type => HASHREF | UNDEF,
optional => 1,
},
});
my $folder_path = $params{folder} || $self->{base_folder};
794df533 Tamino Steinert
9ea083c2 Tamino Steinert
my $folder_string = $self->get_folder_string_from_path(folder_path => $folder_path);
ab7a995e Tamino Steinert
my $email_import =
9ea083c2 Tamino Steinert
$self->_update_emails_from_folder_strings(
base_folder_path => $folder_path,
folder_strings => [$folder_string],
email_journal_params => $params{email_journal_params},
);
794df533 Tamino Steinert
ab7a995e Tamino Steinert
return $email_import;
}
794df533 Tamino Steinert
ab7a995e Tamino Steinert
sub update_emails_from_subfolders {
9ea083c2 Tamino Steinert
my $self = shift;
my %params = validate(@_, {
base_folder => {
type => SCALAR,
optional => 1,
},
email_journal_params => {
type => HASHREF | UNDEF,
optional => 1,
},
});
my $base_folder_path = $params{base_folder} || $self->{base_folder};
794df533 Tamino Steinert
9ea083c2 Tamino Steinert
my $base_folder_string = $self->get_folder_string_from_path(folder_path => $base_folder_path);
ab7a995e Tamino Steinert
my @subfolder_strings = $self->{imap_client}->folders($base_folder_string)
or die "Could not get subfolders via IMAP: $@\n";
@subfolder_strings = grep { $_ ne $base_folder_string } @subfolder_strings;
794df533 Tamino Steinert
ab7a995e Tamino Steinert
my $email_import =
9ea083c2 Tamino Steinert
$self->_update_emails_from_folder_strings(
base_folder_path => $base_folder_path,
folder_strings => \@subfolder_strings,
email_journal_params => $params{email_journal_params},
);
ab7a995e Tamino Steinert
return $email_import;
}
794df533 Tamino Steinert
ab7a995e Tamino Steinert
sub _update_emails_from_folder_strings {
9ea083c2 Tamino Steinert
my $self = shift;
my %params = validate(@_, {
base_folder_path => { type => SCALAR, },
folder_strings => { type => ARRAYREF, },
email_journal_params => {
type => HASHREF | UNDEF,
optional => 1,
},
});
794df533 Tamino Steinert
ab7a995e Tamino Steinert
my $dbh = SL::DB->client->dbh;

my $email_import;
794df533 Tamino Steinert
SL::DB->client->with_transaction(sub {
9ea083c2 Tamino Steinert
foreach my $folder_string (@{$params{folder_strings}}) {
ab7a995e Tamino Steinert
$self->{imap_client}->select($folder_string)
or die "Could not select IMAP folder '$folder_string': $@\n";

5d8e7dc9 Tamino Steinert
my $folder_uidvalidity = $self->{imap_client}->uidvalidity($folder_string)
or die "Could not get UIDVALIDITY for folder '$folder_string': $@\n";

ab7a995e Tamino Steinert
my $msg_uids = $self->{imap_client}->messages
or die "Could not get messages via IMAP: $@\n";

my $query = <<SQL;
SELECT uid
FROM email_imports ei
LEFT JOIN email_journal ej
ON ej.email_import_id = ei.id
WHERE ei.host_name = ?
AND ei.user_name = ?
AND ej.folder = ?
5d8e7dc9 Tamino Steinert
AND ej.folder_uidvalidity = ?
ab7a995e Tamino Steinert
SQL

my $existing_uids = $dbh->selectall_hashref($query, 'uid', undef,
5d8e7dc9 Tamino Steinert
$self->{hostname}, $self->{username}, $folder_string, $folder_uidvalidity);
ab7a995e Tamino Steinert
my @new_msg_uids = grep { !$existing_uids->{$_} } @$msg_uids;

next unless @new_msg_uids;

9ea083c2 Tamino Steinert
$email_import ||= $self->_create_email_import(folder_path => $params{base_folder_path})->save();
ab7a995e Tamino Steinert
foreach my $new_uid (@new_msg_uids) {
my $new_email_string = $self->{imap_client}->message_string($new_uid);
my $email = Email::MIME->new($new_email_string);
my $email_journal = $self->_create_email_journal(
9ea083c2 Tamino Steinert
email => $email,
email_import => $email_import,
uid => $new_uid,
folder_string => $folder_string,
folder_uidvalidity => $folder_uidvalidity,
email_journal_params => $params{email_journal_params},
ab7a995e Tamino Steinert
);
$email_journal->save();
}
794df533 Tamino Steinert
}
});

ab7a995e Tamino Steinert
return $email_import;
794df533 Tamino Steinert
}

sub _create_email_import {
9ea083c2 Tamino Steinert
my $self = shift;
my %params = validate(@_, {
folder_path => { type => SCALAR, },
});
794df533 Tamino Steinert
my $email_import = SL::DB::EmailImport->new(
host_name => $self->{hostname},
user_name => $self->{username},
9ea083c2 Tamino Steinert
folder => $params{folder_path},
794df533 Tamino Steinert
);
return $email_import;
}

sub _create_email_journal {
9ea083c2 Tamino Steinert
my $self = shift;
my %params = validate(@_, {
email => { isa => 'Email::MIME', },
email_import => { isa => 'SL::DB::EmailImport', },
uid => { type => SCALAR, },
folder_string => { type => SCALAR, },
folder_uidvalidity => { type => SCALAR, },
email_journal_params => { type => HASHREF | UNDEF, optional => 1},
});
794df533 Tamino Steinert
9ea083c2 Tamino Steinert
my $email = $params{email};
53c42274 Tamino Steinert
if ($email->content_type) { # decode header
36c58ad3 Tamino Steinert
my $charset = $email->content_type =~ /charset="([A-Z0-9!#$%&'+-^_`{}~]+)"/i ? $1 : undef;
53c42274 Tamino Steinert
if ($charset) {
map { $email->header_str_set($_ => decode($charset, $email->header($_))) }
$email->header_names;
}
}

360dbe68 Tamino Steinert
my $text_part;
my %text_parts;
9ea083c2 Tamino Steinert
my @parts = $email->parts;
_find_text_parts(
text_parts => \%text_parts,
parts => \@parts,
);
360dbe68 Tamino Steinert
my @accepted_text_content_types = ('text/html', 'text/plain', '');
$text_part ||= $text_parts{$_} for @accepted_text_content_types;
9dc7e74d Tamino Steinert
my $body_text = $text_part ? $text_part->body_str : '';
794df533 Tamino Steinert
53c42274 Tamino Steinert
my %header_map = map { $_ => $email->header_str($_) } $email->header_names;
# We need to store the Content-Type header for the text part
9dc7e74d Tamino Steinert
$header_map{'Content-Type'} = $text_part ? $text_part->content_type : 'text/plain';
794df533 Tamino Steinert
my $header_string = join "\r\n",
53c42274 Tamino Steinert
(map { $_ . ': ' . $header_map{$_} } keys %header_map);
794df533 Tamino Steinert
9ea083c2 Tamino Steinert
my $date = _parse_date($email->header_str('Date'));
794df533 Tamino Steinert
53c42274 Tamino Steinert
my $recipients = $email->header_str('To');
$recipients .= ', ' . $email->header_str('Cc') if ($email->header_str('Cc'));
$recipients .= ', ' . $email->header_str('Bcc') if ($email->header_str('Bcc'));
794df533 Tamino Steinert
my @attachments = ();
$email->walk_parts(sub {
my ($part) = @_;
my $filename = $part->filename;
if ($filename) {
360dbe68 Tamino Steinert
my $mime_type = _cleanup_content_type($part->content_type);
794df533 Tamino Steinert
my $content = $part->body;
my $attachment = SL::DB::EmailJournalAttachment->new(
name => $filename,
content => $content,
a991586c Tamino Steinert
mime_type => $mime_type,
794df533 Tamino Steinert
);
push @attachments, $attachment;
}
});

my $email_journal = SL::DB::EmailJournal->new(
9ea083c2 Tamino Steinert
email_import_id => $params{email_import}->id,
folder => $params{folder_string},
folder_uidvalidity => $params{folder_uidvalidity},
uid => $params{uid},
5d8e7dc9 Tamino Steinert
status => 'imported',
extended_status => '',
53c42274 Tamino Steinert
from => $email->header_str('From') || '',
5d8e7dc9 Tamino Steinert
recipients => $recipients,
sent_on => $date,
53c42274 Tamino Steinert
subject => $email->header_str('Subject') || '',
body => $body_text,
5d8e7dc9 Tamino Steinert
headers => $header_string,
attachments => \@attachments,
9ea083c2 Tamino Steinert
%{$params{email_journal_params}},
794df533 Tamino Steinert
);

return $email_journal;
}

9ea083c2 Tamino Steinert
sub _find_text_parts {
my %params = validate(@_,{
text_parts => {type => HASHREF,},
parts => {
type => ARRAYREF,
callbacks => {
"contains only 'Email::MIME'" => sub {
!scalar grep {ref $_ ne 'Email::MIME'} @{$_[0]}
},
},
},
});
for my $part (@{$params{parts}}) {
my $content_type = _cleanup_content_type($part->content_type);
if ($content_type =~ m!^text/! or $content_type eq '') {
$params{text_parts}->{$content_type} ||= $part;
}
my @subparts = $part->subparts;
if (scalar @subparts) {
_find_text_parts(
text_parts => $params{text_parts},
parts => \@subparts,
);
}
}
};

360dbe68 Tamino Steinert
sub _cleanup_content_type {
my ($content_type) = @_;
$content_type =~ s/\A\s+//; # Remove whitespaces at begin
$content_type =~ s/\s+\z//; # Remove whitespaces at end
$content_type =~ s/;.+//; # For S/MIME, etc.
return $content_type;
};

794df533 Tamino Steinert
sub _parse_date {
9ea083c2 Tamino Steinert
my ($date) = @_;
794df533 Tamino Steinert
return '' unless $date;
50a4349d Tamino Steinert
my $parse_date = $date;
# replace whitespaces with single space
$parse_date =~ s/\s+/ /g;
# remove leading and trailing whitespaces
$parse_date =~ s/^\s+|\s+$//g;
# remove day-name
$parse_date =~ s/^[A-Z][a-z][a-z], //;
# add missing seconds
$parse_date =~ s/( \d\d:\d\d) /$1:00 /;
794df533 Tamino Steinert
my $strp = DateTime::Format::Strptime->new(
50a4349d Tamino Steinert
pattern => '%d %b %Y %H:%M:%S %z',
794df533 Tamino Steinert
time_zone => 'UTC',
);
50a4349d Tamino Steinert
my $dt = $strp->parse_datetime($parse_date)
or die "Could not parse date: $date\n";
794df533 Tamino Steinert
return $dt->strftime('%Y-%m-%d %H:%M:%S');
}

ab7a995e Tamino Steinert
sub update_email_files_for_record {
9ea083c2 Tamino Steinert
my $self = shift;
my %params = validate(@_,{
record => {
isa => [qw(SL::DB::Order)],
can => ['id', 'type'],
},
});
my $record = $params{record};
my $folder_string = $self->_get_folder_string_for_record(record => $record);
a992797b Tamino Steinert
return unless $self->{imap_client}->exists($folder_string);
$self->{imap_client}->select($folder_string)
or die "Could not select IMAP folder '$folder_string': $@\n";

my $msg_uids = $self->{imap_client}->messages
ab7a995e Tamino Steinert
or die "Could not get messages via IMAP: $@\n";
a992797b Tamino Steinert
my $dbh = $record->dbh;
my $query = <<SQL;
SELECT uid
FROM files
WHERE object_id = ?
AND object_type = ?
AND source = 'uploaded'
AND file_type = 'attachment'
SQL
my $existing_uids = $dbh->selectall_hashref($query, 'uid', undef,
$record->id, $record->type);
my @new_msg_uids = grep { !$existing_uids->{$_} } @$msg_uids;

foreach my $msg_uid (@new_msg_uids) {
my $sess_fname = "mail_download_" . $record->type . "_" . $record->id . "_" . $msg_uid;

my $file_name =
decode('MIME-Header', $self->{imap_client}->subject($msg_uid)) . '.eml';
my $sfile = SL::SessionFile->new($sess_fname, mode => 'w');
$self->{imap_client}->message_to_file($sfile->fh, $msg_uid)
or die "Could not fetch message $msg_uid from IMAP: $@\n";
$sfile->fh->close;

my $mime_type = File::MimeInfo::Magic::magic($sfile->file_name);
my $fileobj = SL::File->save(
object_id => $record->id,
object_type => $record->type,
mime_type => $mime_type,
source => 'uploaded',
uid => "$msg_uid",
file_type => 'attachment',
file_name => $file_name,
file_path => $sfile->file_name
);
unlink($sfile->file_name);
}
ab7a995e Tamino Steinert
}
a992797b Tamino Steinert
0eebc84f Tamino Steinert
sub update_email_subfolders_and_files_for_records {
ab7a995e Tamino Steinert
my ($self) = @_;
0eebc84f Tamino Steinert
my $base_folder_path = $self->{base_folder};
9ea083c2 Tamino Steinert
my $base_folder_string = $self->get_folder_string_from_path(folder_path => $base_folder_path);
ab7a995e Tamino Steinert
0eebc84f Tamino Steinert
my $folder_strings = $self->{imap_client}->folders($base_folder_string)
ab7a995e Tamino Steinert
or die "Could not get folders via IMAP: $@\n";
0eebc84f Tamino Steinert
my @subfolder_strings = grep { $_ ne $base_folder_string } @$folder_strings;

# Store the emails to the records
foreach my $subfolder_string (@subfolder_strings) {
9ea083c2 Tamino Steinert
my $ilike_folder_path = $self->get_ilike_folder_path_from_string(folder_string => $subfolder_string);
ab7a995e Tamino Steinert
my (
$ilike_record_folder_path, # is greedily matched
$ilike_customer_number, # no spaces allowed
$ilike_customer_name,
$record_folder,
$ilike_record_number
) = $ilike_folder_path =~ m|^(.+)/([^\s]+) (.+)/(.+)/(.+)|;

67e51032 Tamino Steinert
my $record_type = $self->{record_folder_to_type}->{$record_folder};
ab7a995e Tamino Steinert
next unless $record_type;

9ea083c2 Tamino Steinert
my $number_field = SL::DB::Order::TypeData->can('get3')->(
$record_type, 'properties', 'nr_key');
0eebc84f Tamino Steinert
my $record = SL::DB::Manager::Order->get_first(
ab7a995e Tamino Steinert
query => [
and => [
9ea083c2 Tamino Steinert
record_type => $record_type,
ab7a995e Tamino Steinert
$number_field => { ilike => $ilike_record_number },
],
]);
0eebc84f Tamino Steinert
next unless $record;
9ea083c2 Tamino Steinert
$self->update_email_files_for_record(record => $record);
ab7a995e Tamino Steinert
}
0eebc84f Tamino Steinert
399b215e Tamino Steinert
return \@subfolder_strings;
a992797b Tamino Steinert
}

sub create_folder {
9ea083c2 Tamino Steinert
my $self = shift;
my %params = validate(@_, {
folder_string => {type => SCALAR},
});
my $folder_string = $params{folder_string};
return if $self->{imap_client}->exists($folder_string);
$self->{imap_client}->create($folder_string)
or die "Could not create IMAP folder '$folder_string': $@\n";
$self->{imap_client}->subscribe($folder_string)
or die "Could not subscribe to IMAP folder '$folder_string': $@\n";
a992797b Tamino Steinert
return;
}

sub get_folder_string_from_path {
9ea083c2 Tamino Steinert
my $self = shift;
my %params = validate(@_, {
folder_path => {type => SCALAR},
});
my $folder_path = $params{folder_path};
a992797b Tamino Steinert
my $separator = $self->{imap_client}->separator();
ab7a995e Tamino Steinert
if ($separator ne '/') {
my $replace_sep = $separator ne '_' ? '_' : '-';
$folder_path =~ s|\Q${separator}|$replace_sep|g; # \Q -> escape special chars
$folder_path =~ s|/|${separator}|g; # replace / with separator
}
a992797b Tamino Steinert
my $folder_string = encode('IMAP-UTF-7', $folder_path);
return $folder_string;
}

ab7a995e Tamino Steinert
sub get_ilike_folder_path_from_string {
9ea083c2 Tamino Steinert
my $self = shift;
my %params = validate(@_, {
folder_string => {type => SCALAR},
});
my $folder_string = $params{folder_string};
ab7a995e Tamino Steinert
my $separator = $self->{imap_client}->separator();
my $folder_path = decode('IMAP-UTF-7', $folder_string);
$folder_path =~ s|\Q${separator}|/|g; # \Q -> escape special chars
$folder_path =~ s|-|_|g; # for ilike matching
return $folder_path;
}

a992797b Tamino Steinert
sub create_folder_for_record {
9ea083c2 Tamino Steinert
my $self = shift;
my %params = validate(@_,{
record => {
isa => [qw(SL::DB::Order)],
},
});
my $record = $params{record};
my $folder_string = $self->_get_folder_string_for_record(record => $record);
$self->create_folder(folder_string => $folder_string);
a992797b Tamino Steinert
return;
}

048775dc Tamino Steinert
sub clean_up_imported_emails_from_folder {
9ea083c2 Tamino Steinert
my $self = shift;
my %params = validate(@_, {
folder_path => {type => SCALAR},
});
my $folder_path = $params{folder_path};
my $folder_string = $self->get_folder_string_from_path(folder_path => $folder_path);
048775dc Tamino Steinert
$self->_clean_up_imported_emails_from_folder_strings([$folder_string]);
}


sub _clean_up_imported_emails_from_folder_strings {
9ea083c2 Tamino Steinert
my $self = shift;
my %params = validate(@_, {
folder_strings => {type => ARRAYREF},
});
my $folder_strings = $params{folder_strings};
048775dc Tamino Steinert
my $dbh = SL::DB->client->dbh;

foreach my $folder_string (@$folder_strings) {
$self->{imap_client}->select($folder_string)
or die "Could not select IMAP folder '$folder_string': $@\n";

my $folder_uidvalidity = $self->{imap_client}->uidvalidity($folder_string)
or die "Could not get UIDVALIDITY for folder '$folder_string': $@\n";

my $msg_uids = $self->{imap_client}->messages
or die "Could not get messages via IMAP: $@\n";

my $query = <<SQL;
SELECT uid
FROM email_imports ei
LEFT JOIN email_journal ej
ON ej.email_import_id = ei.id
WHERE ei.host_name = ?
AND ei.user_name = ?
AND ej.folder = ?
AND ej.folder_uidvalidity = ?
SQL

my $existing_uids = $dbh->selectall_hashref($query, 'uid', undef,
$self->{hostname}, $self->{username}, $folder_string, $folder_uidvalidity);

my @imported_msg_uids = grep { $existing_uids->{$_} } @$msg_uids;

next unless scalar @imported_msg_uids;

$self->{imap_client}->delete_message(\@imported_msg_uids)
or die "Could not delete messages via IMAP: $@\n";
}
}

cdc08b42 Tamino Steinert
sub clean_up_record_subfolders {
9ea083c2 Tamino Steinert
my $self = shift;
my %params = validate(@_, {
active_records => {type => ARRAYREF},
});
my $active_records = $params{active_records};
ab7a995e Tamino Steinert
399b215e Tamino Steinert
my $subfolder_strings =
0eebc84f Tamino Steinert
$self->update_email_subfolders_and_files_for_records();
ab7a995e Tamino Steinert
9ea083c2 Tamino Steinert
my @active_folder_strings = map { $self->_get_folder_string_for_record(record => $_) }
ab7a995e Tamino Steinert
@$active_records;

399b215e Tamino Steinert
my %keep_folder = map { $_ => 1 } @active_folder_strings;
my @folders_to_delete = grep { !$keep_folder{$_} } @$subfolder_strings;
ab7a995e Tamino Steinert
foreach my $folder (@folders_to_delete) {
$self->{imap_client}->delete($folder)
or die "Could not delete IMAP folder '$folder': $@\n";
}
}

a992797b Tamino Steinert
sub _get_folder_string_for_record {
9ea083c2 Tamino Steinert
my $self = shift;
my %params = validate(@_, {
record => {
isa => [qw(SL::DB::Order)],
can => ['record_type', 'customervendor', 'number'],
},
});
my $record = $params{record};
a992797b Tamino Steinert
my $customer_vendor = $record->customervendor;
ab7a995e Tamino Steinert
#repalce / with _
my %string_parts = ();
$string_parts{cv_number} = $customer_vendor->number;
$string_parts{cv_name} = $customer_vendor->name;
$string_parts{record_number} = $record->number;
foreach my $key (keys %string_parts) {
$string_parts{$key} =~ s|/|_|g;
}

a992797b Tamino Steinert
my $record_folder_path =
$self->{base_folder} . '/' .
ab7a995e Tamino Steinert
$string_parts{cv_number} . ' ' . $string_parts{cv_name} . '/' .
9ea083c2 Tamino Steinert
$self->{record_type_to_folder}->{$record->record_type} . '/' .
ab7a995e Tamino Steinert
$string_parts{record_number};
9ea083c2 Tamino Steinert
my $folder_string = $self->get_folder_string_from_path(folder_path => $record_folder_path);
a992797b Tamino Steinert
return $folder_string;
}

sub _create_imap_client {
my ($self) = @_;

my $socket;
if ($self->{ssl}) {
$socket = IO::Socket::SSL->new(
Proto => 'tcp',
PeerAddr => $self->{hostname},
PeerPort => $self->{port} || 993,
);
} else {
$socket = IO::Socket::INET->new(
Proto => 'tcp',
PeerAddr => $self->{hostname},
PeerPort => $self->{port} || 143,
);
}
if (!$socket) {
die "Failed to create socket for IMAP client: $@\n";
}

my $imap_client = Mail::IMAPClient->new(
Socket => $socket,
User => $self->{username},
Password => $self->{password},
Uid => 1,
peek => 1, # Don't change the \Seen flag
) or do {
die "Failed to create IMAP Client: $@\n"
};

$imap_client->IsAuthenticated() or do {
die "IMAP Client login failed: " . $imap_client->LastError() . "\n";
};

$self->{imap_client} = $imap_client;
return $imap_client;
}

1;


__END__

=pod

=encoding utf8

=head1 NAME

SL::IMAPClient - Base class for interacting with email server from kivitendo

=head1 SYNOPSIS

use SL::IMAPClient;

# uses the config in config/kivitendo.conf
9ea083c2 Tamino Steinert
my $imap_client = SL::IMAPClient->new(%{$::lx_office_conf{imap_client}});
a992797b Tamino Steinert
9ea083c2 Tamino Steinert
# can also be used with a custom config
a992797b Tamino Steinert
my %config = (
enabled => 1,
hostname => 'imap.example.com',
username => 'test_user',
password => 'test_password',
ssl => 1,
base_folder => 'INBOX',
);
my $imap_client = SL::IMAPClient->new(%config);

# create email folder for record
# folder structure: base_folder/customer_vendor_number customer_vendor_name/type/record_number
# e.g. INBOX/1234 Testkunde/Angebot/123
# if the folder already exists, nothing happens
$imap_client->create_folder_for_record($record);

# update emails for record
# fetches all emails from the IMAP server and saves them as attachments
9ea083c2 Tamino Steinert
$imap_client->update_email_files_for_record(record => $record);
a992797b Tamino Steinert
=head1 OVERVIEW

Mail can be sent from kivitendo via the sendmail command or the smtp protocol.


=head1 INTERNAL DATA TYPES

=over 2

67e51032 Tamino Steinert
=item C<%$self->{record_type_to_folder}>
a992797b Tamino Steinert
Due to the lack of a single global mapping for $record->type,
type is mapped to the corresponding translation. All types which
use this module are currently mapped and should be mapped.

67e51032 Tamino Steinert
=item C<%$self->record_folder_to_type>
ab7a995e Tamino Steinert
67e51032 Tamino Steinert
The reverse mapping of C<%$self->{record_type_to_folder}>.
ab7a995e Tamino Steinert
a992797b Tamino Steinert
=back

=head1 FUNCTIONS

=over 4

=item C<new>

9ea083c2 Tamino Steinert
Creates a new SL::IMAPClient object with the given config.
a992797b Tamino Steinert
=item C<DESTROY>

Destructor. Disconnects from the IMAP server.

ab7a995e Tamino Steinert
=item C<update_emails_from_folder>

Updates the emails for a folder. Checks which emails are missing and
fetches these from the IMAP server. Returns the created email import object.

=item C<update_emails_from_subfolders>

Updates the emails for all subfolders of a folder. Checks which emails are
missing and fetches these from the IMAP server. Returns the created email
import object.

=item C<_update_emails_from_folder_strings>
a992797b Tamino Steinert
ab7a995e Tamino Steinert
Updates the emails for a list of folder strings. Checks which emails are
missing and fetches these from the IMAP server. Returns the created
email import object.

=item C<update_email_files_for_record>

Updates the email files for a record. Checks which emails are missing and
a992797b Tamino Steinert
fetches these from the IMAP server.

0eebc84f Tamino Steinert
=item C<update_email_subfolders_and_files_for_records>

Updates all subfolders and the email files for all records.
ab7a995e Tamino Steinert
a992797b Tamino Steinert
=item C<create_folder>

Creates a folder on the IMAP server. If the folder already exists, nothing
happens.

=item C<get_folder_string_from_path>

Converts a folder path to a folder string. The folder path is like path
on unix filesystem. The folder string is the path on the IMAP server.
The folder string is encoded in IMAP-UTF-7.

ab7a995e Tamino Steinert
=item C<get_ilike_folder_path_from_string>
0eebc84f Tamino Steinert
ab7a995e Tamino Steinert
Converts a folder string to a folder path. The folder path is like path
on unix filesystem. The folder string is the path on the IMAP server.
The folder string is encoded in IMAP-UTF-7. It can happend that
C<get_folder_string_from_path> and C<get_ilike_folder_path_from_string>
9ea083c2 Tamino Steinert
don't cancel each other out. This is because the IMAP server can have a
different separator than the unix filesystem. The changes are made so that a
0eebc84f Tamino Steinert
ILIKE query on the database works.
ab7a995e Tamino Steinert
a992797b Tamino Steinert
=item C<create_folder_for_record>

Creates a folder for a record on the IMAP server. The folder structure
is like this: base_folder/customer_vendor_number customer_vendor_name/type/record_number
e.g. INBOX/1234 Testkunde/Angebot/123
If the folder already exists, nothing happens.

cdc08b42 Tamino Steinert
=item C<clean_up_record_subfolders>
ab7a995e Tamino Steinert
0eebc84f Tamino Steinert
Gets a list of acitve records. Syncs all subfolders and add email files to
the records. Then deletes all subfolders which are not corresponding to an
active record.
ab7a995e Tamino Steinert
a992797b Tamino Steinert
=item C<_get_folder_string_for_record>

Returns the folder string for a record. The folder structure is like this:
base_folder/customer_vendor_number customer_vendor_name/type/record_number
e.g. INBOX/1234 Testkunde/Angebot/123. This is passed through
C<get_folder_string_from_path>.

=item C<_create_imap_client>

Creates a new IMAP client and logs in. The IMAP client is stored in
$self->{imap_client}.

=back

=head1 BUGS

0eebc84f Tamino Steinert
The mapping from record to email folder is not bijective. If the record or
customer number has special characters, the mapping can fail. Read
C<get_ilike_folder_path_from_string> for more information.
a992797b Tamino Steinert
=head1 AUTHOR

Tamino Steinert E<lt>tamino.steinert@tamino.stE<gt>

=cut