File Coverage

blib/lib/Plack/App/DAIA/Validator.pm
Criterion Covered Total %
statement 15 15 100.0
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 20 20 100.0


line stmt bran cond sub pod time code
1 1     1   5609 use strict;
  1         1  
  1         26  
2 1     1   3 use warnings;
  1         1  
  1         43  
3             package Plack::App::DAIA::Validator;
4             {
5             $Plack::App::DAIA::Validator::VERSION = '0.45_1';
6             }
7             #ABSTRACT: DAIA validator and converter
8              
9 1     1   691 use CGI qw(:standard);
  1         21538  
  1         7  
10 1     1   1816 use Encode;
  1         2  
  1         96  
11              
12 1     1   3 use parent 'Plack::App::DAIA';
  1         1  
  1         8  
13             use Plack::Util::Accessor qw(xsd xslt warnings);
14              
15             our ($FORMATS);
16             BEGIN {
17             my %f = DAIA->formats;
18             $FORMATS = { map { $_ => $_ } keys %f };
19             $FORMATS->{html} = 'DAIA/HTML';
20             $FORMATS->{json} = 'DAIA/JSON';
21             $FORMATS->{xml} = 'DAIA/XML';
22             $FORMATS->{rdfjson} = 'DAIA/RDF (JSON)';
23             $FORMATS->{turtle} = 'DAIA/RDF (Turtle)' if $FORMATS->{turtle};
24             $FORMATS->{ntriples} = 'DAIA/RDF (NTriples)' if $FORMATS->{ntriples};
25             $FORMATS->{rdfxml} = 'DAIA/RDF (RDF/XML)' if $FORMATS->{rdfxml};
26             foreach (qw(dot svg)) {
27             $FORMATS->{$_} = "DAIA/RDF graph ($_)" if $FORMATS->{$_};
28             }
29             }
30              
31             sub call {
32             my ($self, $env) = @_;
33             my $req = Plack::Request->new($env);
34              
35             my $msg = "";
36             my $error = "";
37             my $url = $req->param('url') || '';
38             my $data = $req->param('data') || '';
39             #eval{ $data = Encode::decode_utf8( $data ); }; # icoming raw data is UTF-8
40              
41             my $eurl = $url; # url_encode
42             $eurl =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
43              
44             my $xsd = $self->xsd;
45              
46             my $informat = lc($req->param('in'));
47             my $outformat = lc($req->param('out')) || lc($req->param('format')) || 'html';
48              
49             my $callback = $req->param('callback') || "";
50             $callback = "" unless $callback =~ /^[a-z][a-z0-9._\[\]]*$/i;
51              
52             my @daiaobjs;
53              
54             # parse DAIA
55             if ( $data ) {
56             @daiaobjs = eval { DAIA->parse( data => $data, format => $informat ) };
57             } elsif( $url ) {
58             @daiaobjs = eval { DAIA->parse( file => $url, format => $informat ) };
59             }
60             if ($@) {
61             $error = $@;
62             $error =~ s/DAIA::([A-Z]+::)?[a-z_]+\(\):| at .* line.*//ig;
63             }
64              
65             my $daia;
66             if (@daiaobjs > 1) {
67             $error = "Found multiple DAIA elements (".(scalar @daiaobjs)."), but expected one";
68             } elsif (@daiaobjs) {
69             $daia = shift @daiaobjs;
70             }
71              
72             if ( $FORMATS->{$outformat} and $outformat ne 'html' ) {
73             $daia = DAIA::Response->new() unless $daia;
74             $daia->addMessage( $error, errno => 500, lang => 'en' ) if $error;
75             return $self->as_psgi( 200, $daia, $outformat, $req->param('callback') );
76             } elsif ( $outformat ne 'html' ) {
77             $error = "Unknown output format - using HTML instead";
78             }
79              
80             # HTML output
81             $error = "<div class='error'>".escapeHTML($error)."!</div>" if $error;
82             if ( $url and not $data ) {
83             $msg = "Data was fetched from URL " . a({href=>$url},escapeHTML($url));
84             $msg .= " (" . a({href=>'#result'}, "result...") . ")" if $daia;
85             $msg = div({class=>'msg'},$msg);
86             # $msg .= div({class=>'msg'},"Use ".
87             # a({href=>url()."?url=$eurl"},'this URL') .
88             # " to to directly pass the URL to this script.");
89             }
90              
91             my $html = <<HTML;
92             <html>
93             <head>
94             <title>DAIA Validator</title>
95             <meta http-equiv="Content-Type" content="text/html;charset=utf-8" />
96             <style>
97             body { font-family: arial, sans-serif;}
98             h1, p { margin: 0; text-align: center; }
99             h2 { margin-top: 2px; border-bottom: 1px dotted #666;}
100             form { margin: 1em; border: 1px solid #333; }
101             fieldset { border: 1px solid #fff; }
102             label, .error, .msg { font-weight: bold; }
103             .submit, .error { font-size: 120%; }
104             .error { color: #A00; margin: 1em; }
105             .msg { color: #0A0; margin: 1em; }
106             .footer { font-size: small; margin: 1em; }
107             #result { border: 1px dotted #666; margin: 1em; padding: 0.5em; }
108             </style>
109             </head>
110             <body>
111             <h1 id='top'>DAIA Converter</h1>
112             <p>Convert and Validate <a href="http://purl.org/NET/DAIA">DAIA response format</a></p>
113             <form method="post" accept-charset="utf-8" action="">
114             HTML
115              
116             $html .= $msg . $error .
117             fieldset(label('Input: ',
118             popup_menu('in',['','json','xml'],'',
119             {''=>'Guess','json'=>'DAIA/JSON','xml'=>'DAIA/XML'})
120             )).
121             fieldset('either', label('URL: ', textfield(-name=>'url', -size=>70, -value => $url)),
122             'or', label('Data:'),
123             textarea( -name=>'data', -rows=>20, -cols=>80, -value => $data),
124             ).
125             fieldset(
126             label('Output: ',
127             popup_menu('out',
128             [ sort { $FORMATS->{$a} cmp $FORMATS->{$b} } keys %$FORMATS ],
129             $outformat, $FORMATS )
130             ), '&#xA0;',
131             label('JSONP Callback: ', textfield(-name=>'callback',-value=>$callback))
132             ).
133             fieldset('<input type="submit" value="Convert" class="submit" />')
134             ;
135             my $has_graphviz = grep /^(svg|dot)$/, keys %$FORMATS;
136             if ( $has_graphviz && $url && !$data) {
137             $html .= "<fieldset>See RDF graph <a href=\"?url=$eurl&format=svg\">as SVG</a></fieldset>";
138             }
139             $html .= '</form>';
140              
141             if ($daia) {
142             if ( $informat eq 'xml' or DAIA::guess($data) eq 'xml' ) {
143             # TODO: move this into module DAIA (validate option when parsing)
144             my ($schema, $parser);
145             eval { require XML::LibXML; };
146             if ( $@ ) {
147             $error = "XML::LibXML::Schema required to validate DAIA/XML";
148             } elsif($xsd) {
149             $parser = XML::LibXML->new;
150             $schema = eval { XML::LibXML::Schema->new( location => $xsd ); };
151             if ($schema) {
152             my $doc = $parser->parse_string( $data );
153             eval { $schema->validate($doc) };
154             $error = "DAIA/XML not valid but parseable: " . $@ if $@;
155             } else {
156             $error = "Could not load XML Schema - validating was skipped";
157             }
158             }
159             if ( $error ) {
160             $html .= "<p class='error'>".escapeHTML($error)."</p>";
161             } else {
162             $html .= p("DAIA/XML valid according to ".a({href=>$xsd},"this XML Schema"));
163             }
164             } else {
165             $html .= p("validation is rather lax so the input may be invalid - but it was parseable");
166             }
167             $html .= "<div id='result'>";
168             my ($pjson, $pxml, $pttl) = ("","","");
169             if (!$data && $url) {
170             $pjson = $pxml = $pttl = "?callback=$callback&url=$eurl";
171             $pjson = " (<a href='$pjson&format=json'>get via proxy</a>)";
172             $pxml = " (<a href='$pxml&format=xml'>get via proxy</a>)";
173             #$pttl = " (<a href='$pttl&format=turtle'>get via proxy</a>)";
174             }
175             $html .= "<h2 id='json'>Result in DAIA/JSON$pjson <a href='#top'>&#x2191;</a> <a href='#xml'>&#x2193;</a></h2>";
176             $html .= pre(escapeHTML( encode('utf8',$daia->json( $callback ) )));
177             $html .= "<h2 id='xml'>Result in DAIA/XML$pxml <a href='#json'>&#x2191;</a></h2>";
178             $html .= pre(escapeHTML( encode('utf8',$daia->xml( xmlns => 1 ) )));
179             if ($FORMATS->{turtle}) {
180             $html .= "<h2 id='ttl'>Result in DAIA/RDF (Turtle) <a href='#json'>&#x2191;</a></h2>";
181             my $ttl = $daia->serialize('turtle');
182             $html .= pre(escapeHTML( encode('utf8', $ttl )));
183             }
184             $html .= "</div>";
185             }
186              
187             $html .= "<div class='footer'>Based on ";
188             $html .= join ' and ', map {
189             "<a href='http://search.cpan.org/perldoc?$_'>$_</a> " . ($_->VERSION || '');
190             } qw(Plack::App::DAIA::Validator DAIA);
191             $html .= <<HTML;
192             . Visit the <a href="http://github.com/gbv/daia/">DAIA project at github</a> for sources and details.
193             </div></body>
194             HTML
195              
196             return [ 200, [ 'Content-Type' => 'text/html; charset=utf-8' ], [ $html ] ];
197             }
198              
199             1;
200              
201              
202             __END__
203             =pod
204              
205             =head1 NAME
206              
207             Plack::App::DAIA::Validator - DAIA validator and converter
208              
209             =head1 VERSION
210              
211             version 0.45_1
212              
213             =head1 SYNOPSIS
214              
215             use Plack::Builder;
216             use Plack::App::DAIA::Validator;
217              
218             builder {
219             enable 'JSONP';
220             Plack::App::DAIA::Validator->new(
221             xsd => $location_of_daia_xsd,
222             xslt => "/daia.xsl",
223             warnings => 1
224             );
225             };
226              
227             =head1 DESCRIPTION
228              
229             This module provides a simple L<DAIA> validator and converter as PSGI web
230             application.
231              
232             To support fetching from DAIA Servers via HTTPS you might need to install
233             L<LWP::Protocol::https> version 6.02 or higher.
234              
235             =head1 CONFIGURATION
236              
237             All configuration parameters (C<xsd>, C<xslt>, and C<warnings>) are optional.
238              
239             =head1 AUTHOR
240              
241             Jakob Voss
242              
243             =head1 COPYRIGHT AND LICENSE
244              
245             This software is copyright (c) 2012 by Jakob Voss.
246              
247             This is free software; you can redistribute it and/or modify it under
248             the same terms as the Perl 5 programming language system itself.
249              
250             =cut
251