Projekt

Allgemein

Profil

Herunterladen (16,7 KB) Statistiken
| Zweig: | Markierung: | Revision:

kivitendo/SL/IMAPClient.pm @ 81e922c2

a992797b Tamino Steinert
package SL::IMAPClient;

use strict;
use warnings;
use utf8;

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;

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;
a992797b Tamino Steinert
ab7a995e Tamino Steinert
use SL::DB::Order;

my %RECORD_TYPE_TO_FOLDER = (
a992797b Tamino Steinert
sales_quotation => t8('Sales Quotations'),
sales_order => t8('Sales Orders'),
);
ab7a995e Tamino Steinert
my %RECORD_FOLDER_TO_TYPE = reverse %RECORD_TYPE_TO_FOLDER;
a992797b Tamino Steinert
sub new {
my ($class, %params) = @_;
my $config = $::lx_office_conf{imap_client} || {};
my $self = bless {
enabled => $config->{enabled},
hostname => $config->{hostname},
port => $config->{port},
ssl => $config->{ssl},
username => $config->{username},
password => $config->{password},
base_folder => $config->{base_folder} || 'INBOX',
%params,
}, $class;
return unless $self->{enabled};
$self->_create_imap_client();
return $self;
}

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

794df533 Tamino Steinert
sub update_emails_from_folder {
my ($self, $folder_path) = @_;
ab7a995e Tamino Steinert
$folder_path ||= $self->{base_folder};
794df533 Tamino Steinert
my $folder_string = $self->get_folder_string_from_path($folder_path);
ab7a995e Tamino Steinert
my $email_import =
_update_emails_from_folder_strings($self, $folder_path, [$folder_string]);
794df533 Tamino Steinert
ab7a995e Tamino Steinert
return $email_import;
}
794df533 Tamino Steinert
ab7a995e Tamino Steinert
sub update_emails_from_subfolders {
my ($self, $base_folder_path) = @_;
$base_folder_path ||= $self->{base_folder};
my $base_folder_string = $self->get_folder_string_from_path($base_folder_path);
794df533 Tamino Steinert
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 =
_update_emails_from_folder_strings($self, $base_folder_path, \@subfolder_strings);

return $email_import;
}
794df533 Tamino Steinert
ab7a995e Tamino Steinert
sub _update_emails_from_folder_strings {
my ($self, $base_folder_path, $folder_strings) = @_;
794df533 Tamino Steinert
ab7a995e Tamino Steinert
my $dbh = SL::DB->client->dbh;

my $email_import;
794df533 Tamino Steinert
SL::DB->client->with_transaction(sub {
ab7a995e Tamino Steinert
foreach my $folder_string (@$folder_strings) {
$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;

$email_import ||= $self->_create_email_import($base_folder_path)->save();

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(
5d8e7dc9 Tamino Steinert
$email, $email_import, $new_uid, $folder_string, $folder_uidvalidity
ab7a995e Tamino Steinert
);
$email_journal->save();
}
794df533 Tamino Steinert
}
});

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

sub _create_email_import {
my ($self, $folder_path) = @_;
my $email_import = SL::DB::EmailImport->new(
host_name => $self->{hostname},
user_name => $self->{username},
folder => $folder_path,
);
return $email_import;
}

sub _create_email_journal {
5d8e7dc9 Tamino Steinert
my ($self, $email, $email_import, $uid, $folder_string, $folder_uidvalidity) = @_;
794df533 Tamino Steinert
my @email_parts = $email->parts; # get parts or self
ab7a995e Tamino Steinert
my $text_part = $email_parts[0];
794df533 Tamino Steinert
my $body = $text_part->body;

my $header_string = join "\r\n",
(map { $_ . ': ' . $email->header($_) } $email->header_names);

my $date = $self->_parse_date($email->header('Date'));

my $recipients = $email->header('To');
$recipients .= ', ' . $email->header('Cc') if ($email->header('Cc'));
$recipients .= ', ' . $email->header('Bcc') if ($email->header('Bcc'));

my @attachments = ();
$email->walk_parts(sub {
my ($part) = @_;
my $filename = $part->filename;
if ($filename) {
my $content_type = $part->content_type;
my $content = $part->body;
my $attachment = SL::DB::EmailJournalAttachment->new(
name => $filename,
content => $content,
mime_type => $content_type,
);
push @attachments, $attachment;
}
});

my $email_journal = SL::DB::EmailJournal->new(
5d8e7dc9 Tamino Steinert
email_import_id => $email_import->id,
folder => $folder_string,
folder_uidvalidity => $folder_uidvalidity,
uid => $uid,
status => 'imported',
extended_status => '',
from => $email->header('From') || '',
recipients => $recipients,
sent_on => $date,
subject => $email->header('Subject') || '',
body => $body,
headers => $header_string,
attachments => \@attachments,
794df533 Tamino Steinert
);

return $email_journal;
}

