Agenten Erstellung automatische Email

Hilfe zu Znuny Problemen aller Art
Locked
MarcoB106
Znuny newbie
Posts: 32
Joined: 14 Jan 2015, 12:20
Znuny Version: 3.3.10
Real Name: Marco
Company: DB

Agenten Erstellung automatische Email

Post by MarcoB106 »

Hallo zusammen,

zurzeit habe ich das Ziel bei der Erstellung eines Agenten ihm eine automatische Email zuzusenden, mit seinem Login und einem PW.

Meine Idee war es die Datei "User.pm" im Verzeichnis /opt/otrs/Kernel/System zu erweitern, ab Zeile 382 der Code Block Bereich "sub UserAdd".
Undzwar wollte ich ganz unten nach "return User ID" Code selber definieren, der dafür sorgt, dass dem erstellten Agenten eine automatische Mail zukommt.

# set password
$Self->SetPassword( UserLogin => $Param{UserLogin}, PW => $Param{UserPw} );

# set email address
$Self->SetPreferences( UserID => $UserID, Key => 'UserEmail', Value => $Param{UserEmail} );

# delete cache
$Self->{CacheInternalObject}->CleanUp();
$Self->{CacheInternalObject}->CleanUp( OtherType => 'Group' );



return $UserID;


#send email



Unter #sendmail soll der Code folgen.

Erreichen wollte ich dies mithilfe der Datei "Email.pm" welche auch im Verzeichnis /opt/otrs/Kernel/System liegt.
Mithilfe dieses Code Blockes aus "Email.pm"

