File Coverage

blib/lib/Plack/App/GraphEasy.pm

Criterion	Covered	Total	%
statement	50	64	78.1
branch	9	18	50.0
condition	3	8	37.5
subroutine	12	13	92.3
pod	1	1	100.0
total	75	104	72.1

line	stmt	bran	cond	sub	pod	time	code
1							package Plack::App::GraphEasy;
2	2			2		74974	use strict;
	2					5
	2					51
3	2			2		11	use warnings;
	2					4
	2					59
4	2			2		739	use parent qw/Plack::Component/;
	2					295
	2					11
5	2			2		31024	use Graph::Easy;
	2					246809
	2					64
6	2			2		2024	use Graph::Easy::Parser;
	2					16354
	2					83
7	2			2		1746	use Plack::Request;
	2					117279
	2					77
8	2			2		1758	use HTTP::Status qw//;
	2					9527
	2					71
9	2					15	use Plack::Util::Accessor qw/
10							stderr
11							timeout
12	2			2		1661	/;
	2					500
13
14							our $VERSION = '0.01';
15
16							our $FORM_HTML = <<'_HTML_';
17
18
19
20							GraphEasy
21
22
23							Manual: http://bloodgate.com/perl/graph/manual/
24
25
26
27
28
29
30
31
32
60
61
62							_HTML_
63
64							sub call {
65	5			5	1	35806	my ($self, $env) = @_;
66
67	5					43	my $req = Plack::Request->new($env);
68	5					60	my $method = $req->method;
69
70	5	100				57	if ($method eq 'GET') {
		50
71	1					4	return $self->_put_form($req);
72							}
73							elsif ($method eq 'POST') {
74	4					15	return $self->_put_graph($req);
75							}
76
77	0					0	return $self->_return_status(404);
78							}
79
80							sub _put_form {
81	1			1		4	my ($self, $req) = @_;
82
83	1					6	my $content = sprintf(
84							$FORM_HTML,
85							$req->path,
86							);
87
88	1					16	return $self->_return_success($content, 'text/html; charset=UTF-8');
89							}
90
91							sub _put_graph {
92	4			4		76	my ($self, $req) = @_;
93
94	4	100				20	my $input_text = $req->param('text')
95							or return $self->_return_success('no text');
96	3					1534	$input_text =~ s/^[\s\t\r\n]+//g;
97	3					15	$input_text =~ s/[\s\t\r\n]+$//g;
98
99	3	50				14	if ($input_text !~ m![\]\}]$!) {
100	0					0	return $self->_return_success('wrong text');
101							}
102
103	3					35	my $parser = Graph::Easy::Parser->new;
104	3					136	my $graph = $parser->from_text($input_text);
105	3	50				5085	if (!$graph) {
106	0					0	return $self->_return_status(500, "Error: something wrong");
107							}
108	3	50				15	if ($parser->error) {
109	0					0	return $self->_return_success("Error: ". $parser->error);
110							}
111
112	3		50			46	$graph->timeout($self->timeout \|\| 10);
113
114	3					96	my $result;
115	3					5	eval {
116	3					12	$result = $graph->as_ascii;
117							};
118	3	50				40052	if (my $e = $@) {
119	0	0				0	if ($e =~ m!layout did not finish in time!) {
120	0					0	return $self->_return_success("timeout");
121							}
122	0					0	return $self->_return_status(500, "Error: $e");
123							}
124
125	3					16	return $self->_return_success($result);
126							}
127
128							sub _return_success {
129	5			5		695	my ($self, $msg, $content_type) = @_;
130
131							return [
132	5		100			339	200,
133							[
134							'Content-Type' => $content_type \|\| 'text/plain',
135							'Content-Length' => length $msg
136							],
137							[$msg]
138							];
139							}
140
141							sub _return_status {
142	0			0			my $self = shift;
143	0		0				my $status_code = shift \|\| 500;
144	0		0				my $err = shift \|\| '';
145
146	0						my $msg = HTTP::Status::status_message($status_code);
147
148	0	0					if ($self->stderr) {
149	0						print STDERR "$msg\n$err\n";
150							}
151
152							return [
153	0						$status_code,
154							[
155							'Content-Type' => 'text/plain',
156							'Content-Length' => length $msg
157							],
158							[$msg]
159							];
160							}
161
162							1;
163
164							__END__