sub _parse_date {
my ($self, $date) = @_;
return '' unless $date;
my $strp = DateTime::Format::Strptime->new(
pattern => '%a, %d %b %Y %H:%M:%S %z',
time_zone => 'UTC',
);
my $dt = $strp->parse_datetime($date);
return $dt->strftime('%Y-%m-%d %H:%M:%S');
}

ab7a995e Tamino Steinert
sub update_email_files_for_record {
a992797b Tamino Steinert
my ($self, $record) = @_;

my $folder_string = $self->_get_folder_string_for_record($record);
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};
my $base_folder_string = $self->get_folder_string_from_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) {
my $ilike_folder_path = $self->get_ilike_folder_path_from_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]+) (.+)/(.+)/(.+)|;

my $record_type = $RECORD_FOLDER_TO_TYPE{$record_folder};
next unless $record_type;

0eebc84f Tamino Steinert
# TODO make it generic for all records
ab7a995e Tamino Steinert
my $is_quotation = $record_type eq 'sales_quotation' ? 1 : 0;
my $number_field = $is_quotation ? 'quonumber' : 'ordnumber';
0eebc84f Tamino Steinert
my $record = SL::DB::Manager::Order->get_first(
ab7a995e Tamino Steinert
query => [
and => [
vendor_id => undef,
quotation => $is_quotation,
$number_field => { ilike => $ilike_record_number },
],
]);
0eebc84f Tamino Steinert
next unless $record;
$self->update_email_files_for_record($record);
ab7a995e Tamino Steinert
}
0eebc84f Tamino Steinert
399b215e Tamino Steinert
return \@subfolder_strings;
a992797b Tamino Steinert
}

sub create_folder {
my ($self, $folder_name) = @_;
return if $self->{imap_client}->exists($folder_name);
$self->{imap_client}->create($folder_name)
or die "Could not create IMAP folder '$folder_name': $@\n";
return;
}

sub get_folder_string_from_path {
my ($self, $folder_path) = @_;
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 {
my ($self, $folder_string) = @_;
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 {
my ($self, $record) = @_;
my $folder_string = $self->_get_folder_string_for_record($record);
$self->create_folder($folder_string);
return;
}

0eebc84f Tamino Steinert
sub clean_up_subfolders {
ab7a995e Tamino Steinert
my ($self, $active_records) = @_;

399b215e Tamino Steinert
my $subfolder_strings =
0eebc84f Tamino Steinert
$self->update_email_subfolders_and_files_for_records();
ab7a995e Tamino Steinert
399b215e Tamino Steinert
my @active_folder_strings = map { $self->_get_folder_string_for_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 {
my ($self, $record) = @_;

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} . '/' .
$RECORD_TYPE_TO_FOLDER{$record->type} . '/' .
$string_parts{record_number};
a992797b Tamino Steinert
my $folder_string = $self->get_folder_string_from_path($record_folder_path);
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
my $imap_client = SL::IMAPClient->new();

# can also be used with a custom config, overriding the global config
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
ab7a995e Tamino Steinert
$imap_client->update_email_files_for_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

ab7a995e Tamino Steinert
=item C<%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.

ab7a995e Tamino Steinert
=item C<%RECORD_FOLDER_TO_TYPE>

The reverse mapping of %RECORD_TYPE_TO_FOLDER.

a992797b Tamino Steinert
=back

=head1 FUNCTIONS

=over 4

=item C<new>

Creates a new SL::IMAPClient object. If no config is passed, the config
from config/kivitendo.conf is used. If a config is passed, the global
config is overridden.

=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>
0eebc84f Tamino Steinert
don't cancel each other out. This is because the IMAP server can has a
different Ieparator than the unix filesystem. The changes are made so that a
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.

0eebc84f Tamino Steinert
=item C<clean_up_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