File Coverage

blib/lib/SeeAlso/Source.pm

Criterion	Covered	Total	%
statement	78	135	57.7
branch	44	88	50.0
condition	7	20	35.0
subroutine	14	17	82.3
pod	10	10	100.0
total	153	270	56.6

use strict;
use warnings;
package SeeAlso::Source;
{
  $SeeAlso::Source::VERSION = '0.71';
}
#ABSTRACT: Provides OpenSearch Suggestions reponses

use Carp qw(croak);
use SeeAlso::Response;
use SeeAlso::Server;

use base 'Exporter';
our @EXPORT_OK = qw(expand_from_config serve);


sub new {
    my $class = shift;
    my ($callback, $cache);

    $callback = shift
        if ref($_[0]) eq 'CODE' or UNIVERSAL::isa($_[0],'SeeAlso::Source');
    $cache = shift if UNIVERSAL::isa($_[0], 'Cache');
    shift if not defined $_[0];

    my (%params) = @_;
    expand_from_config( \%params, 'Source' );

    my $self = bless { }, $class;

    $callback = $params{callback} unless defined $callback;
    $cache = $params{cache} unless defined $cache;

    $self->callback( $callback ) if $callback;
    $self->cache( $cache ) if $cache;
    $self->description( %params ) if %params;

    return $self;
}


sub callback {
    my $self = shift;

    if ( scalar @_ ) {
        my $callback = $_[0];

        croak('callback parameter must be a code reference or SeeAlso::Source')
            if defined $callback and ref( $callback ) ne 'CODE'
               and not UNIVERSAL::isa( $callback, 'SeeAlso::Source' );

        $self->{callback} = $callback;
    }

    return unless defined $self->{callback};
    return $self->{callback} if ref($self->{callback}) eq 'CODE';
    return sub { $self->{callback}->query( $_[0] ) };
}


sub cache {
    my $self = shift;

    if ( scalar @_ ) {
        croak 'Cache must be a Cache object'
            unless not defined $_[0]
                   or UNIVERSAL::isa( $_[0], 'Cache' )
                   or UNIVERSAL::isa( $_[0], 'SeeAlso::Source' );
        $self->{cache} = $_[0];
    }

    return $self->{cache};
}


sub query {
    my ($self, $identifier, %params) = @_;

    $identifier = SeeAlso::Identifier->new( $identifier )
        unless UNIVERSAL::isa( $identifier, 'SeeAlso::Identifier' );

    my $key = $identifier->hash;

    if ( $self->{cache} and not $params{force} ) {
        if ( UNIVERSAL::isa( $self->{cache}, 'Cache' ) ) {
            my $response = $self->{cache}->thaw( $key );
            return $response if defined $response;
        } else {
            my $response = $self->{cache}->query( $identifier );
            return $response if $response->size;
        }
    }

    my $response = $self->query_callback( $identifier );

    $response = SeeAlso::Response->new( $identifier )
        unless UNIVERSAL::isa( $response, 'SeeAlso::Response' );

    if ( $self->{cache} ) {
        if ( UNIVERSAL::isa( $self->{cache}, 'Cache' ) ) {
            $self->{cache}->freeze( $key, $response );
        } else {
            $self->{cache}->update( $response );
        }
    }

    return $response;
}


sub query_callback {
    my ($self, $identifier) = @_;
    return $self->{callback} ?
           $self->callback->( $identifier ) :
           SeeAlso::Response->new( $identifier );
}


sub description {
    my $self = shift;
    my $key = $_[0];

    if (scalar @_ > 1) {
        my %param = @_;
        foreach my $key (keys %param) {
            my $value = defined $param{$key} ? $param{$key} : '';
            if ($key =~ /^Examples?$/) {
                $value = [ $value ] unless ref($value) eq "ARRAY";
                # TODO: check examples (must be an array of a hash)
                $key = "Examples";
            } else {
                $value =~ s/\s+/ /g;  # to string
            }
            if ($self->{description}) {
                $self->{description}{$key} = $value;
            } else {
                my %description = ($key => $value);
                $self->{description} = \%description;
            }
        }
    } elsif ( $self->{description} ) {
        return $self->{description}{$key} if defined $key;
        return $self->{description};
    } else { # this is needed if no description was defined
        return if defined $key;
        my %hash;
        return \%hash;
    }
}


sub about {
    my $self = shift;

    my $name        = $self->description("ShortName");
    my $description = $self->description("Description");
    my $url         = $self->description("BaseURL");

    $name = "" unless defined $name;
    $description = "" unless defined $description;
    $url = "" unless defined $url;

    return ($name, $description, $url);
}


sub serve {
    my ($source, $query, $config);
    if ( UNIVERSAL::isa( $_[0], 'SeeAlso::Source' ) ) {
        ($source, $config) = @_;
    } else {
        $query = shift if ref($_[0]) eq 'CODE';
        $config = shift;
        $source = SeeAlso::Source->new( $query, config => $config );
    }

    my $server = SeeAlso::Server->new( config => $config );

    binmode \*STDOUT, ":encoding(UTF-8)";
    print $server->query( $source );
    exit;
}


sub load_config {
    my $file = shift;
    open(my $fh, "<", $file);
    my $config = eval { JSON->new->relaxed->utf8->decode(join('',<$fh>)); };
    close $fh;
    return $config || { };
}


sub expand_from_config {
    my ($config, $section) = @_;
    return unless defined $config->{config};

    my $cfg = $config->{config};
    if ( ref($cfg) eq 'HASH' ) {
        $cfg = $cfg->{$section};
    } else {
        $cfg = { };
        my $file = $config->{config};
        if ( $file =~ /\.ini$/ ) {
            eval {
                require Config::IniFiles;
                my $ini = Config::IniFiles->new( -file => $config->{config}, -allowcontinue => 1 );
                foreach my $hash ( $ini->Parameters($section) ) {
                    $cfg->{$hash} = $ini->val($section,$hash);
                }
            };
        } elsif ( $file =~ /\.y[a]?ml$/ ) {
            eval {
                require YAML::Any;
                my $config = YAML::Any::LoadFile( $file );
                $cfg = $config->{$section};
            };
        } elsif ( $file =~ /\.json$/ ) {
            eval {
                open(my $fh, "<", $file);
                my $config = JSON->new->relaxed->utf8->decode(join('',<$fh>));
                close $fh;
                $cfg = $config->{$section};
            };
        } else {
            croak "Unknown configuration file type $file";
        }
        croak "Failed to read configuration file $file: $@" if $@;
    }
    return unless ref($cfg) eq 'HASH';
    foreach my $hash ( keys %{ $cfg } ) {
        $config->{$hash} = $cfg->{$hash} unless defined $config->{$hash};
    }
}

1;

__END__