use strict;
use warnings;
package Plack::App::DAIA;
#ABSTRACT: DAIA Server as Plack application

use v5.10.1;

use parent 'Plack::Component';
use LWP::Simple qw(get);
use Encode;
use JSON;
use DAIA;
use Scalar::Util qw(blessed);
use Try::Tiny;
use Plack::Util::Accessor qw(xslt warnings errors code idformat initialized html safe);
use Plack::Middleware::Static;
use File::ShareDir qw(dist_dir);

use Carp;
use Plack::Request;

our %FORMATS  = DAIA->formats;

sub prepare_app {
    my $self = shift;
    return if $self->initialized;

    $self->init;
    $self->errors(0) unless defined $self->errors;
    $self->warnings(1) if $self->errors or not defined $self->warnings;
    $self->idformat( qr{^.*$} ) unless defined $self->idformat;
    $self->safe(1) unless defined $self->safe;
    $self->xslt('daia.xsl') if ($self->xslt // '') =~ /^\d+$/ or (!$self->xslt && $self->html);

    if ($self->xslt) {
        if (defined $self->html and !ref $self->html) {
            carp "html => 1 is deprecated, use xslt => 1 instead";
            $self->html(0);
        }
        $self->html( Plack::Middleware::Static->new(
            path => qr{daia\.(xsl|css|xsd)$|xmlverbatim\.xsl$|icons/[a-z0-9_-]+\.png$},
            root => dist_dir('Plack-App-DAIA')
        )) unless $self->html;
    }

    $self->initialized(1);
}

sub init {
    # initialization hook
}

sub call {
    my ($self, $env) = @_;
    my $req = Plack::Request->new($env);

    my $id     = $req->param('id') // '';
    my $format = lc($req->param('format') // '');

    # serve HTML client
    if ( $self->html and $id eq '' ) {
        my $resp = $self->html->_handle_static( $env );
        if ($resp and $resp->[0] eq 200) {
            return $resp;
        }
    }

    # validate identifier
    my ($invalid_id, $error, %parts) = ('',undef);
    if ( $id ne '' and ref $self->idformat ) {
        if ( ref $self->idformat eq 'Regexp' ) {
            if ( $id =~ $self->idformat ) {
                %parts = %+; # named capturing groups
            } else {
                $invalid_id = $id;
                $id = "";
            }
        }
    }

    if ( $self->warnings ) {
        if ( $invalid_id ne '' ) {
            $error = 'unknown identifier format';
        } elsif ( $id eq ''  ) {
            $error = 'please provide a document identifier';
        }
    }

    # retrieve and construct response
    my ($status, $daia) = (200, undef);
    if ( $error and $self->errors ) {
        $daia = DAIA::Response->new;
    } else {
        if ($self->safe) {
            try {
                $daia = $self->retrieve( $id, %parts );
            } catch {
                chomp($error = "request method died: $_");
                $status = 500;
            }
        } else {
            $daia = $self->retrieve( $id, %parts );
        }
        if (!$daia or !blessed $daia or !$daia->isa('DAIA::Response')) {
            $daia = DAIA::Response->new;
            $error = 'request method did not return a DAIA response'
                unless $error;
            $status = 500;
        }
    }

    if ( $error and $self->warnings ) {
        $daia->addMessage( 'en' => $error, errno => 400 );
    }

    $self->as_psgi( $status, $daia, $format, $req->param('callback') );
}

sub retrieve {
    my $self = shift;
    return $self->code ? $self->code->(@_) : undef;
}

sub as_psgi {
    my ($self, $status, $daia, $format, $callback) = @_;
    my ($content, $type);

    $type = $FORMATS{$format} unless $format eq 'xml';
    $content = $daia->serialize($format) if $type;

    if (!$content) {
        $type = "application/xml; charset=utf-8";
        if ( $self->warnings ) {
            if ( not $format ) {
                $daia->addMessage( 'en' => 'please provide an explicit parameter format=xml', 300 );
            } elsif ( $format ne 'xml' ) {
                $daia->addMessage( 'en' => 'unknown or unsupported format', 300 );
            }
        }
        $content = $daia->xml( header => 1, xmlns => 1, ( $self->xslt ? (xslt => $self->xslt) : () )  );
    } elsif ( $type =~ qr{^application/javascript} and ($callback || '') =~ /^[\w\.\[\]]+$/ ) {
        $content = "$callback($content)";
    }

    return [ $status, [ "Content-Type" => $type ], [ encode('utf8',$content) ] ];
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Plack::App::DAIA - DAIA Server as Plack application

=head1 VERSION

version 0.53

=head1 SYNOPSIS

Either derive from Plack::App::DAIA

    package Your::App;
    use parent 'Plack::App::DAIA';

    sub init {
        my $self = shift;
        $self->idformat( qr{^[a-z]+:.*$} ) unless $self->idformat;
    }

    sub retrieve {
        my ($self, $id, %idparts) = @_;

        my $daia = DAIA::Response->new;

        # construct full response ...

        return $daia;
    };

    1;

or pass a code reference as option C<code>:

    use Plack::App::DAIA;

    Plack::App::DAIA->new(
        code => sub {
            my ($id, %idparts) = @_;

            my $daia = DAIA::Response->new;

            # construct full response ...

            return $daia;
        },
        idformat => qr{^[a-z]+:.*$}
    );

=head1 DESCRIPTION

This module implements a B<Document Availability Information API> (L<DAIA>)
server as PSGI application. A DAIA server receives two URL parameters:

=over 4

=item B<id>

refers to the document to retrieve availability information. The id is parsed
based on the L</idformat> option and passed to an internal L</retrieve> method,
which must return a L<DAIA::Response> object.

=item B<format>

specifies a DAIA serialization format, that the resulting L<DAIA::Response> is
returned in. By default the formats C<xml> (DAIA/XML, the default), C<json>
(DAIA/JSON), and C<rdfjson> (DAIA/RDF in RDF/JSON) are supported. Additional
RDF serializations (C<rdfxml>, C<turtle>, and C<ntriples>) are supported if
L<RDF::Trine> is installed. If L<RDF::NS> is installed, the RDF/Turtle output
uses well-known namespace prefixes. Visual RDF graphs are supported with format
C<svg> and C<dot> if L<RDF::Trine::Exporter::GraphViz> is installed and C<dot>
is in C<$ENV{PATH}>.

=back

This module automatically adds appropriate warnings and error messages. A
simple HTML interface based on client side XSLT is added with option C<xslt>.

=head1 METHODS

=head2 new ( [%options] )

Creates a new DAIA server. Supported options are

=over 4

=item code

Code reference to the C<retrieve> method if you prefer not to create a
module derived from this module.

=item xslt

Path of a DAIA XSLT client to attach to DAIA/XML responses (disabled by
default).  Any numeric value will be set to C<daia.xsl>, so use C<< xslt => 1
>> for enabling the default XSLT client. The default client is provided in form
of three files (C<daia.xsl>, C<daia.css>, C<xmlverbatim.xsl>) and DAIA icons,
all shipped together with this module. Enabling HTML client also enables
serving the DAIA XML Schema as C<daia.xsd>.

You may need to adjust the path if your server rewrites the request path.

=item warnings

Enable warnings in the DAIA response (enabled by default).

=item errors

Enable warnings and directly return a response without calling the retrieve
method on error.

=item idformat

Optional regular expression to validate identifiers. Invalid identifiers are
set to the empty string before they are passed to the C<retrieve> method. In
addition an error message "unknown identifier format" is added to the response,
if the option C<warnings> are enabled. If the option C<errors> is enabled,
the C<retrieve> method is not called on error.

It is recommended to use regular expressions with named capturing groups
as introduced in Perl 5.10. The named parts are also passed to the
C<retrieve method>. For instance:

  idformat => qr{^ (?<prefix>[a-z]+) : (?<local>.+) $}x

will give you C<$parts{prefix}> and C<$parts{local}> in the retrieve method.

=item safe

Catch errors on the request format if enabled (by default). You may want to
disable this to get a stack trace if the request method throws an error.

=item initialized

Stores whether the application had been initialized.

=back

=head2 retrieve ( $id [, %parts ] )

Must return a status and a L<DAIA::Response> object. Override this method
if you derive an application from Plack::App::DAIA. By default it either
calls the retrieve code, as passed to the constructor, or returns undef,
so a HTTP 500 error is returned.

This method is passed the original query identifier and a hash of named
capturing groups from your identifier format.

=head2 init

This method is called by Plack::Component::prepare_app, once before the first
request and before undefined options are set to their default values. You can
define this method in you subclass as initialization hook, for instance to set
default option values. Initialization during runtime can be triggered by
setting C<initialized> to false.

=head2 as_psgi ( $status, $daia [, $format [, $callback ] ] )

Serializes a L<DAIA::Response> in some DAIA serialization format (C<xml> by
default) and returns a a PSGI response with given HTTP status code.

=head1 EXAMPLES

You can also mix this application with L<Plack> middleware.

It is highly recommended to test your services! Testing is made as easy as
possible with the L<provedaia> command line script.

This module contains a dummy application C<app.psgi> and a more detailed
example C<examples/daia-ubbielefeld.pl>.

=head1 SEE ALSO

Plack::App::DAIA is derived from L<Plack::Component>. Use L<Plack::DAIA::Test>
and L<provedaia> (using L<Plack::App::DAIA::Test::Suite>) for writing tests.
See L<Plack::App::DAIA::Validator> for a DAIA validator and converter.

=head1 AUTHOR

Jakob Voß

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by Jakob Voß.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
