view release on metacpan or  search on metacpan

examples/rdfa-distiller-psgi/app.psgi  view on Meta::CPAN

use 5.010;
use strict;

use Encode qw(encode);
use JSON qw(from_json);
use LWP::UserAgent;
use Object::AUTHORITY -package => 'UNIVERSAL';
use Plack::Request;
use RDF::RDFa::Parser 1.096;
use RDF::Trine;

BEGIN { eval 'use RDF::RDFa::Generator' };

my $user_agent = LWP::UserAgent->new(
	agent             => 'RDF::RDFa::Parser Distiller',
	from              => 'tobyink@cpan.org',  ## change this!!
	max_redirect      => 2,
	parse_head        => 0,
	protocols_allowed => [qw[ http https ]],
	timeout           => 60,
);

my %std = (
	'X-Powered-By' => sprintf(
		'RDF::RDFa::Parser/%s (%s)',
		RDF::RDFa::Parser->VERSION,
		RDF::RDFa::Parser->AUTHORITY,
	),
);

sub error
{
	my $message = shift;
	
	[
		400,
		[ %std, 'Content-Type' => 'text/plain' ],
		[ sprintf $message => @_ ],
	]
}

sub show_form
{
	state $form = do
	{
		(my $file = __FILE__) =~ s/psgi$/html/;
		local(@ARGV, $/) = $file;
		my $html = <>;
		
		$html =~ s{ \$AUTHORITY }
		          { RDF::RDFa::Parser->AUTHORITY }xeg;
		$html =~ s{ \$VERSION }
		          { RDF::RDFa::Parser->VERSION }xeg;
		
		$html;
	};
	
	[
		200,
		[ %std, 'Content-Type' => 'text/html' ],
		[ $form ],
	]
}

sub process_config
{
	my ($req, $rdfa_response) = @_;
	my $p   = $req->parameters;
	
	my $rdfa_host =
		   $p->{host}
		|| RDF::RDFa::Parser::Config->host_from_media_type($rdfa_response->content_type);
	
	if ($rdfa_host eq 'html5' and not $p->{host})
	{
		my $prelude = substr($rdfa_response->decoded_content, 0, 512);
		$rdfa_host = 'html32' if $prelude =~ m{-//W3C//DTD HTML 3\.2};
		$rdfa_host = 'html4'  if $prelude =~ m{-//W3C//DTD HTML 4};
	}
	
	$rdfa_host ||= 'xhtml';
	
	my $rdfa_version =
		   $p->{version}
		|| 'guess';
	
	my %options = %{
		eval { from_json($p->{options}) } or +{}
	};
	
	foreach my $k (keys %$p)
	{
		next unless $k =~ /^option_(.+)$/;
		$options{$1} = $p->{$k};
	}
	
	RDF::RDFa::Parser::Config->new($rdfa_host, $rdfa_version, %options)
}

my $app = sub
{
	my $req = Plack::Request->new( shift );
	
	my $url = $req->parameters->{url} // $req->parameters->{uri};
	return show_form($req) unless $url;
	
	my $response = $user_agent->get(