my $Sent = $SendObject->Send(
From => 'me@example.com',
To => 'friend@example.com',
Cc => 'Some Customer B <customer-b@example.com>', # not required
ReplyTo => 'Some Customer B <customer-b@example.com>', # not required, is possible to use 'Reply-To' instead
Subject => 'Some words!',
Charset => 'iso-8859-15',
MimeType => 'text/plain', # "text/plain" or "text/html"
Body => 'Some nice text',
InReplyTo => '<somemessageid-2@example.com>',
References => '<somemessageid-1@example.com> <somemessageid-2@example.com>',
Loop => 1, # not required, removes smtp from).



Angepasst an das System sollte der Code ungefährt so aussehen:

#send email
my $Sent = $Self->{SendmailObject}->Send(
From => $Param{From},
To => $Param{UserEmail},
Subject => 'OTRS account',
Charset => $Self->{LayoutObject}->{UserCharset},
MimeType => $ContentType,
Body => 'Name und PW',

);



Jedoch gibt es beim Verändern der Dateien immer Fehler.

Wollte fragen ob jemand weiß womit das zusammenhängt und ob es überhaupt der richtige Weg ist, dass Ziel so zu erreichen.

Otrs läuft auf Debian 7.4.

PS: Weiß den Variablen Namen, in der die Admin Email hinterlegt ist?


MfG

Marco
Last edited by MarcoB106 on 19 Feb 2015, 12:27, edited 2 times in total.
Greetings

Marco

Im running OTRS::ITSM 3.3.10 on Debian 7.4.
reneeb
Znuny guru
Posts: 5018
Joined: 13 Mar 2011, 09:54
Znuny Version: 6.0.x
Real Name: Renée Bäcker
Company: Perl-Services.de
Contact:

Re: Agenten Erstellung automatische Email

Post by reneeb »

Welche Fehler gibt es denn?
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
MarcoB106
Znuny newbie
Posts: 32
Joined: 14 Jan 2015, 12:20
Znuny Version: 3.3.10
Real Name: Marco
Company: DB

Re: Agenten Erstellung automatische Email

Post by MarcoB106 »

Beim Zugreifen auf die Website erscheint der "Internal Server Error".

Und im Apache Error log steht:

Traceback (6785):
Module: Kernel::System::Web::InterfaceAgent::Run (OTRS 3.3.10) Line: 193
Module: /opt/otrs/bin/cgi-bin/index.pl (unknown version) Line: 49

[Tue Feb 17 11:05:11 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 11:05:12 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Can't call method "Send" on an undefined value at /opt/otrs/bin/cgi-bin/../../Kernel/Modules/AdminUser.pm line 315.
[Tue Feb 17 11:05:17 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Can't call method "Send" on an undefined value at /opt/otrs/bin/cgi-bin/../../Kernel/Modules/AdminUser.pm line 315.
[Tue Feb 17 11:05:21 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
[Tue Feb 17 11:06:27 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 11:06:28 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
[Tue Feb 17 11:31:44 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 11:31:45 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Global symbol "$ContentType" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 482.
syntax error at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 487, near ")


return"
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 11:32:00 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Global symbol "$ContentType" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 482.
syntax error at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 487, near ")


return"
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 11:32:01 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl




Das Ende der Funktion sub UserAdd() sieht ergänzt wie folgt aus :

# check if user exists
if ( !$UserID ) {
$Self->{LogObject}->Log(
Priority => 'notice',
Message => "Unable to create User: '$Param{UserLogin}' ($Param{ChangeUserID})!",
);
return;
}

# log notice
$Self->{LogObject}->Log(
Priority => 'notice',
Message =>
"User: '$Param{UserLogin}' ID: '$UserID' created successfully ($Param{ChangeUserID})!",
);

# set password
$Self->SetPassword( UserLogin => $Param{UserLogin}, PW => $Param{UserPw} );

# set email address
$Self->SetPreferences( UserID => $UserID, Key => 'UserEmail', Value => $Param{UserEmail} );

# delete cache
$Self->{CacheInternalObject}->CleanUp();
$Self->{CacheInternalObject}->CleanUp( OtherType => 'Group' );

#send email
my $Sent = $Self->{SendmailObject}->Send(
From => $Param{From},
To => $Param{UserEmail},
Subject => 'OTRS account',
Charset => $Self->{LayoutObject}->{UserCharset},
MimeType => $ContentType,
Body => 'Name und PW',
)


return $UserID;


}
Greetings

Marco

Im running OTRS::ITSM 3.3.10 on Debian 7.4.
reneeb
Znuny guru
Posts: 5018
Joined: 13 Mar 2011, 09:54
Znuny Version: 6.0.x
Real Name: Renée Bäcker
Company: Perl-Services.de
Contact:

Re: Agenten Erstellung automatische Email

Post by reneeb »

Du musst die Variable $ContentType deklarieren und belegen. In etwa so:

Code: Select all

my $ContentType = 'text/plain';
P.S.: Kannst Du für Code bitte die

Code: Select all

-Tags verwenden. Das macht das Ganze besser lesbar...
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
MarcoB106
Znuny newbie
Posts: 32
Joined: 14 Jan 2015, 12:20
Znuny Version: 3.3.10
Real Name: Marco
Company: DB

Re: Agenten Erstellung automatische Email

Post by MarcoB106 »

Erstmal vielen Dank für die Hilfe!

Die Fehlermeldung tritt nun nichtmehr auf :) , jedoch wird beim erstellen eines Agenten durch den Admin Bereich keine automatische Mail an ihn gesendet.

Der Code sieht angepasst wie folgt aus :

Code: Select all

    # set email address

$Self->SetPreferences( UserID => $UserID, Key => 'UserEmail', Value => $Param{UserEmail} );

# delete cache
$Self->{CacheInternalObject}->CleanUp();
$Self->{CacheInternalObject}->CleanUp( OtherType => 'Group' );
	

#send email
my $ContentType = 'text/plain';
	
my $Sent = $Self->{SendmailObject}->Send(
From => $Param{From},
To => $Param{UserEmail},
Subject => 'OTRS account',
Charset => $Self->{LayoutObject}->{UserCharset},
MimeType => $ContentType,
Body => 'Name und PW',
)

Sind das vielleicht nicht die passenden Variablen + Attribute für "From" und "To" ?


MfG

Marco
Greetings

Marco

Im running OTRS::ITSM 3.3.10 on Debian 7.4.
reneeb
Znuny guru
Posts: 5018
Joined: 13 Mar 2011, 09:54
Znuny Version: 6.0.x
Real Name: Renée Bäcker
Company: Perl-Services.de
Contact:

Re: Agenten Erstellung automatische Email

Post by reneeb »

Statt $Param{From} solltest Du $Self->{ConfigObject}->Get('AdminEmail') oder noch besser $Self->{ConfigObject}->Get('NotificationSenderEmail') nehmen. Und nach dem schließenden ")" fehlt noch ein";"
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
MarcoB106
Znuny newbie
Posts: 32
Joined: 14 Jan 2015, 12:20
Znuny Version: 3.3.10
Real Name: Marco
Company: DB

Re: Agenten Erstellung automatische Email

Post by MarcoB106 »

Wieder vielen Dank für die schnelle Antwort.

Beim ändern des Quellcodes tritt keine Fehlermeldung auf, jedoch wird beim erstellen trotzdem keine Mail gesendet.

Der Quellcode:

Code: Select all

    # delete cache
    $Self->{CacheInternalObject}->CleanUp();
    $Self->{CacheInternalObject}->CleanUp( OtherType => 'Group' );
	
	
	return $UserID;
		

#send email
my $ContentType = 'text/plain';
	
my $Sent = $Self->{SendmailObject}->Send(
From => $Self->{ConfigObject}->Get('NotificationSenderEmail'),
To => $Param{UserEmail},
Subject => 'OTRS account',
Charset => $Self->{LayoutObject}->{UserCharset},
MimeType => $ContentType,
Body => 'Name und PW',
);

Ist die Variable $Param{UserEmail} passend, für einen erstellen Admin account?
Greetings

Marco

Im running OTRS::ITSM 3.3.10 on Debian 7.4.
reneeb
Znuny guru
Posts: 5018
Joined: 13 Mar 2011, 09:54
Znuny Version: 6.0.x
Real Name: Renée Bäcker
Company: Perl-Services.de
Contact:

Re: Agenten Erstellung automatische Email

Post by reneeb »

Das "return $UserID" muss natürlich *nach* dem Email-Versand kommen...
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
MarcoB106
Znuny newbie
Posts: 32
Joined: 14 Jan 2015, 12:20
Znuny Version: 3.3.10
Real Name: Marco
Company: DB

Re: Agenten Erstellung automatische Email

Post by MarcoB106 »

Danke für die Antwort! :)

Code: Select all

#send email
my $ContentType = 'text/plain';
	
my $Sent = $Self->{SendmailObject}->Send(
From => $Self->{ConfigObject}->Get('NotificationSenderEmail'),
To => $Param{UserEmail},
Subject => 'OTRS account',
Charset => $Self->{LayoutObject}->{UserCharset},
MimeType => $ContentType,
Body => 'Name und PW',
);

return $UserID;

 
		
	
	
	
}
Die automatische Mail wird beim erstellen trotzdem noch nicht generiert.
Greetings

Marco

Im running OTRS::ITSM 3.3.10 on Debian 7.4.
reneeb
Znuny guru
Posts: 5018
Joined: 13 Mar 2011, 09:54
Znuny Version: 6.0.x
Real Name: Renée Bäcker
Company: Perl-Services.de
Contact:

Re: Agenten Erstellung automatische Email

Post by reneeb »

Irgendwelche Fehler? Schau mal ins Webserver log und ins OTRS log...
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
MarcoB106
Znuny newbie
Posts: 32
Joined: 14 Jan 2015, 12:20
Znuny Version: 3.3.10
Real Name: Marco
Company: DB

Re: Agenten Erstellung automatische Email

Post by MarcoB106 »

Beim Klicken auf Übermitteln, wenn man damit abschließen möchte den User zu erstellen tritt der "Internal Server Error" 500 auf.
Trotz des Fehlers wird der User angelegt, die Email jedoch nicht versand.

Das ist der Fehler des Apache - Error logs.

my "
Global symbol "$Sent" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 492.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 493.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 494.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 495.
Global symbol "$Self" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 496.
Global symbol "$ContentType" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 497.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 498.
Can't use global @_ in "my" at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 524, near "= @_"
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 528.
Global symbol "$Self" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 529.
syntax error at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 592, near "}"
/opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm has too many errors.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 13:47:55 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
syntax error at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 492, near ")

my "
Global symbol "$Sent" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 492.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 493.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 494.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 495.
Global symbol "$Self" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 496.
Global symbol "$ContentType" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 497.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 498.
Can't use global @_ in "my" at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 524, near "= @_"
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 528.
Global symbol "$Self" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 529.
syntax error at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 592, near "}"
/opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm has too many errors.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 13:47:57 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
[Tue Feb 17 14:03:15 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:03:15 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:21 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:22 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:23 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:25 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
[Tue Feb 17 14:05:38 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:05:39 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
[Tue Feb 17 14:15:29 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:15:30 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Can't call method "Send" on an undefined value at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 482.
[Tue Feb 17 14:35:13 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl, referer: http://172.26.41.93/otrs/index.pl?Actio ... action=Add
[Tue Feb 17 14:40:41 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:46:29 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Can't call method "Send" on an undefined value at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 482.
[Tue Feb 17 14:55:13 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl, referer: http://172.26.41.93/otrs/index.pl?Actio ... action=Add
Greetings

Marco

Im running OTRS::ITSM 3.3.10 on Debian 7.4.
reneeb
Znuny guru
Posts: 5018
Joined: 13 Mar 2011, 09:54
Znuny Version: 6.0.x
Real Name: Renée Bäcker
Company: Perl-Services.de
Contact:

Re: Agenten Erstellung automatische Email

Post by reneeb »

Poste bitte mal den gesamten Code...
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
MarcoB106
Znuny newbie
Posts: 32
Joined: 14 Jan 2015, 12:20
Znuny Version: 3.3.10
Real Name: Marco
Company: DB

Re: Agenten Erstellung automatische Email

Post by MarcoB106 »

Code: Select all

# --
# Kernel/System/User.pm - some user functions
# Copyright (C) 2001-2014 xxx, http://otrs.com/
# --
# This software comes with ABSOLUTELY NO WARRANTY. For details, see
# the enclosed file COPYING for license information (AGPL). If you
# did not receive this file, see http://www.gnu.org/licenses/agpl.txt.
# --

package Kernel::System::User;

use strict;
use warnings;

use Crypt::PasswdMD5 qw(unix_md5_crypt);
use Digest::SHA;

use Kernel::System::CacheInternal;
use Kernel::System::CheckItem;
use Kernel::System::Email;

=head1 NAME

Kernel::System::User - user lib

=head1 SYNOPSIS

All user functions. E. g. to add and updated user and other functions.

=head1 PUBLIC INTERFACE

=over 4

=cut

=item new()

create an object

    use Kernel::Config;
    use Kernel::System::Encode;
    use Kernel::System::Log;
    use Kernel::System::Main;
    use Kernel::System::Time;
    use Kernel::System::DB;
    use Kernel::System::User;

    my $ConfigObject = Kernel::Config->new();
    my $EncodeObject = Kernel::System::Encode->new(
        ConfigObject => $ConfigObject,
    );
    my $LogObject = Kernel::System::Log->new(
        ConfigObject => $ConfigObject,
        EncodeObject => $EncodeObject,
    );
    my $MainObject = Kernel::System::Main->new(
        ConfigObject => $ConfigObject,
        EncodeObject => $EncodeObject,
        LogObject    => $LogObject,
    );
    my $TimeObject = Kernel::System::Time->new(
        ConfigObject => $ConfigObject,
        LogObject    => $LogObject,
    );
    my $DBObject = Kernel::System::DB->new(
        ConfigObject => $ConfigObject,
        EncodeObject => $EncodeObject,
        LogObject    => $LogObject,
        MainObject   => $MainObject,
    );
    my $UserObject = Kernel::System::User->new(
        ConfigObject => $ConfigObject,
        LogObject    => $LogObject,
        MainObject   => $MainObject,
        TimeObject   => $TimeObject,
        DBObject     => $DBObject,
        EncodeObject => $EncodeObject,
    );

=cut

sub new {
    my ( $Type, %Param ) = @_;

    # allocate new hash for object
    my $Self = {};
    bless( $Self, $Type );

    # check needed objects
    for (qw(DBObject ConfigObject LogObject TimeObject MainObject EncodeObject)) {
        $Self->{$_} = $Param{$_} || die "Got no $_!";
    }

    # get user table
    $Self->{UserTable}       = $Self->{ConfigObject}->Get('DatabaseUserTable')       || 'user';
    $Self->{UserTableUserID} = $Self->{ConfigObject}->Get('DatabaseUserTableUserID') || 'id';
    $Self->{UserTableUserPW} = $Self->{ConfigObject}->Get('DatabaseUserTableUserPW') || 'pw';
    $Self->{UserTableUser}   = $Self->{ConfigObject}->Get('DatabaseUserTableUser')   || 'login';

    # create needed object
    $Self->{ValidObject}     = Kernel::System::Valid->new( %{$Self} );
    $Self->{CheckItemObject} = Kernel::System::CheckItem->new( %{$Self} );

    $Self->{CacheInternalObject} = Kernel::System::CacheInternal->new(
        %{$Self},
        Type => 'User',
        TTL  => 60 * 60 * 3,
    );

    # set lower if database is case sensitive
    $Self->{Lower} = '';
    if ( $Self->{DBObject}->GetDatabaseFunction('CaseSensitive') ) {
        $Self->{Lower} = 'LOWER';
    }

    # load generator preferences module
    my $GeneratorModule = $Self->{ConfigObject}->Get('User::PreferencesModule')
        || 'Kernel::System::User::Preferences::DB';
    if ( $Self->{MainObject}->Require($GeneratorModule) ) {
        $Self->{PreferencesObject} = $GeneratorModule->new( %{$Self} );
    }

    return $Self;
}

=item GetUserData()

get user data (UserLogin, UserFirstname, UserLastname, UserEmail, ...)

    my %User = $UserObject->GetUserData(
        UserID => 123,
    );

    or

    my %User = $UserObject->GetUserData(
        User          => 'franz',
        Valid         => 1,       # not required -> 0|1 (default 0)
                                  # returns only data if user is valid
        NoOutOfOffice => 1,       # not required -> 0|1 (default 0)
                                  # returns data without out of office infos
    );

=cut

sub GetUserData {
    my ( $Self, %Param ) = @_;

    # check needed stuff
    if ( !$Param{User} && !$Param{UserID} ) {
        $Self->{LogObject}->Log( Priority => 'error', Message => 'Need User or UserID!' );
        return;
    }

    # get configuration for the full name order
    my $FirstnameLastNameOrder = $Self->{ConfigObject}->Get('FirstnameLastnameOrder') || 0;

    # check if result is cached
    if ( $Param{Valid} ) {
        $Param{Valid} = 1;
    }
    else {
        $Param{Valid} = 0;
    }
    if ( $Param{NoOutOfOffice} ) {
        $Param{NoOutOfOffice} = 1;
    }
    else {
        $Param{NoOutOfOffice} = 0;
    }

    my $CacheKey;
    if ( $Param{User} ) {
        $CacheKey
            = 'GetUserData::User::'
            . $Param{User} . '::'
            . $Param{Valid} . '::'
            . $FirstnameLastNameOrder . '::'
            . $Param{NoOutOfOffice};
    }
    else {
        $CacheKey
            = 'GetUserData::UserID::'
            . $Param{UserID} . '::'
            . $Param{Valid} . '::'
            . $FirstnameLastNameOrder . '::'
            . $Param{NoOutOfOffice};
    }

    # check cache
    my $Cache = $Self->{CacheInternalObject}->Get( Key => $CacheKey );
    return %{$Cache} if $Cache;

    # get initial data
    my @Bind;
    my $SQL = "SELECT $Self->{UserTableUserID}, $Self->{UserTableUser}, "
        . " title, first_name, last_name, $Self->{UserTableUserPW}, valid_id, "
        . " create_time, change_time FROM $Self->{UserTable} WHERE ";

    if ( $Param{User} ) {
        my $User = lc $Param{User};
        $SQL .= " $Self->{Lower}($Self->{UserTableUser}) = ?";
        push @Bind, \$User;
    }
    else {
        $SQL .= " $Self->{UserTableUserID} = ?";
        push @Bind, \$Param{UserID};
    }

    return if !$Self->{DBObject}->Prepare(
        SQL   => $SQL,
        Bind  => \@Bind,
        Limit => 1,
    );

    my %Data;
    while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
        $Data{UserID}        = $Row[0];
        $Data{UserLogin}     = $Row[1];
        $Data{UserTitle}     = $Row[2];
        $Data{UserFirstname} = $Row[3];
        $Data{UserLastname}  = $Row[4];
        $Data{UserPw}        = $Row[5];
        $Data{ValidID}       = $Row[6];
        $Data{CreateTime}    = $Row[7];
        $Data{ChangeTime}    = $Row[8];
    }

    # check data
    if ( !$Data{UserID} ) {
        if ( $Param{User} ) {
            $Self->{LogObject}->Log(
                Priority => 'notice',
                Message  => "Panic! No UserData for user: '$Param{User}'!!!",
            );
            return;
        }
        else {
            $Self->{LogObject}->Log(
                Priority => 'notice',
                Message  => "Panic! No UserData for user id: '$Param{UserID}'!!!",
            );
            return;
        }
    }

    # check valid, return if there is locked for valid users
    if ( $Param{Valid} ) {

        my $Hit = 0;

        for ( $Self->{ValidObject}->ValidIDsGet() ) {
            if ( $_ eq $Data{ValidID} ) {
                $Hit = 1;
            }
        }

        if ( !$Hit ) {

            # set cache
            $Self->{CacheInternalObject}->Set( Key => $CacheKey, Value => {} );
            return;
        }
    }

    # generate the full name and save it in the hash
    my $UserFullname;
    if ( $FirstnameLastNameOrder eq '0' ) {
        $UserFullname = $Data{UserFirstname} . ' '
            . $Data{UserLastname};
    }
    elsif ( $FirstnameLastNameOrder eq '1' ) {
        $UserFullname = $Data{UserLastname} . ', '
            . $Data{UserFirstname};
    }
    elsif ( $FirstnameLastNameOrder eq '2' ) {
        $UserFullname = $Data{UserFirstname} . ' '
            . $Data{UserLastname} . ' ('
            . $Data{UserLogin} . ')';
    }
    elsif ( $FirstnameLastNameOrder eq '3' ) {
        $UserFullname = $Data{UserLastname} . ', '
            . $Data{UserFirstname} . ' ('
            . $Data{UserLogin} . ')';
    }
    elsif ( $FirstnameLastNameOrder eq '4' ) {
        $UserFullname = '(' . $Data{UserLogin}
            . ') ' . $Data{UserFirstname}
            . ' ' . $Data{UserLastname};
    }
    elsif ( $FirstnameLastNameOrder eq '5' ) {
        $UserFullname = '(' . $Data{UserLogin}
            . ') ' . $Data{UserLastname}
            . ', ' . $Data{UserFirstname};
    }

    # save the generated fullname in the hash.
    $Data{UserFullname} = $UserFullname;

    # get preferences
    my %Preferences = $Self->GetPreferences( UserID => $Data{UserID} );

    # add last login timestamp
    if ( $Preferences{UserLastLogin} ) {
        $Preferences{UserLastLoginTimestamp} = $Self->{TimeObject}->SystemTime2TimeStamp(
            SystemTime => $Preferences{UserLastLogin},
        );
    }

    # check compat stuff
    if ( !$Preferences{UserEmail} ) {
        $Preferences{UserEmail} = $Data{UserLogin};
    }

    # out of office check
    if ( !$Param{NoOutOfOffice} ) {
        if ( $Preferences{OutOfOffice} ) {
            my $Time = $Self->{TimeObject}->SystemTime();
            my $Start
                = "$Preferences{OutOfOfficeStartYear}-$Preferences{OutOfOfficeStartMonth}-$Preferences{OutOfOfficeStartDay} 00:00:00";
            my $TimeStart = $Self->{TimeObject}->TimeStamp2SystemTime(
                String => $Start,
            );
            my $End
                = "$Preferences{OutOfOfficeEndYear}-$Preferences{OutOfOfficeEndMonth}-$Preferences{OutOfOfficeEndDay} 23:59:59";
            my $TimeEnd = $Self->{TimeObject}->TimeStamp2SystemTime(
                String => $End,
            );
            my $Till = int( ( $TimeEnd - $Time ) / 60 / 60 / 24 );
            my $TillDate
                = "$Preferences{OutOfOfficeEndYear}-$Preferences{OutOfOfficeEndMonth}-$Preferences{OutOfOfficeEndDay}";
            if ( $TimeStart < $Time && $TimeEnd > $Time ) {
                $Preferences{OutOfOfficeMessage} = "*** out of office till $TillDate/$Till d ***";
                $Data{UserLastname} .= ' ' . $Preferences{OutOfOfficeMessage};
            }
        }
    }

    # merge hash
    %Data = ( %Data, %Preferences );

    # add preferences defaults
    my $Config = $Self->{ConfigObject}->Get('PreferencesGroups');
    if ( $Config && ref $Config eq 'HASH' ) {

        for my $Key ( sort keys %{$Config} ) {

            # next if no default data exists
            next if !defined $Config->{$Key}->{DataSelected};

            # check if data is defined
            next if defined $Data{ $Config->{$Key}->{PrefKey} };

            # set default data
            $Data{ $Config->{$Key}->{PrefKey} } = $Config->{$Key}->{DataSelected};
        }
    }

    # set cache
    $Self->{CacheInternalObject}->Set( Key => $CacheKey, Value => \%Data );

    return %Data;
}

=item UserAdd()

to add new users

    my $UserID = $UserObject->UserAdd(
        UserFirstname => 'Huber',
        UserLastname  => 'Manfred',
        UserLogin     => 'mhuber',
        UserPw        => 'some-pass', # not required
        UserEmail     => 'email@example.com',
        ValidID       => 1,
        ChangeUserID  => 123,
    );

=cut

sub UserAdd {
    my ( $Self, %Param ) = @_;

    # check needed stuff
    for (qw(UserFirstname UserLastname UserLogin UserEmail ValidID ChangeUserID)) {
        if ( !$Param{$_} ) {
            $Self->{LogObject}->Log( Priority => 'error', Message => "Need $_!" );
            return;
        }
    }

    # check if a user with this login (username) already exits
    if ( $Self->UserLoginExistsCheck( UserLogin => $Param{UserLogin} ) ) {
        $Self->{LogObject}->Log(
            Priority => 'error',
            Message  => "A user with username '$Param{UserLogin}' already exists!"
        );
        return;
    }

    # check email address
    if (
        $Param{UserEmail}
        && !$Self->{CheckItemObject}->CheckEmail( Address => $Param{UserEmail} )
        )
    {
        $Self->{LogObject}->Log(
            Priority => 'error',
            Message  => "Email address ($Param{UserEmail}) not valid ("
                . $Self->{CheckItemObject}->CheckError() . ")!",
        );
        return;
    }

    # check password
    if ( !$Param{UserPw} ) {
        $Param{UserPw} = $Self->GenerateRandomPassword();
    }

    # sql
    return if !$Self->{DBObject}->Do(
        SQL => "INSERT INTO $Self->{UserTable} "
            . "(title, first_name, last_name, "
            . " $Self->{UserTableUser}, $Self->{UserTableUserPW}, "
            . " valid_id, create_time, create_by, change_time, change_by)"
            . " VALUES "
            . " (?, ?, ?, ?, ?, ?, current_timestamp, ?, current_timestamp, ?)",
        Bind => [
            \$Param{UserTitle}, \$Param{UserFirstname}, \$Param{UserLastname},
            \$Param{UserLogin}, \$Param{UserPw},        \$Param{ValidID},
            \$Param{ChangeUserID}, \$Param{ChangeUserID},
        ],
    );

    # get new user id
    my $UserLogin = lc $Param{UserLogin};
    return if !$Self->{DBObject}->Prepare(
        SQL => "SELECT $Self->{UserTableUserID} FROM $Self->{UserTable} "
            . " WHERE $Self->{Lower}($Self->{UserTableUser}) = ?",
        Bind  => [ \$UserLogin ],
        Limit => 1,
    );

    # fetch the result
    my $UserID;
    while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
        $UserID = $Row[0];
    }

    # check if user exists
    if ( !$UserID ) {
        $Self->{LogObject}->Log(
            Priority => 'notice',
            Message  => "Unable to create User: '$Param{UserLogin}' ($Param{ChangeUserID})!",
        );
        return;
    }

    # log notice
    $Self->{LogObject}->Log(
        Priority => 'notice',
        Message =>
            "User: '$Param{UserLogin}' ID: '$UserID' created successfully ($Param{ChangeUserID})!",
    );

    # set password
    $Self->SetPassword( UserLogin => $Param{UserLogin}, PW => $Param{UserPw} );

    # set email address
    $Self->SetPreferences( UserID => $UserID, Key => 'UserEmail', Value => $Param{UserEmail} );

    # delete cache
    $Self->{CacheInternalObject}->CleanUp();
    $Self->{CacheInternalObject}->CleanUp( OtherType => 'Group' );
	
	


#send email
my $ContentType = 'text/plain';
	
my $Sent = $Self->{SendmailObject}->Send(
From => $Self->{ConfigObject}->Get('NotificationSenderEmail'),
To => $Param{UserEmail},
Subject => 'OTRS account',
Charset => $Self->{LayoutObject}->{UserCharset},
MimeType => $ContentType,
Body => 'Name und PW',
);

return $UserID;

 
		
	
	
	
}

=item UserUpdate()

to update users

    $UserObject->UserUpdate(
        UserID        => 4321,
        UserFirstname => 'Huber',
        UserLastname  => 'Manfred',
        UserLogin     => 'mhuber',
        UserPw        => 'some-pass', # not required
        UserEmail     => 'email@example.com',
        ValidID       => 1,
        ChangeUserID  => 123,
    );

=cut

sub UserUpdate {
    my ( $Self, %Param ) = @_;

    # check needed stuff
    for (qw(UserID UserFirstname UserLastname UserLogin ValidID ChangeUserID)) {
        if ( !$Param{$_} ) {
            $Self->{LogObject}->Log( Priority => 'error', Message => "Need $_!" );
            return;
        }
    }

    # check if a user with this login (username) already exits
    if ( $Self->UserLoginExistsCheck( UserLogin => $Param{UserLogin}, UserID => $Param{UserID} ) ) {
        $Self->{LogObject}->Log(
            Priority => 'error',
            Message  => "A user with username '$Param{UserLogin}' already exists!"
        );
        return;
    }

    # check email address
    if (
        $Param{UserEmail}
        && !$Self->{CheckItemObject}->CheckEmail( Address => $Param{UserEmail} )
        )
    {
        $Self->{LogObject}->Log(
            Priority => 'error',
            Message  => "Email address ($Param{UserEmail}) not valid ("
                . $Self->{CheckItemObject}->CheckError() . ")!",
        );
        return;
    }

    # update db
    return if !$Self->{DBObject}->Do(
        SQL => "UPDATE $Self->{UserTable} SET title = ?, first_name = ?, last_name = ?, "
            . " $Self->{UserTableUser} = ?, valid_id = ?, "
            . " change_time = current_timestamp, change_by = ? "
            . " WHERE $Self->{UserTableUserID} = ?",
        Bind => [
            \$Param{UserTitle}, \$Param{UserFirstname}, \$Param{UserLastname},
            \$Param{UserLogin}, \$Param{ValidID}, \$Param{ChangeUserID}, \$Param{UserID},
        ],
    );

    # log notice
    $Self->{LogObject}->Log(
        Priority => 'notice',
        Message  => "User: '$Param{UserLogin}' updated successfully ($Param{ChangeUserID})!",
    );

    # check pw
    if ( $Param{UserPw} ) {
        $Self->SetPassword( UserLogin => $Param{UserLogin}, PW => $Param{UserPw} );
    }

    # set email address
    $Self->SetPreferences(
        UserID => $Param{UserID},
        Key    => 'UserEmail',
        Value  => $Param{UserEmail}
    );

    # delete cache
    $Self->{CacheInternalObject}->CleanUp();
    $Self->{CacheInternalObject}->CleanUp( OtherType => 'Group' );

    return 1;
}

=item UserSearch()

to search users

    my %List = $UserObject->UserSearch(
        Search => '*some*', # also 'hans+huber' possible
        Valid  => 1, # not required
    );

    my %List = $UserObject->UserSearch(
        UserLogin => '*some*',
        Limit     => 50,
        Valid     => 1, # not required
    );

    my %List = $UserObject->UserSearch(
        PostMasterSearch => 'email@example.com',
        Valid            => 1, # not required
    );

=cut

sub UserSearch {
    my ( $Self, %Param ) = @_;

    my %Users;
    my $Valid = defined $Param{Valid} ? $Param{Valid} : 1;

    # check needed stuff
    if ( !$Param{Search} && !$Param{UserLogin} && !$Param{PostMasterSearch} ) {
        $Self->{LogObject}->Log(
            Priority => 'error',
            Message  => 'Need Search, UserLogin or PostMasterSearch!',
        );
        return;
    }

    # get like escape string needed for some databases (e.g. oracle)
    my $LikeEscapeString = $Self->{DBObject}->GetDatabaseFunction('LikeEscapeString');

    # build SQL string 1/2
    my $SQL    = "SELECT $Self->{UserTableUserID} ";
    my @Fields = qw(login first_name last_name);
    if (@Fields) {
        for my $Entry (@Fields) {
            $SQL .= ", $Entry";
        }
    }

    # build SQL string 2/2
    $SQL .= " FROM $Self->{UserTable} WHERE ";
    if ( $Param{Search} ) {
        $SQL .= $Self->{DBObject}->QueryCondition(
            Key   => \@Fields,
            Value => $Param{Search},
        ) . ' ';
    }
    elsif ( $Param{PostMasterSearch} ) {

        my %UserID = $Self->SearchPreferences(
            Key   => 'UserEmail',
            Value => $Param{PostMasterSearch},
        );

        for ( sort keys %UserID ) {
            my %User = $Self->GetUserData(
                UserID => $_,
                Valid  => $Param{Valid},
            );
            if (%User) {
                return %UserID;
            }
        }

        return;
    }
    elsif ( $Param{UserLogin} ) {
        $Param{UserLogin} =~ s/\*/%/g;
        $SQL .= " $Self->{Lower}($Self->{UserTableUser}) LIKE $Self->{Lower}('"
            . $Self->{DBObject}->Quote( $Param{UserLogin}, 'Like' ) . "') $LikeEscapeString";
    }

    # add valid option
    if ($Valid) {
        $SQL .= "AND valid_id IN (" . join( ', ', $Self->{ValidObject}->ValidIDsGet() ) . ")";
    }

    # get data
    return if !$Self->{DBObject}->Prepare(
        SQL => $SQL,
        Limit => $Self->{UserSearchListLimit} || $Param{Limit},
    );

    # fetch the result
    while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
        for ( 1 .. 8 ) {
            if ( $Row[$_] ) {
                $Users{ $Row[0] } .= $Row[$_] . ' ';
            }
        }
        $Users{ $Row[0] } =~ s/^(.*)\s(.+?\@.+?\..+?)(\s|)$/"$1" <$2>/;
    }

    return %Users;
}

=item SetPassword()

to set users passwords

    $UserObject->SetPassword(
        UserLogin => 'some-login',
        PW        => 'some-new-password'
    );

=cut

sub SetPassword {
    my ( $Self, %Param ) = @_;

    # check needed stuff
    if ( !$Param{UserLogin} ) {
        $Self->{LogObject}->Log( Priority => 'error', Message => 'Need UserLogin!' );
        return;
    }

    # get old user data
    my %User = $Self->GetUserData( User => $Param{UserLogin} );
    if ( !$User{UserLogin} ) {
        $Self->{LogObject}->Log( Priority => 'error', Message => 'No such User!' );
        return;
    }

    my $Pw = $Param{PW} || '';
    my $CryptedPw = '';

    # get crypt type
    my $CryptType = $Self->{ConfigObject}->Get('AuthModule::DB::CryptType') || 'sha2';

    # crypt plain (no crypt at all)
    if ( $CryptType eq 'plain' ) {
        $CryptedPw = $Pw;
    }

    # crypt with unix crypt
    elsif ( $CryptType eq 'crypt' ) {

        # encode output, needed by crypt() only non utf8 signs
        $Self->{EncodeObject}->EncodeOutput( \$Pw );
        $Self->{EncodeObject}->EncodeOutput( \$Param{UserLogin} );

        $CryptedPw = crypt( $Pw, $Param{UserLogin} );
    }

    # crypt with md5
    elsif ( $CryptType eq 'md5' || !$CryptType ) {

        # encode output, needed by unix_md5_crypt() only non utf8 signs
        $Self->{EncodeObject}->EncodeOutput( \$Pw );
        $Self->{EncodeObject}->EncodeOutput( \$Param{UserLogin} );

        $CryptedPw = unix_md5_crypt( $Pw, $Param{UserLogin} );
    }

    # crypt with sha1
    elsif ( $CryptType eq 'sha1' ) {

        my $SHAObject = Digest::SHA->new('sha1');

        # encode output, needed by sha1_hex() only non utf8 signs
        $Self->{EncodeObject}->EncodeOutput( \$Pw );

        $SHAObject->add($Pw);
        $CryptedPw = $SHAObject->hexdigest();
    }

    # bcrypt
    elsif ( $CryptType eq 'bcrypt' ) {

        if ( !$Self->{MainObject}->Require('Crypt::Eksblowfish::Bcrypt') ) {
            $Self->{LogObject}->Log(
                Priority => 'error',
                Message =>
                    "User: '$User{UserLogin}' tried to store password with bcrypt but 'Crypt::Eksblowfish::Bcrypt' is not installed!",
            );
            return;
        }

        my $Cost = 9;
        my $Salt = $Self->{MainObject}->GenerateRandomString( Length => 16 );

        # remove UTF8 flag, required by Crypt::Eksblowfish::Bcrypt
        $Self->{EncodeObject}->EncodeOutput( \$Pw );

        # calculate password hash
        my $Octets = Crypt::Eksblowfish::Bcrypt::bcrypt_hash(
            {
                key_nul => 1,
                cost    => 9,
                salt    => $Salt,
            },
            $Pw
        );

        # We will store cost and salt in the password string so that it can be decoded
        #   in future even if we use a higher cost by default.
        $CryptedPw = "BCRYPT:$Cost:$Salt:" . Crypt::Eksblowfish::Bcrypt::en_base64($Octets);
    }

    # crypt with sha256 as fallback
    else {

        my $SHAObject = Digest::SHA->new('sha256');

        # encode output, needed by sha256_hex() only non utf8 signs
        $Self->{EncodeObject}->EncodeOutput( \$Pw );

        $SHAObject->add($Pw);
        $CryptedPw = $SHAObject->hexdigest();
    }

    # update db
    my $UserLogin = lc $Param{UserLogin};
    return if !$Self->{DBObject}->Do(
        SQL => "UPDATE $Self->{UserTable} SET $Self->{UserTableUserPW} = ? "
            . " WHERE $Self->{Lower}($Self->{UserTableUser}) = ?",
        Bind => [ \$CryptedPw, \$UserLogin ],
    );

    # log notice
    $Self->{LogObject}->Log(
        Priority => 'notice',
        Message  => "User: '$Param{UserLogin}' changed password successfully!",
    );

    return 1;
}

=item UserLookup()

user login or id lookup

    my $UserLogin = $UserObject->UserLookup(
        UserID => 1,
    );

    my $UserID = $UserObject->UserLookup(
        UserLogin => 'some_user_login',
    );

=cut

sub UserLookup {
    my ( $Self, %Param ) = @_;

    # check needed stuff
    if ( !$Param{UserLogin} && !$Param{UserID} ) {
        $Self->{LogObject}->Log( Priority => 'error', Message => 'Need UserLogin or UserID!' );
        return;
    }

    if ( $Param{UserLogin} ) {

        # check cache
        my $CacheKey = 'UserLookup::ID::' . $Param{UserLogin};
        my $Cache = $Self->{CacheInternalObject}->Get( Key => $CacheKey );
        return $Cache if $Cache;

        # build sql query
        my $UserLogin = lc $Param{UserLogin};

        return if !$Self->{DBObject}->Prepare(
            SQL => "SELECT $Self->{UserTableUserID} FROM $Self->{UserTable} "
                . " WHERE $Self->{Lower}($Self->{UserTableUser}) = ?",
            Bind  => [ \$UserLogin ],
            Limit => 1,
        );

        # fetch the result
        my $ID;
        while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
            $ID = $Row[0];
        }

        if ( !$ID ) {
            $Self->{LogObject}->Log(
                Priority => 'error',
                Message  => "No UserID found for '$Param{UserLogin}'!",
            );
            return;
        }

        # set cache
        $Self->{CacheInternalObject}->Set( Key => $CacheKey, Value => $ID );

        return $ID;
    }

    else {

        # check cache
        my $CacheKey = 'UserLookup::Login::' . $Param{UserID};
        my $Cache = $Self->{CacheInternalObject}->Get( Key => $CacheKey );
        return $Cache if $Cache;

        # build sql query
        return if !$Self->{DBObject}->Prepare(
            SQL => "SELECT $Self->{UserTableUser} FROM $Self->{UserTable} "
                . " WHERE $Self->{UserTableUserID} = ?",
            Bind  => [ \$Param{UserID} ],
            Limit => 1,
        );

        # fetch the result
        my $Login;
        while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
            $Login = $Row[0];
        }

        if ( !$Login ) {
            $Self->{LogObject}->Log(
                Priority => 'error',
                Message  => "No UserLogin found for '$Param{UserID}'!",
            );
            return;
        }

        # set cache
        $Self->{CacheInternalObject}->Set( Key => $CacheKey, Value => $Login );

        return $Login;
    }
}

=item UserName()

get user name

    my $Name = $UserObject->UserName(
        UserLogin => 'some-login',
    );

    or

    my $Name = $UserObject->UserName(
        UserID => 123,
    );

=cut

sub UserName {
    my ( $Self, %Param ) = @_;

    my %User = $Self->GetUserData(%Param);

    return if !%User;
    return $User{UserFullname};
}

=item UserList()

return a hash with all users

    my %List = $UserObject->UserList(
        Type  => 'Short', # Short|Long, default Short
        Valid => 1,       # not required, default 0
    );

=cut

sub UserList {
    my ( $Self, %Param ) = @_;

    my $Type = $Param{Type} || 'Short';

    # set valid option
    my $Valid = $Param{Valid};
    if ( !defined $Valid || $Valid ) {
        $Valid = 1;
    }
    else {
        $Valid = 0;
    }

    # get configuration for the full name order
    my $FirstnameLastNameOrder = $Self->{ConfigObject}->Get('FirstnameLastnameOrder') || 0;

    # check cache
    my $CacheKey = 'UserList::' . $Type . '::' . $Valid
        . '::' . $FirstnameLastNameOrder;
    my $Cache = $Self->{CacheInternalObject}->Get(
        Key => $CacheKey,
    );
    return %{$Cache} if $Cache;

    my $SelectStr;
    if ( $Type eq 'Short' ) {
        $SelectStr = "$Self->{ConfigObject}->{DatabaseUserTableUserID}, "
            . " $Self->{ConfigObject}->{DatabaseUserTableUser}";
    }
    else {
        $SelectStr = "$Self->{ConfigObject}->{DatabaseUserTableUserID}, "
            . " last_name, first_name, "
            . " $Self->{ConfigObject}->{DatabaseUserTableUser}";
    }

    # sql query
    if ($Valid) {
        return if !$Self->{DBObject}->Prepare(
            SQL =>
                "SELECT $SelectStr FROM $Self->{ConfigObject}->{DatabaseUserTable} WHERE valid_id IN "
                . "( ${\(join ', ', $Self->{ValidObject}->ValidIDsGet())} )",
        );
    }
    else {
        return if !$Self->{DBObject}->Prepare(
            SQL => "SELECT $SelectStr FROM $Self->{ConfigObject}->{DatabaseUserTable}",
        );
    }

    # fetch the result
    my %UsersRaw;
    my %Users;
    while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
        $UsersRaw{ $Row[0] } = $Row[1];
    }

    if ( $Type eq 'Short' ) {
        %Users = %UsersRaw;
    }
    else {
        for my $CurrentUserID ( sort keys %UsersRaw ) {
            my $UserFullname = $Self->UserName( UserID => $CurrentUserID );
            $Users{$CurrentUserID} = $UserFullname;
        }
    }

    # check vacation option
    for my $UserID ( sort keys %Users ) {
        next if !$UserID;

        my %User = $Self->GetUserData(
            UserID => $UserID,
        );
        if ( $User{OutOfOfficeMessage} ) {
            $Users{$UserID} .= ' ' . $User{OutOfOfficeMessage};
        }
    }

    # set cache
    $Self->{CacheInternalObject}->Set(
        Key   => $CacheKey,
        Value => \%Users,
    );

    return %Users;
}

=item GenerateRandomPassword()

generate a random password

    my $Password = $UserObject->GenerateRandomPassword();

    or

    my $Password = $UserObject->GenerateRandomPassword(
        Size => 16,
    );

=cut

sub GenerateRandomPassword {
    my ( $Self, %Param ) = @_;

    # Generated passwords are eight characters long by default.
    my $Size = $Param{Size} || 8;

    my $Password = $Self->{MainObject}->GenerateRandomString(
        Length => $Size,
    );

    # Return the password.
    return $Password;
}

=item SetPreferences()

set user preferences

    $UserObject->SetPreferences(
        Key    => 'UserComment',
        Value  => 'some comment',
        UserID => 123,
    );

=cut

sub SetPreferences {
    my ( $Self, %Param ) = @_;

    # check needed stuff
    for (qw(Key UserID)) {
        if ( !$Param{$_} ) {
            $Self->{LogObject}->Log( Priority => 'error', Message => "Need $_!" );
            return;
        }
    }

    # get current setting
    my %User = $Self->GetUserData(
        UserID        => $Param{UserID},
        NoOutOfOffice => 1,
    );

    # no updated needed
    return 1
        if defined $User{ $Param{Key} }
        && defined $Param{Value}
        && $User{ $Param{Key} } eq $Param{Value};

    # delete cache
    my $Login = $Self->UserLookup( UserID => $Param{UserID} );
    $Self->{CacheInternalObject}->CleanUp();

    # set preferences
    return $Self->{PreferencesObject}->SetPreferences(%Param);
}

=item GetPreferences()

get user preferences

    my %Preferences = $UserObject->GetPreferences(
        UserID => 123,
    );

=cut

sub GetPreferences {
    my ( $Self, %Param ) = @_;

    return $Self->{PreferencesObject}->GetPreferences(%Param);
}

=item SearchPreferences()

search in user preferences

    my %UserList = $UserObject->SearchPreferences(
        Key   => 'UserEmail',
        Value => 'email@example.com',   # optional, limit to a certain value/pattern
    );

=cut

sub SearchPreferences {
    my $Self = shift;

    return $Self->{PreferencesObject}->SearchPreferences(@_);
}

=item TokenGenerate()

generate a random token

    my $Token = $UserObject->TokenGenerate(
        UserID => 123,
    );

=cut

sub TokenGenerate {
    my ( $Self, %Param ) = @_;

    # check needed stuff
    if ( !$Param{UserID} ) {
        $Self->{LogObject}->Log( Priority => 'error', Message => "Need UserID!" );
        return;
    }
    my $Token = $Self->{MainObject}->GenerateRandomString(
        Length => 15,
    );

    # save token in preferences
    $Self->SetPreferences(
        Key    => 'UserToken',
        Value  => $Token,
        UserID => $Param{UserID},
    );

    return $Token;
}

=item TokenCheck()

check password token

    my $Valid = $UserObject->TokenCheck(
        Token  => $Token,
        UserID => 123,
    );

=cut

sub TokenCheck {
    my ( $Self, %Param ) = @_;

    # check needed stuff
    if ( !$Param{Token} || !$Param{UserID} ) {
        $Self->{LogObject}->Log( Priority => 'error', Message => 'Need Token and UserID!' );
        return;
    }

    # get preferences token
    my %Preferences = $Self->GetPreferences(
        UserID => $Param{UserID},
    );

    # check requested vs. stored token
    if ( $Preferences{UserToken} && $Preferences{UserToken} eq $Param{Token} ) {

        # reset password token
        $Self->SetPreferences(
            Key    => 'UserToken',
            Value  => '',
            UserID => $Param{UserID},
        );

        # return true if token is valid
        return 1;
    }

    # return false if token is invalid
    return;
}

=item UserLoginExistsCheck()

return 1 if another user with this login (username) already exits

    $Exist = $UserObject->UserLoginExistsCheck(
        UserLogin => 'Some::UserLogin',
        UserID => 1, # optional
    );

=cut

sub UserLoginExistsCheck {
    my ( $Self, %Param ) = @_;
    return if !$Self->{DBObject}->Prepare(
        SQL =>
            "SELECT $Self->{UserTableUserID} FROM $Self->{UserTable} WHERE $Self->{UserTableUser} = ?",
        Bind => [ \$Param{UserLogin} ],
    );

    # fetch the result
    my $Flag;
    while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
        if ( !$Param{UserID} || $Param{UserID} ne $Row[0] ) {
            $Flag = 1;
        }
    }
    if ($Flag) {
        return 1;
    }
    return 0;
}

1;

=back

=head1 TERMS AND CONDITIONS

This software is part of the OTRS project (L<http://otrs.org/>).

This software comes with ABSOLUTELY NO WARRANTY. For details, see
the enclosed file COPYING for license information (AGPL). If you
did not receive this file, see L<http://www.gnu.org/licenses/agpl.txt>.

=cut
Greetings

Marco

Im running OTRS::ITSM 3.3.10 on Debian 7.4.
reneeb
Znuny guru
Posts: 5018
Joined: 13 Mar 2011, 09:54
Znuny Version: 6.0.x
Real Name: Renée Bäcker
Company: Perl-Services.de
Contact:

Re: Agenten Erstellung automatische Email

Post by reneeb »

In der sub new musst Du noch ein

Code: Select all

$Self->{SendmailObject} = Kernel::System::Email->new(%{$Self});
machen. Ansonsten sind keine Syntaxfehler drin. Starte dann mal den Apachen neu...
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
MarcoB106
Znuny newbie
Posts: 32
Joined: 14 Jan 2015, 12:20
Znuny Version: 3.3.10
Real Name: Marco
Company: DB

Re: Agenten Erstellung automatische Email

Post by MarcoB106 »

Danke für die Antwort. :)

Jetzt habe ich den Bereich new durch deinen Code erweiterert.

Code: Select all

sub new {
    my ( $Type, %Param ) = @_;

    # allocate new hash for object
    my $Self = {};
    bless( $Self, $Type );

    # check needed objects
    for (qw(DBObject ConfigObject LogObject TimeObject MainObject EncodeObject)) {
        $Self->{$_} = $Param{$_} || die "Got no $_!";
    }
	
$Self->{SendmailObject} = Kernel::System::Email->new(%{$Self});
    # get user table
    $Self->{UserTable}       = $Self->{ConfigObject}->Get('DatabaseUserTable')       || 'user';
    $Self->{UserTableUserID} = $Self->{ConfigObject}->Get('DatabaseUserTableUserID') || 'id';
    $Self->{UserTableUserPW} = $Self->{ConfigObject}->Get('DatabaseUserTableUserPW') || 'pw';
    $Self->{UserTableUser}   = $Self->{ConfigObject}->Get('DatabaseUserTableUser')   || 'login';

    # create needed object
    $Self->{ValidObject}     = Kernel::System::Valid->new( %{$Self} );
    $Self->{CheckItemObject} = Kernel::System::CheckItem->new( %{$Self} );

    $Self->{CacheInternalObject} = Kernel::System::CacheInternal->new(
        %{$Self},
        Type => 'User',
        TTL  => 60 * 60 * 3,
    );

    # set lower if database is case sensitive
    $Self->{Lower} = '';
    if ( $Self->{DBObject}->GetDatabaseFunction('CaseSensitive') ) {
        $Self->{Lower} = 'LOWER';
    }

    # load generator preferences module
    my $GeneratorModule = $Self->{ConfigObject}->Get('User::PreferencesModule')
        || 'Kernel::System::User::Preferences::DB';
    if ( $Self->{MainObject}->Require($GeneratorModule) ) {
        $Self->{PreferencesObject} = $GeneratorModule->new( %{$Self} );
    }

    return $Self;
}


Die Fehlemeldung tritt nun nichtmehr auf, beim übermitteln der Daten, jedoch wird trotzdem keine Email an die jeweilige Mail versendet.
Den Apache Server habe ich schon neugestartet.

Im Apache Error ist jedoch eine neue Fehlermeldung aufgetreten.

my "
Global symbol "$Sent" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 492.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 493.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 494.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 495.
Global symbol "$Self" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 496.
Global symbol "$ContentType" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 497.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 498.
Can't use global @_ in "my" at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 524, near "= @_"
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 528.
Global symbol "$Self" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 529.
syntax error at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 592, near "}"
/opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm has too many errors.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 13:47:57 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
[Tue Feb 17 14:03:15 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:03:15 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:21 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:22 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:23 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:25 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
[Tue Feb 17 14:05:38 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:05:39 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
[Tue Feb 17 14:15:29 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:15:30 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Can't call method "Send" on an undefined value at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 482.
[Tue Feb 17 14:35:13 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl, referer: http://172.26.41.93/otrs/index.pl?Actio ... action=Add
[Tue Feb 17 14:40:41 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:46:29 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Can't call method "Send" on an undefined value at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 482.
[Tue Feb 17 14:55:13 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl, referer: http://172.26.41.93/otrs/index.pl?Actio ... action=Add
[Tue Feb 17 15:57:05 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 15:57:06 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
ERROR: OTRS-CGI-40 Perl: 5.14.2 OS: linux Time: Tue Feb 17 15:58:44 2015

Message: Need Charset!

RemoteAddress: 10.176.6.119
RequestURI: /otrs/index.pl

Traceback (4887):
Module: Kernel::System::Email::Send (OTRS 3.3.10) Line: 176
Module: Kernel::System::User::UserAdd (OTRS 3.3.10) Line: 482
Module: Kernel::Modules::AdminUser::Run (OTRS 3.3.10) Line: 363
Module: Kernel::System::Web::InterfaceAgent::Run (OTRS 3.3.10) Line: 871
Module: /opt/otrs/bin/cgi-bin/index.pl (unknown version) Line: 49

[Tue Feb 17 15:59:26 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 15:59:27 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
ERROR: OTRS-CGI-40 Perl: 5.14.2 OS: linux Time: Tue Feb 17 16:02:25 2015

Message: Need Charset!

RemoteAddress: 10.176.6.119
RequestURI: /otrs/index.pl

Traceback (5049):
Module: Kernel::System::Email::Send (OTRS 3.3.10) Line: 176
Module: Kernel::System::User::UserAdd (OTRS 3.3.10) Line: 482
Module: Kernel::Modules::AdminUser::Run (OTRS 3.3.10) Line: 363
Module: Kernel::System::Web::InterfaceAgent::Run (OTRS 3.3.10) Line: 871
Module: /opt/otrs/bin/cgi-bin/index.pl (unknown version) Line: 49

Eine Idee was ich noch versuchen könnte?
Greetings

Marco

Im running OTRS::ITSM 3.3.10 on Debian 7.4.
reneeb
Znuny guru
Posts: 5018
Joined: 13 Mar 2011, 09:54
Znuny Version: 6.0.x
Real Name: Renée Bäcker
Company: Perl-Services.de
Contact:

Re: Agenten Erstellung automatische Email

Post by reneeb »

In dem Code, den Du in Deinem vorigen Post gezeigt hast, gibt es kein $SendObject und ein Syntaxfehler war auch nicht drin. Der Apache lädt anscheinend irgendeine andere Datei...
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
MarcoB106
Znuny newbie
Posts: 32
Joined: 14 Jan 2015, 12:20
Znuny Version: 3.3.10
Real Name: Marco
Company: DB

Re: Agenten Erstellung automatische Email

Post by MarcoB106 »

Code: Select all

my $ContentType = 'text/plain';
	
my $Sent = $Self->{SendmailObject}->Send(
From => $Self->{ConfigObject}->Get('NotificationSenderEmail'),
To => $Param{UserEmail},
Subject => 'OTRS account',
Charset => $Self->{LayoutObject}->{UserCharset},
MimeType => $ContentType,
Body => 'Name und PW',
);

return $UserID;


Code: Select all

my $Sent = $SendObject->Send(
        From          => 'me@example.com',
        To            => 'friend@example.com',
        Cc            => 'Some Customer B <customer-b@example.com>',   # not required
        ReplyTo       => 'Some Customer B <customer-b@example.com>',   # not required, is possible to use 'Reply-To' instead
        Subject       => 'Some words!',);
        


Macht es einen Unterschied, dass in Email.pm "my $Sent = $SendObject->Send(); "hinter legt ist und in User.pm "my $Sent = $Self->{SendmailObject}->Send();"
Greetings

Marco

Im running OTRS::ITSM 3.3.10 on Debian 7.4.
reneeb
Znuny guru
Posts: 5018
Joined: 13 Mar 2011, 09:54
Znuny Version: 6.0.x
Real Name: Renée Bäcker
Company: Perl-Services.de
Contact:

Re: Agenten Erstellung automatische Email

Post by reneeb »

Hast Du in Email.pm auch was geändert? Das mit den "$SendObject" sollte eigentlich nur in der Dokumentation (zwischen =item ... und =cut) stehen...
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
MarcoB106
Znuny newbie
Posts: 32
Joined: 14 Jan 2015, 12:20
Znuny Version: 3.3.10
Real Name: Marco
Company: DB

Re: Agenten Erstellung automatische Email

Post by MarcoB106 »

Nein in Email.pm wurde nichts geändert.

Code: Select all

# --
# Kernel/System/Email.pm - the global email send module
# Copyright (C) 2001-2014 xxx, http://otrs.com/
# --
# This software comes with ABSOLUTELY NO WARRANTY. For details, see
# the enclosed file COPYING for license information (AGPL). If you
# did not receive this file, see http://www.gnu.org/licenses/agpl.txt.
# --

package Kernel::System::Email;
## nofilter(TidyAll::Plugin::OTRS::Perl::Require)

use strict;
use warnings;

use MIME::Entity;
use Mail::Address;

use Kernel::System::Crypt;
use Kernel::System::HTMLUtils;
use Kernel::System::VariableCheck qw(:all);

=head1 NAME

Kernel::System::Email - to send email

=head1 SYNOPSIS

Global module to send email via sendmail or SMTP.

=head1 PUBLIC INTERFACE

=over 4

=cut

=item new()

create an object

    use Kernel::Config;
    use Kernel::System::Encode;
    use Kernel::System::Log;
    use Kernel::System::Main;
    use Kernel::System::Time;
    use Kernel::System::DB;
    use Kernel::System::Email;

    my $ConfigObject = Kernel::Config->new();
    my $EncodeObject = Kernel::System::Encode->new(
        ConfigObject => $ConfigObject,
    );
    my $LogObject = Kernel::System::Log->new(
        ConfigObject => $ConfigObject,
        EncodeObject => $EncodeObject,
    );
    my $MainObject = Kernel::System::Main->new(
        ConfigObject => $ConfigObject,
        EncodeObject => $EncodeObject,
        LogObject    => $LogObject,
    );
    my $TimeObject = Kernel::System::Time->new(
        ConfigObject => $ConfigObject,
        LogObject    => $LogObject,
    );
    my $DBObject = Kernel::System::DB->new(
        ConfigObject => $ConfigObject,
        EncodeObject => $EncodeObject,
        LogObject    => $LogObject,
        MainObject   => $MainObject,
    );
    my $SendObject = Kernel::System::Email->new(
        ConfigObject => $ConfigObject,
        LogObject    => $LogObject,
        DBObject     => $DBObject,
        MainObject   => $MainObject,
        TimeObject   => $TimeObject,
        EncodeObject => $EncodeObject,
    );

=cut

sub new {
    my ( $Type, %Param ) = @_;

    # allocate new hash for object
    my $Self = {%Param};
    bless( $Self, $Type );

    # debug level
    $Self->{Debug} = $Param{Debug} || 0;

    # check all needed objects
    for (qw(ConfigObject LogObject DBObject TimeObject MainObject EncodeObject)) {
        die "Got no $_" if !$Self->{$_};
    }

    # load generator backend module
    my $GenericModule = $Self->{ConfigObject}->Get('SendmailModule')
        || 'Kernel::System::Email::Sendmail';

    return if !$Self->{MainObject}->Require($GenericModule);

    # create backend object
    $Self->{Backend} = $GenericModule->new( %{$Self} );

    $Self->{HTMLUtilsObject} = Kernel::System::HTMLUtils->new( %{$Self} );

    return $Self;
}

=item Send()

To send an email without already created header:

    my $Sent = $SendObject->Send(
        From          => 'me@example.com',
        To            => 'friend@example.com',
        Cc            => 'Some Customer B <customer-b@example.com>',   # not required
        ReplyTo       => 'Some Customer B <customer-b@example.com>',   # not required, is possible to use 'Reply-To' instead
        Subject       => 'Some words!',
        Charset       => 'iso-8859-15',
        MimeType      => 'text/plain', # "text/plain" or "text/html"
        Body          => 'Some nice text',
        InReplyTo     => '<somemessageid-2@example.com>',
        References    => '<somemessageid-1@example.com> <somemessageid-2@example.com>',
        Loop          => 1, # not required, removes smtp from
        CustomHeaders => {
            X-OTRS-MyHeader => 'Some Value',
        },
        Attachment   => [
            {
                Filename    => "somefile.csv",
                Content     => $ContentCSV,
                ContentType => "text/csv",
            },
            {
                Filename    => "somefile.png",
                Content     => $ContentPNG,
                ContentType => "image/png",
            }
        ],
        Sign => {
            Type    => 'PGP',
            SubType => 'Inline|Detached',
            Key     => '81877F5E',

            Type => 'SMIME',
            Key  => '3b630c80',
        },
        Crypt => {
            Type    => 'PGP',
            SubType => 'Inline|Detached',
            Key     => '81877F5E',

            Type => 'SMIME',
            Key  => '3b630c80',
        },
    );

    if ($Sent) {
        print "Email sent!\n";
    }
    else {
        print "Email not sent!\n";
    }

=cut

sub Send {
    my ( $Self, %Param ) = @_;

    # check needed stuff
    for (qw(Body Charset)) {
        if ( !$Param{$_} ) {
            $Self->{LogObject}->Log( Priority => 'error', Message => "Need $_!" );
            return;
        }
    }
    if ( !$Param{To} && !$Param{Cc} && !$Param{Bcc} ) {
        $Self->{LogObject}->Log( Priority => 'error', Message => 'Need To, Cc or Bcc!' );
        return;
    }

    # check from
    if ( !$Param{From} ) {
        $Param{From} = $Self->{ConfigObject}->Get('AdminEmail') || 'otrs@localhost';
    }

    # replace all br tags with br tags with a space to show newlines in Lotus Notes
    if ( $Param{MimeType} && lc $Param{MimeType} eq 'text/html' ) {
        $Param{Body} =~ s{\Q<br/>\E}{<br />}xmsgi;
    }

    # map ReplyTo into Reply-To if present
    if ( $Param{ReplyTo} ) {
        $Param{'Reply-To'} = $Param{ReplyTo};
    }

    # get sign options for inline
    if ( $Param{Sign} && $Param{Sign}->{SubType} && $Param{Sign}->{SubType} eq 'Inline' ) {
        my $CryptObject = Kernel::System::Crypt->new(
            LogObject    => $Self->{LogObject},
            DBObject     => $Self->{DBObject},
            ConfigObject => $Self->{ConfigObject},
            EncodeObject => $Self->{EncodeObject},
            CryptType    => $Param{Sign}->{Type},
            MainObject   => $Self->{MainObject},
        );
        if ( !$CryptObject ) {
            return;
        }
        my $Body = $CryptObject->Sign(
            Message => $Param{Body},
            Key     => $Param{Sign}->{Key},
            Type    => 'Clearsign',
            Charset => $Param{Charset},
        );
        if ($Body) {
            $Param{Body} = $Body;
        }
    }

    # crypt inline
    if ( $Param{Crypt} && $Param{Crypt}->{Type} eq 'PGP' && $Param{Crypt}->{SubType} eq 'Inline' ) {
        my $CryptObject = Kernel::System::Crypt->new(
            LogObject    => $Self->{LogObject},
            DBObject     => $Self->{DBObject},
            ConfigObject => $Self->{ConfigObject},
            EncodeObject => $Self->{EncodeObject},
            CryptType    => $Param{Crypt}->{Type},
            MainObject   => $Self->{MainObject},
        );
        if ( !$CryptObject ) {
            $Self->{LogObject}->Log(
                Message  => 'Not possible to create crypt object',
                Priority => 'error',
            );
            return;
        }

        my $Body = $CryptObject->Crypt(
            Message => $Param{Body},
            Key     => $Param{Crypt}->{Key},
            Type    => $Param{Crypt}->{SubType},
        );
        if ($Body) {
            $Param{Body} = $Body;
        }
    }

    # build header
    my %Header;
    if ( IsHashRefWithData( $Param{CustomHeaders} ) ) {
        %Header = %{ $Param{CustomHeaders} };
    }
    for (qw(From To Cc Subject Charset Reply-To)) {
        next if !$Param{$_};
        $Header{$_} = $Param{$_};
    }

    # loop
    if ( $Param{Loop} ) {
        $Header{'X-Loop'}          = 'yes';
        $Header{'Precedence:'}     = 'bulk';
        $Header{'Auto-Submitted:'} = "auto-generated";
    }

    # do some encode
    for (qw(From To Cc Subject)) {
        next if !$Header{$_};
        $Header{$_} = $Self->_EncodeMIMEWords(
            Field   => $_,
            Line    => $Header{$_},
            Charset => $Param{Charset},
        );
    }

    # check if it's html, add text attachment
    my $HTMLEmail = 0;
    if ( $Param{MimeType} && $Param{MimeType} =~ /html/i ) {
        $HTMLEmail = 1;

        # add html as first attachment
        my $Attach = {
            Content     => $Param{Body},
            ContentType => "text/html; charset=\"$Param{Charset}\"",
            Filename    => '',
        };
        if ( !$Param{Attachment} ) {
            @{ $Param{Attachment} } = ($Attach);
        }
        else {
            @{ $Param{Attachment} } = ( $Attach, @{ $Param{Attachment} } );
        }

        # remember html body for later comparison
        $Param{HTMLBody} = $Param{Body};

        # add ascii body
        $Param{MimeType} = 'text/plain';
        $Param{Body}     = $Self->{HTMLUtilsObject}->ToAscii(
            String => $Param{Body},
        );

    }

    my $Product = $Self->{ConfigObject}->Get('Product');
    my $Version = $Self->{ConfigObject}->Get('Version');

    if ( !$Self->{ConfigObject}->Get('Secure::DisableBanner') ) {
        $Header{'X-Mailer'}     = "$Product Mail Service ($Version)";
        $Header{'X-Powered-By'} = 'OTRS - Open Ticket Request System (http://otrs.org/)';
    }
    $Header{Type} = $Param{MimeType} || 'text/plain';

    # define email encoding
    if ( $Param{Charset} && $Param{Charset} =~ /^iso/i ) {
        $Header{Encoding} = '8bit';
    }
    else {
        $Header{Encoding} = 'quoted-printable';
    }

    # check if we need to force the encoding
    if ( $Self->{ConfigObject}->Get('SendmailEncodingForce') ) {
        $Header{Encoding} = $Self->{ConfigObject}->Get('SendmailEncodingForce');
    }

    # check and create message id
    if ( $Param{'Message-ID'} ) {
        $Header{'Message-ID'} = $Param{'Message-ID'};
    }
    else {
        $Header{'Message-ID'} = $Self->_MessageIDCreate();
    }

    # add date header
    $Header{Date} = 'Date: ' . $Self->{TimeObject}->MailTimeStamp();

    # add organisation header
    my $Organization = $Self->{ConfigObject}->Get('Organization');
    if ($Organization) {
        $Header{Organization} = $Self->_EncodeMIMEWords(
            Field   => 'Organization',
            Line    => $Organization,
            Charset => $Param{Charset},
        );
    }

    # build MIME::Entity, Data should be bytes, not utf-8
    # see http://bugs.otrs.org/show_bug.cgi?id=9832
    $Self->{EncodeObject}->EncodeOutput( \$Param{Body} );
    my $Entity = MIME::Entity->build( %Header, Data => $Param{Body} );

    # set In-Reply-To and References header
    my $Header = $Entity->head();
    if ( $Param{InReplyTo} ) {
        $Param{'In-Reply-To'} = $Param{InReplyTo};
    }
    for my $Key ( 'In-Reply-To', 'References' ) {
        next if !$Param{$Key};
        my $Value = $Param{$Key};

        # Split up '<msgid><msgid>' to allow line folding (see bug#9345).
        $Value =~ s{><}{> <}xmsg;
        $Header->replace( $Key, $Value );
    }

    # add attachments to email
    if ( $Param{Attachment} ) {
        my $Count    = 0;
        my $PartType = '';
        my @NewAttachments;
        ATTACHMENT:
        for my $Upload ( @{ $Param{Attachment} } ) {

            # ignore attachment if no content is given
            next ATTACHMENT if !defined $Upload->{Content};

            # ignore attachment if no filename is given
            next ATTACHMENT if !defined $Upload->{Filename};

            # prepare ContentType for Entity Type. $Upload->{ContentType} has
            # useless `name` parameter, we don't need to send it to the `attach`
            # constructor. For more details see Bug #7879 and MIME::Entity.
            # Note: we should remove `name` attribute only.
            my @ContentTypeTmp = grep { !/\s*name=/ } ( split /;/, $Upload->{ContentType} );
            $Upload->{ContentType} = join ';', @ContentTypeTmp;

            # if it's a html email, add the first attachment as alternative (to show it
            # as alternative content)
            if ($HTMLEmail) {
                $Count++;
                if ( $Count == 1 ) {
                    $Entity->make_multipart('alternative;');
                    $PartType = 'alternative';
                }
                else {

                    # don't attach duplicate html attachment (aka file-2)
                    next ATTACHMENT if
                        $Upload->{Filename} eq 'file-2'
                        && $Upload->{ContentType} =~ /html/i
                        && $Upload->{Content} eq $Param{HTMLBody};

                    # skip, but remember all attachments except inline images
                    if ( !defined $Upload->{ContentID} ) {
                        push @NewAttachments, \%{$Upload};
                        next ATTACHMENT;
                    }

                    # add inline images as related
                    if ( $PartType ne 'related' ) {
                        $Entity->make_multipart( 'related;', Force => 1, );
                        $PartType = 'related';
                    }
                }
            }

            # content encode
            $Self->{EncodeObject}->EncodeOutput( \$Upload->{Content} );

            # filename encode
            my $Filename = $Self->_EncodeMIMEWords(
                Field   => 'filename',
                Line    => $Upload->{Filename},
                Charset => $Param{Charset},
            );

            # format content id, leave undefined if no value
            my $ContentID = $Upload->{ContentID};
            if ( $ContentID && $ContentID !~ /^</ ) {
                $ContentID = '<' . $ContentID . '>';
            }

            # attach file to email
            $Entity->attach(
                Filename    => $Filename,
                Data        => $Upload->{Content},
                Type        => $Upload->{ContentType},
                Id          => $ContentID,
                Disposition => $Upload->{Disposition} || 'inline',
                Encoding    => $Upload->{Encoding} || '-SUGGEST',
            );
        }

        # add all other attachments as multipart mixed (if we had html body)
        for my $Upload (@NewAttachments) {

            # make multipart mixed
            if ( $PartType ne 'mixed' ) {
                $Entity->make_multipart( 'mixed;', Force => 1, );
                $PartType = 'mixed';
            }

            # content encode
            $Self->{EncodeObject}->EncodeOutput( \$Upload->{Content} );

            # filename encode
            my $Filename = $Self->_EncodeMIMEWords(
                Field   => 'filename',
                Line    => $Upload->{Filename},
                Charset => $Param{Charset},
            );

            # attach file to email (no content id needed)
            $Entity->attach(
                Filename    => $Filename,
                Data        => $Upload->{Content},
                Type        => $Upload->{ContentType},
                Disposition => $Upload->{Disposition} || 'inline',
                Encoding    => $Upload->{Encoding} || '-SUGGEST',
            );
        }
    }

    # get sign options for detached
    if ( $Param{Sign} && $Param{Sign}->{SubType} && $Param{Sign}->{SubType} eq 'Detached' ) {
        my $CryptObject = Kernel::System::Crypt->new(
            LogObject    => $Self->{LogObject},
            DBObject     => $Self->{DBObject},
            ConfigObject => $Self->{ConfigObject},
            EncodeObject => $Self->{EncodeObject},
            MainObject   => $Self->{MainObject},
            CryptType    => $Param{Sign}->{Type},
        );
        if ( !$CryptObject ) {
            $Self->{LogObject}->Log(
                Message  => 'Not possible to create crypt object',
                Priority => 'error',
            );
            return;
        }

        if ( $Param{Sign}->{Type} eq 'PGP' ) {

            # make_multipart -=> one attachment for sign
            $Entity->make_multipart(
                "signed; micalg=pgp-sha1; protocol=\"application/pgp-signature\";",
                Force => 1,
            );

            # get string to sign
            my $T = $Entity->parts(0)->as_string();

            # according to RFC3156 all line endings MUST be CR/LF
            $T =~ s/\x0A/\x0D\x0A/g;
            $T =~ s/\x0D+/\x0D/g;
            my $Sign = $CryptObject->Sign(
                Message => $T,
                Key     => $Param{Sign}->{Key},
                Type    => 'Detached',
                Charset => $Param{Charset},
            );

            # it sign failed, remove singned multi part
            if ( !$Sign ) {
                $Entity->make_singlepart();
            }
            else {

                # addach sign to email
                $Entity->attach(
                    Filename => 'pgp_sign.asc',
                    Data     => $Sign,
                    Type     => 'application/pgp-signature',
                    Encoding => '7bit',
                );
            }
        }
        elsif ( $Param{Sign}->{Type} eq 'SMIME' ) {

            # make multi part
            my $EntityCopy = $Entity->dup();
            $EntityCopy->make_multipart( 'mixed;', Force => 1, );

            # get header to remember
            my $Head = $EntityCopy->head();
            $Head->delete('MIME-Version');
            $Head->delete('Content-Type');
            $Head->delete('Content-Disposition');
            $Head->delete('Content-Transfer-Encoding');
            my $Header = $Head->as_string();

            # get string to sign
            my $T = $EntityCopy->parts(0)->as_string();

            # according to RFC3156 all line endings MUST be CR/LF
            $T =~ s/\x0A/\x0D\x0A/g;
            $T =~ s/\x0D+/\x0D/g;

            # remove empty line after multi-part preable as it will be removed later by MIME::Parser
            #    otherwise signed content will be different than the actual mail and verify will
            #    fail
            $T =~ s{(This is a multi-part message in MIME format...\r\n)\r\n}{$1}g;

            my $Sign = $CryptObject->Sign(
                Message  => $T,
                Filename => $Param{Sign}->{Key},
                Type     => 'Detached',
            );
            if ($Sign) {
                use MIME::Parser;
                my $Parser = MIME::Parser->new();
                $Parser->output_to_core('ALL');

                $Parser->output_dir( $Self->{ConfigObject}->Get('TempDir') );
                $Entity = $Parser->parse_data( $Header . $Sign );
            }
        }
    }

    # crypt detached!
    #my $NotCryptedBody = $Entity->body_as_string();
    if (
        $Param{Crypt}
        && $Param{Crypt}->{Type}
        && $Param{Crypt}->{Type} eq 'PGP'
        && $Param{Crypt}->{SubType} eq 'Detached'
        )
    {
        my $CryptObject = Kernel::System::Crypt->new(
            LogObject    => $Self->{LogObject},
            DBObject     => $Self->{DBObject},
            ConfigObject => $Self->{ConfigObject},
            EncodeObject => $Self->{EncodeObject},
            MainObject   => $Self->{MainObject},
            CryptType    => $Param{Crypt}->{Type},
        );
        return if !$CryptObject;

        # make_multipart -=> one attachment for encryption
        $Entity->make_multipart(
            "encrypted; protocol=\"application/pgp-encrypted\";",
            Force => 1,
        );

        # crypt it
        my $Crypt = $CryptObject->Crypt(
            Message => $Entity->parts(0)->as_string(),

            # Key => '81877F5E',
            # Key => '488A0B8F',
            Key => $Param{Crypt}->{Key},
        );

        # it crypt failed, remove encrypted multi part
        if ( !$Crypt ) {
            $Entity->make_singlepart();
        }
        else {

            # eliminate all parts
            $Entity->parts( [] );

            # add crypted parts
            $Entity->attach(
                Type        => 'application/pgp-encrypted',
                Disposition => 'attachment',
                Data        => [ "Version: 1", "" ],
                Encoding    => '7bit',
            );
            $Entity->attach(
                Type        => 'application/octet-stream',
                Disposition => 'inline',
                Filename    => 'msg.asc',
                Data        => $Crypt,
                Encoding    => '7bit',
            );
        }
    }
    elsif ( $Param{Crypt} && $Param{Crypt}->{Type} && $Param{Crypt}->{Type} eq 'SMIME' ) {
        my $CryptObject = Kernel::System::Crypt->new(
            LogObject    => $Self->{LogObject},
            DBObject     => $Self->{DBObject},
            ConfigObject => $Self->{ConfigObject},
            EncodeObject => $Self->{EncodeObject},
            MainObject   => $Self->{MainObject},
            CryptType    => $Param{Crypt}->{Type},
        );

        if ( !$CryptObject ) {
            $Self->{LogObject}->Log(
                Message  => 'Failed creation of crypt object',
                Priority => 'error',
            );
            return;
        }

        # make_multipart -=> one attachment for encryption
        $Entity->make_multipart( 'mixed;', Force => 1, );

        # get header to remember
        my $Head = $Entity->head();
        $Head->delete('MIME-Version');
        $Head->delete('Content-Type');
        $Head->delete('Content-Disposition');
        $Head->delete('Content-Transfer-Encoding');
        my $Header = $Head->as_string();

        my $T = $Entity->parts(0)->as_string();

        # according to RFC3156 all line endings MUST be CR/LF
        $T =~ s/\x0A/\x0D\x0A/g;
        $T =~ s/\x0D+/\x0D/g;

        # crypt it
        my $Crypt = $CryptObject->Crypt(
            Message  => $T,
            Filename => $Param{Crypt}->{Key},
        );
        use MIME::Parser;
        my $Parser = MIME::Parser->new();

        $Parser->output_dir( $Self->{ConfigObject}->Get('TempDir') );
        $Entity = $Parser->parse_data( $Header . $Crypt );
    }

    # get header from Entity
    my $Head = $Entity->head();
    $Param{Header} = $Head->as_string();

    # remove not needed folding of email heads, we do have many problems with email clients
    my @Headers = split( /\n/, $Param{Header} );

    # reset orig header
    $Param{Header} = '';
    for my $Line (@Headers) {
        $Line =~ s/^    (.*)$/ $1/;
        $Param{Header} .= $Line . "\n";
    }

    # get body from Entity
    $Param{Body} = $Entity->body_as_string();

    # get recipients
    my @ToArray;
    my $To = '';
    for (qw(To Cc Bcc)) {
        next if !$Param{$_};
        for my $Email ( Mail::Address->parse( $Param{$_} ) ) {
            push( @ToArray, $Email->address() );
            if ($To) {
                $To .= ', ';
            }
            $To .= $Email->address();
        }
    }

    # add Bcc recipients
    my $SendmailBcc = $Self->{ConfigObject}->Get('SendmailBcc');
    if ($SendmailBcc) {
        push @ToArray, $SendmailBcc;
        $To .= ', ' . $SendmailBcc;
    }

    # set envelope sender for replies
    my $RealFrom = $Self->{ConfigObject}->Get('SendmailEnvelopeFrom') || '';
    if ( !$RealFrom ) {
        my @Sender = Mail::Address->parse( $Param{From} );
        $RealFrom = $Sender[0]->address();
    }

    # set envelope sender for autoresponses and notifications
    if ( $Param{Loop} ) {
        $RealFrom = $Self->{ConfigObject}->Get('SendmailNotificationEnvelopeFrom') || '';
    }

    # debug
    if ( $Self->{Debug} > 1 ) {
        $Self->{LogObject}->Log(
            Priority => 'notice',
            Message  => "Sent email to '$To' from '$RealFrom'. Subject => '$Param{Subject}';",
        );
    }

    # send email to backend
    my $Sent = $Self->{Backend}->Send(
        From    => $RealFrom,
        ToArray => \@ToArray,
        Header  => \$Param{Header},
        Body    => \$Param{Body},
    );

    if ( !$Sent ) {
        $Self->{LogObject}->Log(
            Message  => "Error sending message",
            Priority => 'info',
        );
        return;
    }

    return ( \$Param{Header}, \$Param{Body} );
}

=item Check()

Check mail configuration

    my %Check = $SendObject->Check();

=cut

sub Check {
    my ( $Self, %Param ) = @_;

    my %Check = $Self->{Backend}->Check();

    if ( $Check{Successful} ) {
        return ( Successful => 1 )
    }
    else {
        return ( Successful => 0, Message => $Check{Message} );
    }
}

=item Bounce()

Bounce an email

    $SendObject->Bounce(
        From  => 'me@example.com',
        To    => 'friend@example.com',
        Email => $Email,
    );

=cut

sub Bounce {
    my ( $Self, %Param ) = @_;

    # check needed stuff
    for (qw(From To Email)) {
        if ( !$Param{$_} ) {
            $Self->{LogObject}->Log( Priority => 'error', Message => "Need $_!" );
            return;
        }
    }

    # check and create message id
    my $MessageID = '';
    if ( $Param{'Message-ID'} ) {
        $MessageID = $Param{'Message-ID'};
    }
    else {
        $MessageID = $Self->_MessageIDCreate();
    }

    # split body && header
    my @EmailPlain = split( /\n/, $Param{Email} );
    my $EmailObject = Mail::Internet->new( \@EmailPlain );

    # get sender
    my @Sender   = Mail::Address->parse( $Param{From} );
    my $RealFrom = $Sender[0]->address();

    # add ReSent header
    my $HeaderObject = $EmailObject->head();
    my $OldMessageID = $HeaderObject->get('Message-ID') || '??';
    $HeaderObject->replace( 'Message-ID',        $MessageID );
    $HeaderObject->replace( 'ReSent-Message-ID', $OldMessageID );
    $HeaderObject->replace( 'Resent-To',         $Param{To} );
    $HeaderObject->replace( 'Resent-From',       $RealFrom );
    my $Body         = $EmailObject->body();
    my $BodyAsString = '';
    for ( @{$Body} ) {
        $BodyAsString .= $_ . "\n";
    }
    my $HeaderAsString = $HeaderObject->as_string();

    # debug
    if ( $Self->{Debug} > 1 ) {
        $Self->{LogObject}->Log(
            Priority => 'notice',
            Message  => "Bounced email to '$Param{To}' from '$RealFrom'. "
                . "MessageID => '$OldMessageID';",
        );
    }

    my $Sent = $Self->{Backend}->Send(
        From    => $RealFrom,
        ToArray => [ $Param{To} ],
        Header  => \$HeaderAsString,
        Body    => \$BodyAsString,
    );

    return if !$Sent;

    return ( \$HeaderAsString, \$BodyAsString );
}

=begin Internal:

=cut

sub _EncodeMIMEWords {
    my ( $Self, %Param ) = @_;

    # return if no content is given
    return '' if !defined $Param{Line};

    # check if MIME::EncWords is installed
    if ( eval { require MIME::EncWords } ) {    ## no critic
        return MIME::EncWords::encode_mimewords(
            Encode::encode(
                $Param{Charset},
                $Param{Line},
            ),
            Charset => $Param{Charset},

            # use 'a' for quoted printable or base64 choice automatically
            Encoding => 'a',

            # for line length calculation to fold lines
            Field => $Param{Field},
        );
    }

    # as fallback use MIME::Words of MIME::Tools (but it lakes on some utf8
    # issues, see pod of MIME::Words)
    else {
        require MIME::Words;    ## no critic
        return MIME::Words::encode_mimewords(
            Encode::encode(
                $Param{Charset},
                $Param{Line},
            ),
            Charset => $Param{Charset},

            # for line length calculation to fold lines (gets ignored by
            # MIME::Words, see pod of MIME::Words)
            Field => $Param{Field},
        );
    }
}

sub _MessageIDCreate {
    my ( $Self, %Param ) = @_;

    my $FQDN = $Self->{ConfigObject}->Get('FQDN');
    return 'Message-ID: <' . time() . '.' . rand(999999) . '@' . $FQDN . '>';
}

1;

=end Internal:

=back

=head1 TERMS AND CONDITIONS

This software is part of the OTRS project (L<http://otrs.org/>).

This software comes with ABSOLUTELY NO WARRANTY. For details, see
the enclosed file COPYING for license information (AGPL). If you
did not receive this file, see L<http://www.gnu.org/licenses/agpl.txt>.

=cut
Greetings

Marco

Im running OTRS::ITSM 3.3.10 on Debian 7.4.
reneeb
Znuny guru
Posts: 5018
Joined: 13 Mar 2011, 09:54
Znuny Version: 6.0.x
Real Name: Renée Bäcker
Company: Perl-Services.de
Contact:

Re: Agenten Erstellung automatische Email

Post by reneeb »

Dann sollte der Code eigentlich funktionieren. Die Fehlermeldungen passen nicht zu dem Code, den Du vorhin gepostet hast. Kontrollier nochmal, dass Du die richtige User.pm geändert hast. Ansonsten weiß ich jetzt auch nicht, wie ich Dir über das Forum weiterhelfen kann..
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
MarcoB106
Znuny newbie
Posts: 32
Joined: 14 Jan 2015, 12:20
Znuny Version: 3.3.10
Real Name: Marco
Company: DB

Re: Agenten Erstellung automatische Email

Post by MarcoB106 »

Habs überprüft stimmt alles. Das ist das was aktuelle im Apache - Log steht

[Tue Feb 17 14:20:10 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:20:16 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
[Tue Feb 17 16:57:09 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 16:57:14 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
[Tue Feb 17 16:58:26 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 16:58:31 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
ERROR: OTRS-CGI-40 Perl: 5.14.2 OS: linux Time: Tue Feb 17 17:00:55 2015

Message: Need Charset!

RemoteAddress: 10.176.6.119
RequestURI: /otrs/index.pl

Traceback (6503):
Module: Kernel::System::Email::Send (OTRS 3.3.10) Line: 176
Module: Kernel::System::User::UserAdd (OTRS 3.3.10) Line: 483
Module: Kernel::Modules::AdminUser::Run (OTRS 3.3.10) Line: 361
Module: Kernel::System::Web::InterfaceAgent::Run (OTRS 3.3.10) Line: 871
Module: ModPerl::ROOT::ModPerl::Registry::opt_otrs_bin_cgi_2dbin_index_2epl::handler (unknown version) Line: 49
Module: (eval) (v1.99) Line: 204
Module: ModPerl::RegistryCooker::run (v1.99) Line: 204
Module: ModPerl::RegistryCooker::default_handler (v1.99) Line: 170
Module: ModPerl::Registry::handler (v1.99) Line: 31



Falls das nicht weiterhilft, dann bedank ich mich trotzdem für die Hilfe :)
Greetings

Marco

Im running OTRS::ITSM 3.3.10 on Debian 7.4.
reneeb
Znuny guru
Posts: 5018
Joined: 13 Mar 2011, 09:54
Znuny Version: 6.0.x
Real Name: Renée Bäcker
Company: Perl-Services.de
Contact:

Re: Agenten Erstellung automatische Email

Post by reneeb »

Ok, das sieht schon besser aus. Jetzt ersetze noch

Code: Select all

$Self->{LayoutObject}->{UserCharset}
mit

Code: Select all

'utf-8'
, dann sollte es passen...
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
MarcoB106
Znuny newbie
Posts: 32
Joined: 14 Jan 2015, 12:20
Znuny Version: 3.3.10
Real Name: Marco
Company: DB

Re: Agenten Erstellung automatische Email

Post by MarcoB106 »

Es funktioniert! Vielen Dank für deine Geduld und deine Hilfe =).


Für alle, die die selbe Funktion umsetzen möchten, hier der Code:

Code: Select all

# --
# Kernel/System/User.pm - some user functions
# Copyright (C) 2001-2014 xxx, http://otrs.com/
# --
# This software comes with ABSOLUTELY NO WARRANTY. For details, see
# the enclosed file COPYING for license information (AGPL). If you
# did not receive this file, see http://www.gnu.org/licenses/agpl.txt.
# --

package Kernel::System::User;

use strict;
use warnings;

use Crypt::PasswdMD5 qw(unix_md5_crypt);
use Digest::SHA;

use Kernel::System::CacheInternal;
use Kernel::System::CheckItem;
use Kernel::System::Email;

=head1 NAME

Kernel::System::User - user lib

=head1 SYNOPSIS

All user functions. E. g. to add and updated user and other functions.

=head1 PUBLIC INTERFACE

=over 4

=cut

=item new()

create an object

    use Kernel::Config;
    use Kernel::System::Encode;
    use Kernel::System::Log;
    use Kernel::System::Main;
    use Kernel::System::Time;
    use Kernel::System::DB;
    use Kernel::System::User;

    my $ConfigObject = Kernel::Config->new();
    my $EncodeObject = Kernel::System::Encode->new(
        ConfigObject => $ConfigObject,
    );
    my $LogObject = Kernel::System::Log->new(
        ConfigObject => $ConfigObject,
        EncodeObject => $EncodeObject,
    );
    my $MainObject = Kernel::System::Main->new(
        ConfigObject => $ConfigObject,
        EncodeObject => $EncodeObject,
        LogObject    => $LogObject,
    );
    my $TimeObject = Kernel::System::Time->new(
        ConfigObject => $ConfigObject,
        LogObject    => $LogObject,
    );
    my $DBObject = Kernel::System::DB->new(
        ConfigObject => $ConfigObject,
        EncodeObject => $EncodeObject,
        LogObject    => $LogObject,
        MainObject   => $MainObject,
    );
    my $UserObject = Kernel::System::User->new(
        ConfigObject => $ConfigObject,
        LogObject    => $LogObject,
        MainObject   => $MainObject,
        TimeObject   => $TimeObject,
        DBObject     => $DBObject,
        EncodeObject => $EncodeObject,
    );

=cut

sub new {
    my ( $Type, %Param ) = @_;

    # allocate new hash for object
    my $Self = {};
    bless( $Self, $Type );

    # check needed objects
    for (qw(DBObject ConfigObject LogObject TimeObject MainObject EncodeObject)) {
        $Self->{$_} = $Param{$_} || die "Got no $_!";
    }
	
	$Self->{SendmailObject} = Kernel::System::Email->new(%{$Self});
    # get user table
    $Self->{UserTable}       = $Self->{ConfigObject}->Get('DatabaseUserTable')       || 'user';
    $Self->{UserTableUserID} = $Self->{ConfigObject}->Get('DatabaseUserTableUserID') || 'id';
    $Self->{UserTableUserPW} = $Self->{ConfigObject}->Get('DatabaseUserTableUserPW') || 'pw';
    $Self->{UserTableUser}   = $Self->{ConfigObject}->Get('DatabaseUserTableUser')   || 'login';

    # create needed object
    $Self->{ValidObject}     = Kernel::System::Valid->new( %{$Self} );
    $Self->{CheckItemObject} = Kernel::System::CheckItem->new( %{$Self} );

    $Self->{CacheInternalObject} = Kernel::System::CacheInternal->new(
        %{$Self},
        Type => 'User',
        TTL  => 60 * 60 * 3,
    );

    # set lower if database is case sensitive
    $Self->{Lower} = '';
    if ( $Self->{DBObject}->GetDatabaseFunction('CaseSensitive') ) {
        $Self->{Lower} = 'LOWER';
    }

    # load generator preferences module
    my $GeneratorModule = $Self->{ConfigObject}->Get('User::PreferencesModule')
        || 'Kernel::System::User::Preferences::DB';
    if ( $Self->{MainObject}->Require($GeneratorModule) ) {
        $Self->{PreferencesObject} = $GeneratorModule->new( %{$Self} );
    }

    return $Self;
}

=item GetUserData()

get user data (UserLogin, UserFirstname, UserLastname, UserEmail, ...)

    my %User = $UserObject->GetUserData(
        UserID => 123,
    );

    or

    my %User = $UserObject->GetUserData(
        User          => 'franz',
        Valid         => 1,       # not required -> 0|1 (default 0)
                                  # returns only data if user is valid
        NoOutOfOffice => 1,       # not required -> 0|1 (default 0)
                                  # returns data without out of office infos
    );

=cut

sub GetUserData {
    my ( $Self, %Param ) = @_;

    # check needed stuff
    if ( !$Param{User} && !$Param{UserID} ) {
        $Self->{LogObject}->Log( Priority => 'error', Message => 'Need User or UserID!' );
        return;
    }

    # get configuration for the full name order
    my $FirstnameLastNameOrder = $Self->{ConfigObject}->Get('FirstnameLastnameOrder') || 0;

    # check if result is cached
    if ( $Param{Valid} ) {
        $Param{Valid} = 1;
    }
    else {
        $Param{Valid} = 0;
    }
    if ( $Param{NoOutOfOffice} ) {
        $Param{NoOutOfOffice} = 1;
    }
    else {
        $Param{NoOutOfOffice} = 0;
    }

    my $CacheKey;
    if ( $Param{User} ) {
        $CacheKey
            = 'GetUserData::User::'
            . $Param{User} . '::'
            . $Param{Valid} . '::'
            . $FirstnameLastNameOrder . '::'
            . $Param{NoOutOfOffice};
    }
    else {
        $CacheKey
            = 'GetUserData::UserID::'
            . $Param{UserID} . '::'
            . $Param{Valid} . '::'
            . $FirstnameLastNameOrder . '::'
            . $Param{NoOutOfOffice};
    }

    # check cache
    my $Cache = $Self->{CacheInternalObject}->Get( Key => $CacheKey );
    return %{$Cache} if $Cache;

    # get initial data
    my @Bind;
    my $SQL = "SELECT $Self->{UserTableUserID}, $Self->{UserTableUser}, "
        . " title, first_name, last_name, $Self->{UserTableUserPW}, valid_id, "
        . " create_time, change_time FROM $Self->{UserTable} WHERE ";

    if ( $Param{User} ) {
        my $User = lc $Param{User};
        $SQL .= " $Self->{Lower}($Self->{UserTableUser}) = ?";
        push @Bind, \$User;
    }
    else {
        $SQL .= " $Self->{UserTableUserID} = ?";
        push @Bind, \$Param{UserID};
    }

    return if !$Self->{DBObject}->Prepare(
        SQL   => $SQL,
        Bind  => \@Bind,
        Limit => 1,
    );

    my %Data;
    while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
        $Data{UserID}        = $Row[0];
        $Data{UserLogin}     = $Row[1];
        $Data{UserTitle}     = $Row[2];
        $Data{UserFirstname} = $Row[3];
        $Data{UserLastname}  = $Row[4];
        $Data{UserPw}        = $Row[5];
        $Data{ValidID}       = $Row[6];
        $Data{CreateTime}    = $Row[7];
        $Data{ChangeTime}    = $Row[8];
    }

    # check data
    if ( !$Data{UserID} ) {
        if ( $Param{User} ) {
            $Self->{LogObject}->Log(
                Priority => 'notice',
                Message  => "Panic! No UserData for user: '$Param{User}'!!!",
            );
            return;
        }
        else {
            $Self->{LogObject}->Log(
                Priority => 'notice',
                Message  => "Panic! No UserData for user id: '$Param{UserID}'!!!",
            );
            return;
        }
    }

    # check valid, return if there is locked for valid users
    if ( $Param{Valid} ) {

        my $Hit = 0;

        for ( $Self->{ValidObject}->ValidIDsGet() ) {
            if ( $_ eq $Data{ValidID} ) {
                $Hit = 1;
            }
        }

        if ( !$Hit ) {

            # set cache
            $Self->{CacheInternalObject}->Set( Key => $CacheKey, Value => {} );
            return;
        }
    }

    # generate the full name and save it in the hash
    my $UserFullname;
    if ( $FirstnameLastNameOrder eq '0' ) {
        $UserFullname = $Data{UserFirstname} . ' '
            . $Data{UserLastname};
    }
    elsif ( $FirstnameLastNameOrder eq '1' ) {
        $UserFullname = $Data{UserLastname} . ', '
            . $Data{UserFirstname};
    }
    elsif ( $FirstnameLastNameOrder eq '2' ) {
        $UserFullname = $Data{UserFirstname} . ' '
            . $Data{UserLastname} . ' ('
            . $Data{UserLogin} . ')';
    }
    elsif ( $FirstnameLastNameOrder eq '3' ) {
        $UserFullname = $Data{UserLastname} . ', '
            . $Data{UserFirstname} . ' ('
            . $Data{UserLogin} . ')';
    }
    elsif ( $FirstnameLastNameOrder eq '4' ) {
        $UserFullname = '(' . $Data{UserLogin}
            . ') ' . $Data{UserFirstname}
            . ' ' . $Data{UserLastname};
    }
    elsif ( $FirstnameLastNameOrder eq '5' ) {
        $UserFullname = '(' . $Data{UserLogin}
            . ') ' . $Data{UserLastname}
            . ', ' . $Data{UserFirstname};
    }

    # save the generated fullname in the hash.
    $Data{UserFullname} = $UserFullname;

    # get preferences
    my %Preferences = $Self->GetPreferences( UserID => $Data{UserID} );

    # add last login timestamp
    if ( $Preferences{UserLastLogin} ) {
        $Preferences{UserLastLoginTimestamp} = $Self->{TimeObject}->SystemTime2TimeStamp(
            SystemTime => $Preferences{UserLastLogin},
        );
    }

    # check compat stuff
    if ( !$Preferences{UserEmail} ) {
        $Preferences{UserEmail} = $Data{UserLogin};
    }

    # out of office check
    if ( !$Param{NoOutOfOffice} ) {
        if ( $Preferences{OutOfOffice} ) {
            my $Time = $Self->{TimeObject}->SystemTime();
            my $Start
                = "$Preferences{OutOfOfficeStartYear}-$Preferences{OutOfOfficeStartMonth}-$Preferences{OutOfOfficeStartDay} 00:00:00";
            my $TimeStart = $Self->{TimeObject}->TimeStamp2SystemTime(
                String => $Start,
            );
            my $End
                = "$Preferences{OutOfOfficeEndYear}-$Preferences{OutOfOfficeEndMonth}-$Preferences{OutOfOfficeEndDay} 23:59:59";
            my $TimeEnd = $Self->{TimeObject}->TimeStamp2SystemTime(
                String => $End,
            );
            my $Till = int( ( $TimeEnd - $Time ) / 60 / 60 / 24 );
            my $TillDate
                = "$Preferences{OutOfOfficeEndYear}-$Preferences{OutOfOfficeEndMonth}-$Preferences{OutOfOfficeEndDay}";
            if ( $TimeStart < $Time && $TimeEnd > $Time ) {
                $Preferences{OutOfOfficeMessage} = "*** out of office till $TillDate/$Till d ***";
                $Data{UserLastname} .= ' ' . $Preferences{OutOfOfficeMessage};
            }
        }
    }

    # merge hash
    %Data = ( %Data, %Preferences );

    # add preferences defaults
    my $Config = $Self->{ConfigObject}->Get('PreferencesGroups');
    if ( $Config && ref $Config eq 'HASH' ) {

        for my $Key ( sort keys %{$Config} ) {

            # next if no default data exists
            next if !defined $Config->{$Key}->{DataSelected};

            # check if data is defined
            next if defined $Data{ $Config->{$Key}->{PrefKey} };

            # set default data
            $Data{ $Config->{$Key}->{PrefKey} } = $Config->{$Key}->{DataSelected};
        }
    }

    # set cache
    $Self->{CacheInternalObject}->Set( Key => $CacheKey, Value => \%Data );

    return %Data;
}

=item UserAdd()

to add new users

    my $UserID = $UserObject->UserAdd(
        UserFirstname => 'Huber',
        UserLastname  => 'Manfred',
        UserLogin     => 'mhuber',
        UserPw        => 'some-pass', # not required
        UserEmail     => 'email@example.com',
        ValidID       => 1,
        ChangeUserID  => 123,
    );

=cut

sub UserAdd {
    my ( $Self, %Param ) = @_;

    # check needed stuff
    for (qw(UserFirstname UserLastname UserLogin UserEmail ValidID ChangeUserID)) {
        if ( !$Param{$_} ) {
            $Self->{LogObject}->Log( Priority => 'error', Message => "Need $_!" );
            return;
        }
    }

    # check if a user with this login (username) already exits
    if ( $Self->UserLoginExistsCheck( UserLogin => $Param{UserLogin} ) ) {
        $Self->{LogObject}->Log(
            Priority => 'error',
            Message  => "A user with username '$Param{UserLogin}' already exists!"
        );
        return;
    }

    # check email address
    if (
        $Param{UserEmail}
        && !$Self->{CheckItemObject}->CheckEmail( Address => $Param{UserEmail} )
        )
    {
        $Self->{LogObject}->Log(
            Priority => 'error',
            Message  => "Email address ($Param{UserEmail}) not valid ("
                . $Self->{CheckItemObject}->CheckError() . ")!",
        );
        return;
    }

    # check password
    if ( !$Param{UserPw} ) {
        $Param{UserPw} = $Self->GenerateRandomPassword();
    }

    # sql
    return if !$Self->{DBObject}->Do(
        SQL => "INSERT INTO $Self->{UserTable} "
            . "(title, first_name, last_name, "
            . " $Self->{UserTableUser}, $Self->{UserTableUserPW}, "
            . " valid_id, create_time, create_by, change_time, change_by)"
            . " VALUES "
            . " (?, ?, ?, ?, ?, ?, current_timestamp, ?, current_timestamp, ?)",
        Bind => [
            \$Param{UserTitle}, \$Param{UserFirstname}, \$Param{UserLastname},
            \$Param{UserLogin}, \$Param{UserPw},        \$Param{ValidID},
            \$Param{ChangeUserID}, \$Param{ChangeUserID},
        ],
    );

    # get new user id
    my $UserLogin = lc $Param{UserLogin};
    return if !$Self->{DBObject}->Prepare(
        SQL => "SELECT $Self->{UserTableUserID} FROM $Self->{UserTable} "
            . " WHERE $Self->{Lower}($Self->{UserTableUser}) = ?",
        Bind  => [ \$UserLogin ],
        Limit => 1,
    );

    # fetch the result
    my $UserID;
    while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
        $UserID = $Row[0];
    }

    # check if user exists
    if ( !$UserID ) {
        $Self->{LogObject}->Log(
            Priority => 'notice',
            Message  => "Unable to create User: '$Param{UserLogin}' ($Param{ChangeUserID})!",
        );
        return;
    }

    # log notice
    $Self->{LogObject}->Log(
        Priority => 'notice',
        Message =>
            "User: '$Param{UserLogin}' ID: '$UserID' created successfully ($Param{ChangeUserID})!",
    );

    # set password
    $Self->SetPassword( UserLogin => $Param{UserLogin}, PW => $Param{UserPw} );

    # set email address
    $Self->SetPreferences( UserID => $UserID, Key => 'UserEmail', Value => $Param{UserEmail} );

    # delete cache
    $Self->{CacheInternalObject}->CleanUp();
    $Self->{CacheInternalObject}->CleanUp( OtherType => 'Group' );
	
	


#send email
my $ContentType = 'text/plain';
	
my $Sent = $Self->{SendmailObject}->Send(
From => $Self->{ConfigObject}->Get('NotificationSenderEmail'),
To => $Param{UserEmail},
Subject => 'OTRS account',
Charset => 'utf-8',
MimeType => $ContentType,
Body => 'Name und PW',
);

return $UserID;

 
}

=item UserUpdate()

to update users

    $UserObject->UserUpdate(
        UserID        => 4321,
        UserFirstname => 'Huber',
        UserLastname  => 'Manfred',
        UserLogin     => 'mhuber',
        UserPw        => 'some-pass', # not required
        UserEmail     => 'email@example.com',
        ValidID       => 1,
        ChangeUserID  => 123,
    );

=cut

sub UserUpdate {
    my ( $Self, %Param ) = @_;

    # check needed stuff
    for (qw(UserID UserFirstname UserLastname UserLogin ValidID ChangeUserID)) {
        if ( !$Param{$_} ) {
            $Self->{LogObject}->Log( Priority => 'error', Message => "Need $_!" );
            return;
        }
    }

    # check if a user with this login (username) already exits
    if ( $Self->UserLoginExistsCheck( UserLogin => $Param{UserLogin}, UserID => $Param{UserID} ) ) {
        $Self->{LogObject}->Log(
            Priority => 'error',
            Message  => "A user with username '$Param{UserLogin}' already exists!"
        );
        return;
    }

    # check email address
    if (
        $Param{UserEmail}
        && !$Self->{CheckItemObject}->CheckEmail( Address => $Param{UserEmail} )
        )
    {
        $Self->{LogObject}->Log(
            Priority => 'error',
            Message  => "Email address ($Param{UserEmail}) not valid ("
                . $Self->{CheckItemObject}->CheckError() . ")!",
        );
        return;
    }

    # update db
    return if !$Self->{DBObject}->Do(
        SQL => "UPDATE $Self->{UserTable} SET title = ?, first_name = ?, last_name = ?, "
            . " $Self->{UserTableUser} = ?, valid_id = ?, "
            . " change_time = current_timestamp, change_by = ? "
            . " WHERE $Self->{UserTableUserID} = ?",
        Bind => [
            \$Param{UserTitle}, \$Param{UserFirstname}, \$Param{UserLastname},
            \$Param{UserLogin}, \$Param{ValidID}, \$Param{ChangeUserID}, \$Param{UserID},
        ],
    );

    # log notice
    $Self->{LogObject}->Log(
        Priority => 'notice',
        Message  => "User: '$Param{UserLogin}' updated successfully ($Param{ChangeUserID})!",
    );

    # check pw
    if ( $Param{UserPw} ) {
        $Self->SetPassword( UserLogin => $Param{UserLogin}, PW => $Param{UserPw} );
    }

    # set email address
    $Self->SetPreferences(
        UserID => $Param{UserID},
        Key    => 'UserEmail',
        Value  => $Param{UserEmail}
    );

    # delete cache
    $Self->{CacheInternalObject}->CleanUp();
    $Self->{CacheInternalObject}->CleanUp( OtherType => 'Group' );

    return 1;
}

=item UserSearch()

to search users

    my %List = $UserObject->UserSearch(
        Search => '*some*', # also 'hans+huber' possible
        Valid  => 1, # not required
    );

    my %List = $UserObject->UserSearch(
        UserLogin => '*some*',
        Limit     => 50,
        Valid     => 1, # not required
    );

    my %List = $UserObject->UserSearch(
        PostMasterSearch => 'email@example.com',
        Valid            => 1, # not required
    );

=cut

sub UserSearch {
    my ( $Self, %Param ) = @_;

    my %Users;
    my $Valid = defined $Param{Valid} ? $Param{Valid} : 1;

    # check needed stuff
    if ( !$Param{Search} && !$Param{UserLogin} && !$Param{PostMasterSearch} ) {
        $Self->{LogObject}->Log(
            Priority => 'error',
            Message  => 'Need Search, UserLogin or PostMasterSearch!',
        );
        return;
    }

    # get like escape string needed for some databases (e.g. oracle)
    my $LikeEscapeString = $Self->{DBObject}->GetDatabaseFunction('LikeEscapeString');

    # build SQL string 1/2
    my $SQL    = "SELECT $Self->{UserTableUserID} ";
    my @Fields = qw(login first_name last_name);
    if (@Fields) {
        for my $Entry (@Fields) {
            $SQL .= ", $Entry";
        }
    }

    # build SQL string 2/2
    $SQL .= " FROM $Self->{UserTable} WHERE ";
    if ( $Param{Search} ) {
        $SQL .= $Self->{DBObject}->QueryCondition(
            Key   => \@Fields,
            Value => $Param{Search},
        ) . ' ';
    }
    elsif ( $Param{PostMasterSearch} ) {

        my %UserID = $Self->SearchPreferences(
            Key   => 'UserEmail',
            Value => $Param{PostMasterSearch},
        );

        for ( sort keys %UserID ) {
            my %User = $Self->GetUserData(
                UserID => $_,
                Valid  => $Param{Valid},
            );
            if (%User) {
                return %UserID;
            }
        }

        return;
    }
    elsif ( $Param{UserLogin} ) {
        $Param{UserLogin} =~ s/\*/%/g;
        $SQL .= " $Self->{Lower}($Self->{UserTableUser}) LIKE $Self->{Lower}('"
            . $Self->{DBObject}->Quote( $Param{UserLogin}, 'Like' ) . "') $LikeEscapeString";
    }

    # add valid option
    if ($Valid) {
        $SQL .= "AND valid_id IN (" . join( ', ', $Self->{ValidObject}->ValidIDsGet() ) . ")";
    }

    # get data
    return if !$Self->{DBObject}->Prepare(
        SQL => $SQL,
        Limit => $Self->{UserSearchListLimit} || $Param{Limit},
    );

    # fetch the result
    while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
        for ( 1 .. 8 ) {
            if ( $Row[$_] ) {
                $Users{ $Row[0] } .= $Row[$_] . ' ';
            }
        }
        $Users{ $Row[0] } =~ s/^(.*)\s(.+?\@.+?\..+?)(\s|)$/"$1" <$2>/;
    }

    return %Users;
}

=item SetPassword()

to set users passwords

    $UserObject->SetPassword(
        UserLogin => 'some-login',
        PW        => 'some-new-password'
    );

=cut

sub SetPassword {
    my ( $Self, %Param ) = @_;

    # check needed stuff
    if ( !$Param{UserLogin} ) {
        $Self->{LogObject}->Log( Priority => 'error', Message => 'Need UserLogin!' );
        return;
    }

    # get old user data
    my %User = $Self->GetUserData( User => $Param{UserLogin} );
    if ( !$User{UserLogin} ) {
        $Self->{LogObject}->Log( Priority => 'error', Message => 'No such User!' );
        return;
    }

    my $Pw = $Param{PW} || '';
    my $CryptedPw = '';

    # get crypt type
    my $CryptType = $Self->{ConfigObject}->Get('AuthModule::DB::CryptType') || 'sha2';

    # crypt plain (no crypt at all)
    if ( $CryptType eq 'plain' ) {
        $CryptedPw = $Pw;
    }

    # crypt with unix crypt
    elsif ( $CryptType eq 'crypt' ) {

        # encode output, needed by crypt() only non utf8 signs
        $Self->{EncodeObject}->EncodeOutput( \$Pw );
        $Self->{EncodeObject}->EncodeOutput( \$Param{UserLogin} );

        $CryptedPw = crypt( $Pw, $Param{UserLogin} );
    }

    # crypt with md5
    elsif ( $CryptType eq 'md5' || !$CryptType ) {

        # encode output, needed by unix_md5_crypt() only non utf8 signs
        $Self->{EncodeObject}->EncodeOutput( \$Pw );
        $Self->{EncodeObject}->EncodeOutput( \$Param{UserLogin} );

        $CryptedPw = unix_md5_crypt( $Pw, $Param{UserLogin} );
    }

    # crypt with sha1
    elsif ( $CryptType eq 'sha1' ) {

        my $SHAObject = Digest::SHA->new('sha1');

        # encode output, needed by sha1_hex() only non utf8 signs
        $Self->{EncodeObject}->EncodeOutput( \$Pw );

        $SHAObject->add($Pw);
        $CryptedPw = $SHAObject->hexdigest();
    }

    # bcrypt
    elsif ( $CryptType eq 'bcrypt' ) {

        if ( !$Self->{MainObject}->Require('Crypt::Eksblowfish::Bcrypt') ) {
            $Self->{LogObject}->Log(
                Priority => 'error',
                Message =>
                    "User: '$User{UserLogin}' tried to store password with bcrypt but 'Crypt::Eksblowfish::Bcrypt' is not installed!",
            );
            return;
        }

        my $Cost = 9;
        my $Salt = $Self->{MainObject}->GenerateRandomString( Length => 16 );

        # remove UTF8 flag, required by Crypt::Eksblowfish::Bcrypt
        $Self->{EncodeObject}->EncodeOutput( \$Pw );

        # calculate password hash
        my $Octets = Crypt::Eksblowfish::Bcrypt::bcrypt_hash(
            {
                key_nul => 1,
                cost    => 9,
                salt    => $Salt,
            },
            $Pw
        );

        # We will store cost and salt in the password string so that it can be decoded
        #   in future even if we use a higher cost by default.
        $CryptedPw = "BCRYPT:$Cost:$Salt:" . Crypt::Eksblowfish::Bcrypt::en_base64($Octets);
    }

    # crypt with sha256 as fallback
    else {

        my $SHAObject = Digest::SHA->new('sha256');

        # encode output, needed by sha256_hex() only non utf8 signs
        $Self->{EncodeObject}->EncodeOutput( \$Pw );

        $SHAObject->add($Pw);
        $CryptedPw = $SHAObject->hexdigest();
    }

    # update db
    my $UserLogin = lc $Param{UserLogin};
    return if !$Self->{DBObject}->Do(
        SQL => "UPDATE $Self->{UserTable} SET $Self->{UserTableUserPW} = ? "
            . " WHERE $Self->{Lower}($Self->{UserTableUser}) = ?",
        Bind => [ \$CryptedPw, \$UserLogin ],
    );

    # log notice
    $Self->{LogObject}->Log(
        Priority => 'notice',
        Message  => "User: '$Param{UserLogin}' changed password successfully!",
    );

    return 1;
}

=item UserLookup()

user login or id lookup

    my $UserLogin = $UserObject->UserLookup(
        UserID => 1,
    );

    my $UserID = $UserObject->UserLookup(
        UserLogin => 'some_user_login',
    );

=cut

sub UserLookup {
    my ( $Self, %Param ) = @_;

    # check needed stuff
    if ( !$Param{UserLogin} && !$Param{UserID} ) {
        $Self->{LogObject}->Log( Priority => 'error', Message => 'Need UserLogin or UserID!' );
        return;
    }

    if ( $Param{UserLogin} ) {

        # check cache
        my $CacheKey = 'UserLookup::ID::' . $Param{UserLogin};
        my $Cache = $Self->{CacheInternalObject}->Get( Key => $CacheKey );
        return $Cache if $Cache;

        # build sql query
        my $UserLogin = lc $Param{UserLogin};

        return if !$Self->{DBObject}->Prepare(
            SQL => "SELECT $Self->{UserTableUserID} FROM $Self->{UserTable} "
                . " WHERE $Self->{Lower}($Self->{UserTableUser}) = ?",
            Bind  => [ \$UserLogin ],
            Limit => 1,
        );

        # fetch the result
        my $ID;
        while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
            $ID = $Row[0];
        }

        if ( !$ID ) {
            $Self->{LogObject}->Log(
                Priority => 'error',
                Message  => "No UserID found for '$Param{UserLogin}'!",
            );
            return;
        }

        # set cache
        $Self->{CacheInternalObject}->Set( Key => $CacheKey, Value => $ID );

        return $ID;
    }

    else {

        # check cache
        my $CacheKey = 'UserLookup::Login::' . $Param{UserID};
        my $Cache = $Self->{CacheInternalObject}->Get( Key => $CacheKey );
        return $Cache if $Cache;

        # build sql query
        return if !$Self->{DBObject}->Prepare(
            SQL => "SELECT $Self->{UserTableUser} FROM $Self->{UserTable} "
                . " WHERE $Self->{UserTableUserID} = ?",
            Bind  => [ \$Param{UserID} ],
            Limit => 1,
        );

        # fetch the result
        my $Login;
        while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
            $Login = $Row[0];
        }

        if ( !$Login ) {
            $Self->{LogObject}->Log(
                Priority => 'error',
                Message  => "No UserLogin found for '$Param{UserID}'!",
            );
            return;
        }

        # set cache
        $Self->{CacheInternalObject}->Set( Key => $CacheKey, Value => $Login );

        return $Login;
    }
}

=item UserName()

get user name

    my $Name = $UserObject->UserName(
        UserLogin => 'some-login',
    );

    or

    my $Name = $UserObject->UserName(
        UserID => 123,
    );

=cut

sub UserName {
    my ( $Self, %Param ) = @_;

    my %User = $Self->GetUserData(%Param);

    return if !%User;
    return $User{UserFullname};
}

=item UserList()

return a hash with all users

    my %List = $UserObject->UserList(
        Type  => 'Short', # Short|Long, default Short
        Valid => 1,       # not required, default 0
    );

=cut

sub UserList {
    my ( $Self, %Param ) = @_;

    my $Type = $Param{Type} || 'Short';

    # set valid option
    my $Valid = $Param{Valid};
    if ( !defined $Valid || $Valid ) {
        $Valid = 1;
    }
    else {
        $Valid = 0;
    }

    # get configuration for the full name order
    my $FirstnameLastNameOrder = $Self->{ConfigObject}->Get('FirstnameLastnameOrder') || 0;

    # check cache
    my $CacheKey = 'UserList::' . $Type . '::' . $Valid
        . '::' . $FirstnameLastNameOrder;
    my $Cache = $Self->{CacheInternalObject}->Get(
        Key => $CacheKey,
    );
    return %{$Cache} if $Cache;

    my $SelectStr;
    if ( $Type eq 'Short' ) {
        $SelectStr = "$Self->{ConfigObject}->{DatabaseUserTableUserID}, "
            . " $Self->{ConfigObject}->{DatabaseUserTableUser}";
    }
    else {
        $SelectStr = "$Self->{ConfigObject}->{DatabaseUserTableUserID}, "
            . " last_name, first_name, "
            . " $Self->{ConfigObject}->{DatabaseUserTableUser}";
    }

    # sql query
    if ($Valid) {
        return if !$Self->{DBObject}->Prepare(
            SQL =>
                "SELECT $SelectStr FROM $Self->{ConfigObject}->{DatabaseUserTable} WHERE valid_id IN "
                . "( ${\(join ', ', $Self->{ValidObject}->ValidIDsGet())} )",
        );
    }
    else {
        return if !$Self->{DBObject}->Prepare(
            SQL => "SELECT $SelectStr FROM $Self->{ConfigObject}->{DatabaseUserTable}",
        );
    }

    # fetch the result
    my %UsersRaw;
    my %Users;
    while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
        $UsersRaw{ $Row[0] } = $Row[1];
    }

    if ( $Type eq 'Short' ) {
        %Users = %UsersRaw;
    }
    else {
        for my $CurrentUserID ( sort keys %UsersRaw ) {
            my $UserFullname = $Self->UserName( UserID => $CurrentUserID );
            $Users{$CurrentUserID} = $UserFullname;
        }
    }

    # check vacation option
    for my $UserID ( sort keys %Users ) {
        next if !$UserID;

        my %User = $Self->GetUserData(
            UserID => $UserID,
        );
        if ( $User{OutOfOfficeMessage} ) {
            $Users{$UserID} .= ' ' . $User{OutOfOfficeMessage};
        }
    }

    # set cache
    $Self->{CacheInternalObject}->Set(
        Key   => $CacheKey,
        Value => \%Users,
    );

    return %Users;
}

=item GenerateRandomPassword()

generate a random password

    my $Password = $UserObject->GenerateRandomPassword();

    or

    my $Password = $UserObject->GenerateRandomPassword(
        Size => 16,
    );

=cut

sub GenerateRandomPassword {
    my ( $Self, %Param ) = @_;

    # Generated passwords are eight characters long by default.
    my $Size = $Param{Size} || 8;

    my $Password = $Self->{MainObject}->GenerateRandomString(
        Length => $Size,
    );

    # Return the password.
    return $Password;
}

=item SetPreferences()

set user preferences

    $UserObject->SetPreferences(
        Key    => 'UserComment',
        Value  => 'some comment',
        UserID => 123,
    );

=cut

sub SetPreferences {
    my ( $Self, %Param ) = @_;

    # check needed stuff
    for (qw(Key UserID)) {
        if ( !$Param{$_} ) {
            $Self->{LogObject}->Log( Priority => 'error', Message => "Need $_!" );
            return;
        }
    }

    # get current setting
    my %User = $Self->GetUserData(
        UserID        => $Param{UserID},
        NoOutOfOffice => 1,
    );

    # no updated needed
    return 1
        if defined $User{ $Param{Key} }
        && defined $Param{Value}
        && $User{ $Param{Key} } eq $Param{Value};

    # delete cache
    my $Login = $Self->UserLookup( UserID => $Param{UserID} );
    $Self->{CacheInternalObject}->CleanUp();

    # set preferences
    return $Self->{PreferencesObject}->SetPreferences(%Param);
}

=item GetPreferences()

get user preferences

    my %Preferences = $UserObject->GetPreferences(
        UserID => 123,
    );

=cut

sub GetPreferences {
    my ( $Self, %Param ) = @_;

    return $Self->{PreferencesObject}->GetPreferences(%Param);
}

=item SearchPreferences()

search in user preferences

    my %UserList = $UserObject->SearchPreferences(
        Key   => 'UserEmail',
        Value => 'email@example.com',   # optional, limit to a certain value/pattern
    );

=cut

sub SearchPreferences {
    my $Self = shift;

    return $Self->{PreferencesObject}->SearchPreferences(@_);
}

=item TokenGenerate()

generate a random token

    my $Token = $UserObject->TokenGenerate(
        UserID => 123,
    );

=cut

sub TokenGenerate {
    my ( $Self, %Param ) = @_;

    # check needed stuff
    if ( !$Param{UserID} ) {
        $Self->{LogObject}->Log( Priority => 'error', Message => "Need UserID!" );
        return;
    }
    my $Token = $Self->{MainObject}->GenerateRandomString(
        Length => 15,
    );

    # save token in preferences
    $Self->SetPreferences(
        Key    => 'UserToken',
        Value  => $Token,
        UserID => $Param{UserID},
    );

    return $Token;
}

=item TokenCheck()

check password token

    my $Valid = $UserObject->TokenCheck(
        Token  => $Token,
        UserID => 123,
    );

=cut

sub TokenCheck {
    my ( $Self, %Param ) = @_;

    # check needed stuff
    if ( !$Param{Token} || !$Param{UserID} ) {
        $Self->{LogObject}->Log( Priority => 'error', Message => 'Need Token and UserID!' );
        return;
    }

    # get preferences token
    my %Preferences = $Self->GetPreferences(
        UserID => $Param{UserID},
    );

    # check requested vs. stored token
    if ( $Preferences{UserToken} && $Preferences{UserToken} eq $Param{Token} ) {

        # reset password token
        $Self->SetPreferences(
            Key    => 'UserToken',
            Value  => '',
            UserID => $Param{UserID},
        );

        # return true if token is valid
        return 1;
    }

    # return false if token is invalid
    return;
}

=item UserLoginExistsCheck()

return 1 if another user with this login (username) already exits

    $Exist = $UserObject->UserLoginExistsCheck(
        UserLogin => 'Some::UserLogin',
        UserID => 1, # optional
    );

=cut

sub UserLoginExistsCheck {
    my ( $Self, %Param ) = @_;
    return if !$Self->{DBObject}->Prepare(
        SQL =>
            "SELECT $Self->{UserTableUserID} FROM $Self->{UserTable} WHERE $Self->{UserTableUser} = ?",
        Bind => [ \$Param{UserLogin} ],
    );

    # fetch the result
    my $Flag;
    while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
        if ( !$Param{UserID} || $Param{UserID} ne $Row[0] ) {
            $Flag = 1;
        }
    }
    if ($Flag) {
        return 1;
    }
    return 0;
}

1;

=back

=head1 TERMS AND CONDITIONS

This software is part of the OTRS project (L<http://otrs.org/>).

This software comes with ABSOLUTELY NO WARRANTY. For details, see
the enclosed file COPYING for license information (AGPL). If you
did not receive this file, see L<http://www.gnu.org/licenses/agpl.txt>.

=cut
Greetings

Marco

Im running OTRS::ITSM 3.3.10 on Debian 7.4.
Locked