init III

Perl OTRS/Kernel/GenericInterface/Transport/HTTP/Test.pm

@@ -0,0 +1,273 @@
+# --
+# Copyright (C) 2001-2019 OTRS AG, https://otrs.com/
+# --
+# This software comes with ABSOLUTELY NO WARRANTY. For details, see
+# the enclosed file COPYING for license information (GPL). If you
+# did not receive this file, see https://www.gnu.org/licenses/gpl-3.0.txt.
+# --
+
+package Kernel::GenericInterface::Transport::HTTP::Test;
+
+use strict;
+use warnings;
+
+use HTTP::Request::Common;
+use LWP::UserAgent;
+use LWP::Protocol;
+
+# prevent 'Used once' warning for Kernel::OM
+use Kernel::System::ObjectManager;
+
+our $ObjectManagerDisabled = 1;
+
+=head1 NAME
+
+Kernel::GenericInterface::Transport::HTTP::Test - GenericInterface network transport interface for testing purposes
+
+=head1 PUBLIC INTERFACE
+
+=head2 new()
+
+usually, you want to create an instance of this
+by using Kernel::GenericInterface::Transport->new();
+
+    use Kernel::GenericInterface::Transport;
+
+    my $TransportObject = Kernel::GenericInterface::Transport->new(
+
+        TransportConfig => {
+            Type => 'HTTP::Test',
+            Config => {
+                Fail => 0,  # 0 or 1
+            },
+        },
+    );
+
+In the config parameter 'Fail' you can tell the transport to simulate
+failed network requests. If 'Fail' is set to 0, the transport will return
+the query string of the requests as return data (see L<RequesterPerformRequest>
+for an example);
+
+=cut
+
+sub new {
+    my ( $Type, %Param ) = @_;
+
+    my $Self = {};
+    bless( $Self, $Type );
+
+    for my $Needed (qw( DebuggerObject TransportConfig)) {
+        $Self->{$Needed} = $Param{$Needed} || return {
+            Success      => 0,
+            ErrorMessage => "Got no $Needed!"
+        };
+    }
+
+    return $Self;
+}
+
+=head2 ProviderProcessRequest()
+
+this will read the incoming HTTP request via CGI and
+return the HTTP parameters in the data hash.
+
+=cut
+
+sub ProviderProcessRequest {
+    my ( $Self, %Param ) = @_;
+
+    if ( $Self->{TransportConfig}->{Config}->{Fail} ) {
+
+        return {
+            Success      => 0,
+            ErrorMessage => "HTTP status code: 500",
+            Data         => {},
+        };
+    }
+
+    my $ParamObject = $Kernel::OM->Get('Kernel::System::Web::Request');
+
+    my %Result;
+    for my $ParamName ( $ParamObject->GetParamNames() ) {
+        $Result{$ParamName} = $ParamObject->GetParam( Param => $ParamName );
+    }
+
+    # special handling for empty post request
+    if ( scalar keys %Result == 1 && exists $Result{POSTDATA} && !$Result{POSTDATA} ) {
+        %Result = ();
+    }
+
+    if ( !%Result ) {
+
+        return $Self->{DebuggerObject}->Error(
+            Summary => 'No request data found.',
+        );
+    }
+
+    return {
+        Success   => 1,
+        Data      => \%Result,
+        Operation => 'test_operation',
+    };
+}
+
+=head2 ProviderGenerateResponse()
+
+this will generate a query string from the passed data hash
+and generate an HTTP response with this string as the body.
+This response will be printed so that the web server will
+send it to the client.
+
+=cut
+
+sub ProviderGenerateResponse {
+    my ( $Self, %Param ) = @_;
+
+    if ( $Self->{TransportConfig}->{Config}->{Fail} ) {
+
+        return {
+            Success      => 0,
+            ErrorMessage => 'Test response generation failed',
+        };
+    }
+
+    my $Response;
+
+    if ( !$Param{Success} ) {
+        $Response = HTTP::Response->new( 500 => ( $Param{ErrorMessage} || 'Internal Server Error' ) );
+        $Response->protocol('HTTP/1.0');
+        $Response->content_type("text/plain; charset=UTF-8");
+        $Response->date(time);
+    }
+    else {
+
+        # generate a request string from the data
+        my $Request = HTTP::Request::Common::POST( 'http://testhost.local/', Content => $Param{Data} );
+
+        $Response = HTTP::Response->new( 200 => "OK" );
+        $Response->protocol('HTTP/1.0');
+        $Response->content_type("text/plain; charset=UTF-8");
+        $Response->add_content_utf8( $Request->content() );
+        $Response->date(time);
+    }
+
+    $Self->{DebuggerObject}->Debug(
+        Summary => 'Sending HTTP response',
+        Data    => $Response->as_string(),
+    );
+
+    # now send response to client
+    print STDOUT $Response->as_string();
+
+    return {
+        Success => 1,
+    };
+}
+
+=head2 RequesterPerformRequest()
+
+in Fail mode, returns error status. Otherwise, returns the
+query string generated out of the data for the HTTP response.
+
+    my $Result = $TransportObject->RequesterPerformRequest(
+        Data => {
+            A => 'A',
+            b => 'b',
+        },
+    );
+
+Returns
+
+    $Result = {
+        Success => 1,
+        Data => {
+            ResponseData => 'A=A&b=b',
+        },
+    };
+
+=cut
+
+sub RequesterPerformRequest {
+    my ( $Self, %Param ) = @_;
+
+    if ( $Self->{TransportConfig}->{Config}->{Fail} ) {
+
+        return {
+            Success      => 0,
+            ErrorMessage => "HTTP status code: 500",
+            Data         => {},
+        };
+    }
+
+    # use custom protocol handler to avoid sending out real network requests
+    LWP::Protocol::implementor(
+        testhttp => 'Kernel::GenericInterface::Transport::HTTP::Test::CustomHTTPProtocol'
+    );
+    my $UserAgent = LWP::UserAgent->new();
+    my $Response  = $UserAgent->post( 'testhttp://localhost.local/', Content => $Param{Data} );
+
+    return {
+        Success => 1,
+        Data    => {
+            ResponseContent => $Response->content(),
+        },
+    };
+}
+
+=begin Internal:
+
+=cut
+
+=head1 NAME
+
+Kernel::GenericInterface::Transport::HTTP::Test::CustomHTTPProtocol
+
+=head1 DESCRIPTION
+
+This package is used to handle the custom HTTP requests of
+Kernel::GenericInterface::Transport::HTTP::Test.
+The requests are immediately answered with a response, without
+sending them out to the network.
+
+=cut
+
+package Kernel::GenericInterface::Transport::HTTP::Test::CustomHTTPProtocol;    ## no critic
+
+use parent qw(LWP::Protocol);
+
+sub new {
+    my $Class = shift;
+
+    return $Class->SUPER::new(@_);
+}
+
+sub request {                                                                   ## no critic
+    my $Self = shift;
+
+    my ( $Request, $Proxy, $Arg, $Size, $Timeout ) = @_;
+
+    my $Response = HTTP::Response->new( 200 => "OK" );
+    $Response->protocol('HTTP/1.0');
+    $Response->content_type("text/plain; charset=UTF-8");
+    $Response->add_content_utf8( $Request->content() );
+    $Response->date(time);
+
+    #print $Request->as_string();
+    #print $Response->as_string();
+
+    return $Response;
+}
+
+1;
+
+=end Internal:
+
+=head1 TERMS AND CONDITIONS
+
+This software is part of the OTRS project (L<https://otrs.org/>).
+
+This software comes with ABSOLUTELY NO WARRANTY. For details, see
+the enclosed file COPYING for license information (GPL). If you
+did not receive this file, see L<https://www.gnu.org/licenses/gpl-3.0.txt>.
+
+=cut