dumper.psgi

#!/usr/bin/env perl
use Plack::Request;
use Plack::Response;
use Const::Fast;
use Path::Class;
use XML::Twig;
use LWP::UserAgent;
use Carp qw/confess/;
use utf8;
use Encode qw/encode decode/;
use Plack::Builder;
use Plack::App::Directory;

const my $URI => $ENV{DEVEL} ? 'http://poc.r114.co.kr/smartphone/smartphone.asp' : 'http://m.r114.co.kr/smartphone/smartphone.asp';
#const my $URI => 'http://localhost:3000';
print "$URI\n";
const my $LOG_DIR => dir('log');
const my $PRETTY_XML_PARAMS => [qw(none nsgmls nice indented record record_c)];
const my $LATEST => file('latest.log');

sub error_quit {
	my $message = shift;
	return [ 500, [ "Content-Type" => "text/plain" ], [ $message ] ];
}

sub pretty_xml {
	my $xml = shift;
	my $format = $PRETTY_XML_PARAMS->[3];
	my $twig= new XML::Twig;
	$twig->set_pretty_print($PRETTY_XML_PARAMS->[3]);
	eval { $twig->parse($xml) };
	if ($@) {
		print STDERR "\e[7m$@\e[m\n";
		return $xml;
	} else {
		return $twig->sprint;
	}
}

sub url_encode {
    my ($url) = @_;
    $url =~ s/([^A-Za-z0-9:\/?&]=)/sprintf("%%%02X", ord($1))/seg;
    return $url;
}

my $app = sub {
    my $env = shift;
	error_quit("operation not permitted, only allow POST method instead $env{REQUEST_METHOD}") if $env{REQUEST_METHOD} ne 'POST';
    my $req = Plack::Request->new($env);
	my $xmlData = $req->param('xmlData') || '';
	error_quit("'xmlData' param required") if $xmlData eq '';
	my ($id) = $xmlData =~ m{<xml-DATA id="(.*?)"}s;
	error_quit('required id attribute in xml-DATA tag: <xml-DATA id=">>> id <<<" ...') unless $id;
	my $log = file($LOG_DIR, $id);
	my $fh = $log->open('w') or confess "Couldn't open $log\n";
	unlink $LATEST if -e $LATEST;
	eval { symlink $log, $LATEST };
	if ($@) {
		warn "Couldn't synlink $LATEST: $@\n";
	}
	# 요청 메세지 로깅 - xmlData
	print $fh "[REQ] " . "=" x 50, "\n";
	print $fh pretty_xml($xmlData);
	# Request - [Deployment|Development]
#	my $request  = HTTP::Request->new(POST => $URI);
#	$request->content_type('application/x-www-form-urlencoded');
#	$request->content('xmlData=' . encode('utf8', url_encode($xmlData)));
#	my $response = $ua->request($request);
	my $ua       = LWP::UserAgent->new;
	my $response = $ua->post($URI, [
		'xmlData' => $xmlData, 
	]);
	# Response check
	confess STDERR $response->status_line, "\n" unless $response->is_success;
	# 응답 메세지 로깅
	print $fh "[RES] " . "=" x 50, "\n";
	print $fh pretty_xml($response->content);
	undef $fh;
	# Response
    my $res = $req->new_response(200);
	#$res->content_type('text/plain');
    $res->content_type('text/xml');
    $res->body($response->content);
    $res->finalize;
};

builder {
	mount '/log', builder { Plack::App::Directory->new({ root => 'log' }) };
	mount '/trace', $app;
}

=pod

=head1 NAME

F<dumper.pl>

=head1 SYNOPSIS

	$ plackup dumper.pl                   # Request to Deployment Server  - http://m.r114.co.kr/smartphone/smartphone.asp
	$ DEVEL=1 plackup dumper.pl -p 5001   # Request to Development Server - http://poc.r114.co.kr/smartphone/smartphone.asp

=head1 DESCRIPTION

부동산114 POST xml 메세지를 Dump 하기 위한 proxy - F<dumper.pl>

=cut

echo.psgi

use Plack::Request;
use Plack::Response;

sub {
    my $env = shift;
    my $req = Plack::Request->new($env);
    return [ 200, [ "Content-Type" => "text/plain", "Content-Length" => length $req->param('xmlData') ], [ $req->param('xmlData') ] ];
};

t.pl

#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use Encode qw/encode decode/;
use HTTP::Request;
use HTTP::Response;
use LWP::UserAgent;

my $xml = join '', <DATA>;

my $request  = HTTP::Request->new(POST => 'http://localhost:5000/');
   $request->content_type('application/x-www-form-urlencoded');
   $request->content('xmlData=' . encode('utf8', $xml));
my $ua       = LWP::UserAgent->new;
my $response = $ua->request($request);
# Response check
confess STDERR $response->status_line, "\n" unless $response->is_success;
print $response->content, "\n";

sub url_encode {
    my $url = @_;
    $url =~ s/([^A-Za-z0-9:\/?&]=)/sprintf("%%%02X", ord($1))/seg;
    return $url;
}

__DATA__
<xml-DATA id="P-200"><UID>100</UID></xml-DATA>