| blib/lib/Plack/App/DAIA/Validator.pm | |||
|---|---|---|---|
| Criterion | Covered | Total | % |
| statement | 21 | 21 | 100.0 |
| branch | n/a | ||
| condition | n/a | ||
| subroutine | 7 | 7 | 100.0 |
| pod | n/a | ||
| total | 28 | 28 | 100.0 |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | 2 | 2 | 87352 | use strict; | |||
| 2 | 5 | ||||||
| 2 | 96 | ||||||
| 2 | 2 | 2 | 10 | use warnings; | |||
| 2 | 5 | ||||||
| 2 | 230 | ||||||
| 3 | package Plack::App::DAIA::Validator; | ||||||
| 4 | #ABSTRACT: DAIA validator and converter | ||||||
| 5 | our $VERSION = '0.55'; #VERSION | ||||||
| 6 | 2 | 2 | 4598 | use CGI qw(:standard); | |||
| 2 | 34258 | ||||||
| 2 | 19 | ||||||
| 7 | 2 | 2 | 8414 | use Encode; | |||
| 2 | 22763 | ||||||
| 2 | 213 | ||||||
| 8 | 2 | 2 | 1797 | use File::ShareDir qw(dist_dir); | |||
| 2 | 15349 | ||||||
| 2 | 175 | ||||||
| 9 | 2 | 2 | 1824 | use File::Spec::Functions qw(catfile); | |||
| 2 | 1650 | ||||||
| 2 | 162 | ||||||
| 10 | |||||||
| 11 | 2 | 2 | 16 | use parent 'Plack::App::DAIA'; | |||
| 2 | 3 | ||||||
| 2 | 20 | ||||||
| 12 | use Plack::Util::Accessor qw(xsd xslt warnings); | ||||||
| 13 | |||||||
| 14 | our $HAS_LIBXML = 0; | ||||||
| 15 | |||||||
| 16 | our ($FORMATS); | ||||||
| 17 | BEGIN { | ||||||
| 18 | my %f = DAIA->formats; | ||||||
| 19 | $FORMATS = { map { $_ => $_ } keys %f }; | ||||||
| 20 | $FORMATS->{html} = 'DAIA/HTML'; | ||||||
| 21 | $FORMATS->{json} = 'DAIA/JSON'; | ||||||
| 22 | $FORMATS->{xml} = 'DAIA/XML'; | ||||||
| 23 | $FORMATS->{rdfjson} = 'DAIA/RDF (JSON)'; | ||||||
| 24 | $FORMATS->{turtle} = 'DAIA/RDF (Turtle)' if $FORMATS->{turtle}; | ||||||
| 25 | $FORMATS->{ntriples} = 'DAIA/RDF (NTriples)' if $FORMATS->{ntriples}; | ||||||
| 26 | $FORMATS->{rdfxml} = 'DAIA/RDF (RDF/XML)' if $FORMATS->{rdfxml}; | ||||||
| 27 | foreach (qw(dot svg)) { | ||||||
| 28 | $FORMATS->{$_} = "DAIA/RDF graph ($_)" if $FORMATS->{$_}; | ||||||
| 29 | } | ||||||
| 30 | } | ||||||
| 31 | |||||||
| 32 | sub init { | ||||||
| 33 | my $self = shift; | ||||||
| 34 | if ($self->xsd) { | ||||||
| 35 | ## no critic | ||||||
| 36 | eval "use XML::LibXML"; | ||||||
| 37 | $HAS_LIBXML = !$@; | ||||||
| 38 | } | ||||||
| 39 | } | ||||||
| 40 | |||||||
| 41 | sub call { | ||||||
| 42 | my ($self, $env) = @_; | ||||||
| 43 | my $req = Plack::Request->new($env); | ||||||
| 44 | |||||||
| 45 | # serve parts of the XSLT client | ||||||
| 46 | my $res = $self->call_client($req); | ||||||
| 47 | return $res if $res; | ||||||
| 48 | |||||||
| 49 | my $msg = ""; | ||||||
| 50 | my $error = ""; | ||||||
| 51 | my $url = $req->param('url') || ''; | ||||||
| 52 | my $data = $req->param('data') || ''; | ||||||
| 53 | #eval{ $data = Encode::decode_utf8( $data ); }; # icoming raw data is UTF-8 | ||||||
| 54 | |||||||
| 55 | my $eurl = $url; # url_encode | ||||||
| 56 | $eurl =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg; | ||||||
| 57 | |||||||
| 58 | my $xsd = $self->xsd; | ||||||
| 59 | |||||||
| 60 | my $informat = lc($req->param('in') || ''); | ||||||
| 61 | my $outformat = lc($req->param('out') || $req->param('format') || 'html'); | ||||||
| 62 | |||||||
| 63 | my $callback = $req->param('callback') || ""; | ||||||
| 64 | $callback = "" unless $callback =~ /^[a-z][a-z0-9._\[\]]*$/i; | ||||||
| 65 | |||||||
| 66 | my @daiaobjs; | ||||||
| 67 | |||||||
| 68 | # parse DAIA | ||||||
| 69 | if ( $data ) { | ||||||
| 70 | @daiaobjs = eval { DAIA->parse( data => $data, format => $informat ) }; | ||||||
| 71 | } elsif( $url ) { | ||||||
| 72 | @daiaobjs = eval { DAIA->parse( file => $url, format => $informat ) }; | ||||||
| 73 | } | ||||||
| 74 | if ($@) { | ||||||
| 75 | $error = $@; | ||||||
| 76 | $error =~ s/DAIA::([A-Z]+::)?[a-z_]+\(\):| at .* line.*//ig; | ||||||
| 77 | } | ||||||
| 78 | |||||||
| 79 | my $daia; | ||||||
| 80 | if (@daiaobjs > 1) { | ||||||
| 81 | $error = "Found multiple DAIA elements (".(scalar @daiaobjs)."), but expected one"; | ||||||
| 82 | } elsif (@daiaobjs) { | ||||||
| 83 | $daia = shift @daiaobjs; | ||||||
| 84 | } | ||||||
| 85 | |||||||
| 86 | if ( $FORMATS->{$outformat} and $outformat ne 'html' ) { | ||||||
| 87 | $daia = DAIA::Response->new() unless $daia; | ||||||
| 88 | $daia->addMessage( $error, errno => 500, lang => 'en' ) if $error; | ||||||
| 89 | return $self->as_psgi( 200, $daia, $outformat, $req->param('callback') ); | ||||||
| 90 | } elsif ( $outformat ne 'html' ) { | ||||||
| 91 | $error = "Unknown output format - using HTML instead"; | ||||||
| 92 | } | ||||||
| 93 | |||||||
| 94 | # HTML output | ||||||
| 95 | $error = " ".escapeHTML($error)."! " if $error; |
||||||
| 96 | if ( $url and not $data ) { | ||||||
| 97 | $msg = "Data was fetched from URL " . a({href=>$url},escapeHTML($url)); | ||||||
| 98 | $msg .= " (" . a({href=>'#result'}, "result...") . ")" if $daia; | ||||||
| 99 | $msg = div({class=>'msg'},$msg); | ||||||
| 100 | # $msg .= div({class=>'msg'},"Use ". | ||||||
| 101 | # a({href=>url()."?url=$eurl"},'this URL') . | ||||||
| 102 | # " to to directly pass the URL to this script."); | ||||||
| 103 | } | ||||||
| 104 | |||||||
| 105 | my $html = < | ||||||
| 106 | |||||||
| 107 | |||||||
| 108 | |
||||||
| 109 | |||||||
| 110 | |||||||
| 124 | |||||||
| 125 | |||||||
| 126 | DAIA Validator/Converter |
||||||
| 127 | Convert and Validate DAIA response format |
||||||
| 128 | |||||||
| 129 | HTML | ||||||
| 130 | |||||||
| 131 | $html .= $msg . $error . | ||||||
| 132 | fieldset(label('Input: ', | ||||||
| 133 | popup_menu('in',['','json','xml'],'', | ||||||
| 134 | {''=>'Guess','json'=>'DAIA/JSON','xml'=>'DAIA/XML'}) | ||||||
| 135 | )). | ||||||
| 136 | fieldset('either', label('URL: ', textfield(-name=>'url', -size=>70, -value => $url)), | ||||||
| 137 | 'or', label('Data:'), | ||||||
| 138 | textarea( -name=>'data', -rows=>20, -cols=>80, -value => $data), | ||||||
| 139 | ). | ||||||
| 140 | fieldset( | ||||||
| 141 | label('Output: ', | ||||||
| 142 | popup_menu('out', | ||||||
| 143 | [ sort { $FORMATS->{$a} cmp $FORMATS->{$b} } keys %$FORMATS ], | ||||||
| 144 | $outformat, $FORMATS ) | ||||||
| 145 | ), ' ', | ||||||
| 146 | label('JSONP Callback: ', textfield(-name=>'callback',-value=>$callback)) | ||||||
| 147 | ). | ||||||
| 148 | fieldset('') | ||||||
| 149 | ; | ||||||
| 150 | my $has_graphviz = grep /^(svg|dot)$/, keys %$FORMATS; | ||||||
| 151 | if ( $has_graphviz && $url && !$data) { | ||||||
| 152 | $html .= ""; | ||||||
| 153 | } | ||||||
| 154 | $html .= ''; | ||||||
| 155 | |||||||
| 156 | if ($daia) { | ||||||
| 157 | if ( $informat eq 'xml' or DAIA::guess($data) eq 'xml' ) { | ||||||
| 158 | # TODO: move this into module DAIA (validate option when parsing) | ||||||
| 159 | my ($schema, $parser); | ||||||
| 160 | if ($xsd) { | ||||||
| 161 | if (!$HAS_LIBXML) { | ||||||
| 162 | $error = "XML::LibXML not found - validating skipped"; | ||||||
| 163 | } else { | ||||||
| 164 | $parser = XML::LibXML->new; | ||||||
| 165 | $schema = eval { | ||||||
| 166 | XML::LibXML::Schema->new( | ||||||
| 167 | location => catfile(dist_dir('Plack-App-DAIA'),'daia.xsd') | ||||||
| 168 | ); | ||||||
| 169 | }; | ||||||
| 170 | if ($schema) { | ||||||
| 171 | my $doc = $parser->parse_string( $data ); | ||||||
| 172 | eval { $schema->validate($doc) }; | ||||||
| 173 | $error = "DAIA/XML not valid but parseable: " . $@ if $@; | ||||||
| 174 | } else { | ||||||
| 175 | $error = "Could not load XML Schema - validating skipped"; | ||||||
| 176 | } | ||||||
| 177 | } | ||||||
| 178 | } | ||||||
| 179 | if ( $error ) { | ||||||
| 180 | $html .= " ".escapeHTML($error)." "; |
||||||
| 181 | } else { | ||||||
| 182 | $html .= " DAIA/XML valid according to ".a({href=>$xsd},"this XML Schema")." "; |
||||||
| 183 | } | ||||||
| 184 | } else { | ||||||
| 185 | $html .= p("validation is rather lax so the input may be invalid - but it was parseable"); | ||||||
| 186 | } | ||||||
| 187 | $html .= " "; |
||||||
| 188 | my ($pjson, $pxml, $pttl) = ("","",""); | ||||||
| 189 | if (!$data && $url) { | ||||||
| 190 | $pjson = $pxml = $pttl = "?callback=$callback&url=$eurl"; | ||||||
| 191 | $pjson = " (get via proxy)"; | ||||||
| 192 | $pxml = " (get via proxy)"; | ||||||
| 193 | #$pttl = " (get via proxy)"; | ||||||
| 194 | } | ||||||
| 195 | $html .= "Result in DAIA/JSON$pjson ↑ ↓"; |
||||||
| 196 | $html .= pre(escapeHTML( encode('utf8',$daia->json( $callback ) ))); | ||||||
| 197 | $html .= "Result in DAIA/XML$pxml ↑"; |
||||||
| 198 | $html .= pre(escapeHTML( encode('utf8',$daia->xml( xmlns => 1 ) ))); | ||||||
| 199 | if ($FORMATS->{turtle}) { | ||||||
| 200 | $html .= "Result in DAIA/RDF (Turtle) ↑"; |
||||||
| 201 | my $ttl = $daia->serialize('turtle'); | ||||||
| 202 | $html .= pre(escapeHTML( encode('utf8', $ttl ))); | ||||||
| 203 | } | ||||||
| 204 | $html .= ""; | ||||||
| 205 | } | ||||||
| 206 | |||||||
| 207 | $html .= " | ||||||
| 208 | $html .= join ' and ', map { | ||||||
| 209 | "$_ " . ($_->VERSION || ''); | ||||||
| 210 | } qw(Plack::App::DAIA::Validator DAIA); | ||||||
| 211 | $html .= < | ||||||
| 212 | . Visit the DAIA project at github for sources and details. | ||||||
| 213 | |||||||
| 214 | HTML | ||||||
| 215 | |||||||
| 216 | return [ 200, [ 'Content-Type' => 'text/html; charset=utf-8' ], [ $html ] ]; | ||||||
| 217 | } | ||||||
| 218 | |||||||
| 219 | 1; | ||||||
| 220 | |||||||
| 221 | __END__ |