=head1 NAME

Froody::Dispatch - Easily call Froody Methods

=head1 SYNOPSIS

  use Froody::Dispatch;
  my $dispatcher = Froody::Dispatch->new();
  my $response = $dispatcher->call( "foo.bar.baz",
    fred => "wilma" 
  );

or, as a client:

  $client = Froody::Dispatch->new;

  # uses reflection to load methods from the server
  $client->add_endpoint( "uri" ); 

  # look mah, no arguments!
  $rsp = $invoker->invoke($client, 'service.wibble');

  # ok, take some arguments then.
  $rsp = $invoker->invoke($client, 'service.devide', divisor => 1, dividend => 2);

  # alternatively, args can be passed as a hashref:
  $args = { devisor => 1, devidend => 2 }; 
  $rsp = $invoker->invoke($client, 'service.devide', $args);


=head1 DESCRIPTION

This class handles dispatching Froody Methods.  It's used both from within the
servers where you don't want to have to worry about the little details and as a
client.

=cut

package Froody::Dispatch;
use base qw( Froody::Base );

use warnings;
use strict;

use Params::Validate qw(:all);
use Scalar::Util qw( blessed );

use Froody::Response::Terse;
use Froody::Repository;
use Froody::Response::Error;
use Froody::Invoker::Remote;
use Froody::Error qw(err);
use Froody::Logger;

my $logger = get_logger("froody.dispatch");

__PACKAGE__->mk_accessors(qw{response_class error_class endpoints filters});

=head1 METHODS

=head2 Class Methods

=over 4

=item new

Create a new instance of the dispatcher

=cut

sub new {
  my $class = shift;
  my $self = $class->SUPER::new(@_);
  $self->endpoints({}) unless $self->endpoints;
  $self->error_class('Froody::Response::Error') unless $self->error_class;
  $self;
}

=item parse_cli (@args) 

Parses a list of files, urls, modules, method filter expressions, and paths.

What you're able to do:

=over 4

=item module

-MModule::Name (or just Module::Name) - request that that module is registered.

=item path

-Ipath will inject that path into C<%INC>

=item perl module file name

filename will extract all module names from within the path

=item method filter 

foo.bar.baz will be interpreted as a filter expression.

=back

Returns a hashref of include paths, modules, urls, and filters

=cut

sub parse_cli {
  my ($self, @args) = @_;
  my @urls;
  my @modules;
  my @filters;
  my @includes;
  for (@args) {
    if ($_ =~ s/^-M// || $_ =~ m/::/) {
      push @modules, $_; 
    } elsif ( $_ =~ m/^https?:/) {
      push @urls, $_;
    } elsif ( -f $_ ) {
      # fairly horrible, this.
      my $data;
      {
        open my $fh, "<", $_ or die "can't open $_ for reading: $!";
        local $/;
        $data = <$fh>;
      }
      while ($data =~ /^\s*package (.*?);$/gm) {
        my $module = $1;
        $module =~ s/'/::/g;  # incase of crack
        push @modules, $module;
      }
    } elsif ( $_ =~ s/^-I//) {
      push @includes, $_;
    } elsif ( $_ =~ m/\./) {
      push @filters, $_;
    } else {
      # TODO: Write a real usage doc.
      die "What should I do with $_?  I understand perl modules, URLs, and froody method names";
    }
  }
  return {
    modules => \@modules,
    urls => \@urls,
    filters => \@filters,
    includes => \@includes,
    args => {},
  }
}

=item config ($args)

Configures the dispatcher. Takes { filters => [], modules => [], urls => [], includes => [] } and
ensures that the dispatcher only contains methods that are present in either the modules
list or the urls list, and only if those modules match one or more of the filters in the
filters list.  If the filters list is empty, then all methods will be registered.

=cut

sub config {
  my ($self, $args) = @_;
  unless (ref $self) {
    $self = $self->new; # we should be an instance.
  }
  my $repository = Froody::Repository->new;
  $self->repository($repository);
  for (@{ $args->{includes} }) {
    unshift @INC, $_; #extend the search path
  }
  my @filters = @{ $args->{filters} || [] };
  $self->filters(@filters);
  for (@{ $args->{urls} || [] }) { 
    $self->add_endpoint( $_, @filters );
  }
#  warn Dumper($args->{modules}); use Data::Dumper;

  # implementation has-a api_specification
  # implementation has-a list of filters
  
  my %api;
  for my $module (@{ $args->{modules} || [] }) {
  
    # make sure implementation is loaded for isa-checks etc.
    $module->require;
    $module->import();
    
    my ($module_api, $invoker, @filters);
    if ($module->isa('Froody::API')) {
        $invoker = bless {}, 'Froody::Invoker';
        $module_api = $module;
    } elsif ($module->isa("Froody::Implementation")) {
        ($module_api, @filters) = $module->implements;
        $invoker = $module->new;
    } else {
        Carp::confess "fatal error; $module not a Froody::API or Froody::Implementation";
    }

    push @{ $api{$module_api} }, [ $invoker, @filters ];
  }
  
  @filters = _filter_to_rxs(@filters);

  # Register each API _once_, making sure to bind functions  
  foreach my $api (keys %api) {
    $api->require;
    $api->import();
    my @structures = $api->load;
    foreach my $impl (@{$api{$api}}) {
        my ($invoker, @impl_filters) = @$impl;
        $repository->load($invoker, \@structures, @filters, _filter_to_rxs(@impl_filters));
        if ($invoker->isa("Froody::Implementation")) {
          my @plugin_methods = grep { !eval { $repository->get_method($_->full_name)} }
                               @{ $invoker->plugin_methods || [] };
          for (@plugin_methods) {
            # UGH
            $repository->load($_->invoker, [$_], @filters);
          }
        }
    }
  }
  return $self;
}

sub _filter_to_rxs {
   map { Froody::Method->match_to_regex( $_ ) } @_;
}

=item add_implementation 

Adds an implementation's methods to this dispatcher.

=cut

sub add_implementation {
  my ($self, $module, @filters) = @_;
  return if $self->endpoints->{$module}{loaded};
  
  eval " use $module; 1" or die $@;
  my ($api, $invoker);
  my $repository = $self->repository;
  $invoker = $self->endpoints->{$module}{invoker};
  if ($module->isa('Froody::API')) {
    $api = $module;
    $invoker ||= (bless {}, "Froody::Invoker");  
    $self->repository->register_api( $api, $invoker, @filters );
  } elsif ($module->isa("Froody::Implementation")) {
    my @imp_filters;
    $module->register_in_repository($repository, @filters);
  }
  $self->endpoints->{$module} = { invoker => $invoker, loaded => 1 };
}

=item cli_config

Parses arguments with L<parse_cli|/Froody::Dispatch>, and then calls
config with the arguments. This is intended to be used for parsing command
line options, and directly creating configuration details

Returns a dispatch object, and the parsed options.

=cut

sub cli_config {
  my ($self, @args) = @_;
  my $parsed = $self->parse_cli(@args);

  return ($self->config($parsed), $parsed);
}

=item default_repository

DEPRECATED: This is harmful -- you end up with random methods in your namespaces

The first time this method is called it creates a default repository by
trawling through all loaded modues and checking which are subclasses of
Froody::Implementation.

If you're running this in a mod_perl handler you might want to consider
calling this method at compile time to preload all the classes.

See L<config|/Froody::Dispatch>

=cut

sub default_repository
{
  require Carp;
  Carp::confess "Don't expect the default repo to introspect.";
}

=item call_via ($invoker, $method, [@ARGS, $args])

Calls C<$method> with C<$invoker>.  If $invoker or $method are not
instances of C<Froody::Invoker> and C<Froody::Method> respectively then
this method will attempt to discover them in the registered list of endpoints
and the method repository.

Returns a Froody::Response object.

=cut

sub call_via {
  my ($self, $invoker, $method )  = splice @_, 0, 3; #pull off first three args.
  my $args  = ref $_[0] eq 'HASH' ? $_[0] 
                                  : { @_ };

  Carp::confess "You must provide an invoker" unless $invoker;
  
  if (!UNIVERSAL::isa($invoker, 'Froody::Invoker')) {
    $self->endpoints({}) unless $self->endpoints();
    $invoker = $self->endpoints->{$invoker}{invoker}
  }

  $method = $self->get_method($method, $args)
    unless UNIVERSAL::isa($method, 'Froody::Method');
  
  my $meta = {
    dispatcher => $self,
    method => $method,
    params => $args,
    repository => $self->repository,
  };
  return $invoker->invoke($method, $args, $meta);
}

=item add_endpoint( "url" )

Registers all methods from a remote repository within this one.

TODO:  add regex filtering of methods.

=cut

sub add_endpoint {
  my ($self,$url, @method_filters) = @_;
  die "add_endpoint requires an url" unless $url;
  
  my $endpoints = $self->endpoints;
  if ($endpoints->{$url}{loaded}) {
    $logger->warn("Attempted to add endpoint($url) more than once.");
    return $self;
  }
  $self->endpoints->{ $url }{invoker} ||= Froody::Invoker::Remote->new()->url($url);

  $self->load_specification($url, @method_filters);
 
  return $self;
}

=item load_specification ($name, @method_filters) 

Load method and errortype specifications from a named endpoint

=cut

sub load_specification {
  my ($self, $name, @method_filters) = @_;
  
  my $endpoint = $self->endpoints->{$name};
  my $invoker = $endpoint->{invoker};
  
  my $repo = $self->repository;
  my $response = $self->call_via($invoker, 'froody.reflection.getSpecification' );
  if ($response->as_xml->status eq 'ok') {
    my @structures =  Froody::API::XML->load_spec($response->as_xml->xml);
    $repo->load($invoker, \@structures, @method_filters);
    $endpoint->{$endpoint}{loaded} = time;
  } 
}

=back

=head2 Instance Methods

=over

=item get_method( 'full_name', args )

Retrieve a method

=cut

sub get_method {
  my ($self, $name, $args) = @_;
  Froody::Error->throw("froody.invoke.nomethod", "Missing argument: method")
    unless length($name || "");

  # get the method from the repository and just return it
  my $repo = $self->repository;
  my $method = eval { $repo->get_method($name, $args) };
  return $method if $method;

  # We didn't find it?  Maybe it's been declared in our spec that may have
  # changed since we last loaded it.  Let's look for it in here!
  # TODO: Improve this so it DTRT more (though works for now)
  if (err('froody.invoke.nosuchmethod')) {
    local $@ = $@;
    my $get_info = $repo->get_method("froody.reflection.getMethodInfo", $args);
    for (keys %{$self->endpoints || {}}) {
      my $invoker = $self->endpoints->{$_}{invoker};

      my $info = $self->call_via($invoker, $get_info, { %$args, method_name => $name })->as_xml;
      if ($info->status eq 'ok') {
        $method = Froody::API::XML->load_method( $info->xml->findnodes("/rsp/method") );
        $method->invoker($invoker);
        $repo->register_method($method);
      }
      return $method if $method;
    }
  }

  # if we got this far then, darnit, we had an error so we should throw
  # it again
  die $@;
}

=item dispatch( %args )

Causes a dispatch to a froody method to happen.  At a minimum you need to
pass in a method name:

  my $response = Froody::Dispatch->new->dispatch( method => "foo.bar.bob" );

You can also pass in parameters:

  my $response = Froody::Dispatch->new->dispatch( 
    method => "foo.bar.bob",
    param  => { wibble => "wobble" },
  );

Which repository this class uses and how errors are reported depends on
the methods defined below.

=cut

sub dispatch {
  my $self = shift;
  my $args = { @_ };

  # Strip leading and trailing whitespace in all incomming attribute names.
  if (defined $args->{method}) {
    $args->{method} =~ s/^\s+//;
    $args->{method} =~ s/\s+$//;
  }
  for (keys %{ $args->{params} }) {
    next unless /^\s|\s$/; # if there is any leading or trailing whitespace in the key name
    my $val = delete $args->{params}{$_};
    s/^\s+//;
    s/\s+$//;
    $args->{params}{$_} = $val;
  }

  my $response;
  
  my $method = eval { $self->get_method( $args->{method}, $args->{params} ) };
  
  if (my $e = $@) {
    # something here eats $@. Bah.
    $response = $self->error_class->from_exception( $e, $self->repository );

  } else {
  
    Froody::Error->throw("froody.invoke.noinvoker", "No invoker defined for this method")
      unless $method->invoker;
  
    $response = $self->call_via($method->invoker, $method, $args->{params});
  }
  
  # throw an exception if what we got back wasn't an acceptable
  # Froody::Response object
  $self->_validate_response($response);

  return $self->render_response( $response);
}

=item render_response( $response )

=cut

sub render_response {
  my ($self, $response) = @_;
  
  my $style = $self->error_style;
  my $error = $response->isa("Froody::Response::Error") ? $response : undef;
  
  if ($error && $style eq 'throw') {
    $error->throw;
  }

  my $is_an_error;
  if ($response->can('status')) {
    $is_an_error = $response->status ne 'ok';
  } else {
    $response = $response->as_xml; #Response must be representable as XML for now.

    if ($response->status ne 'ok') {
      my $code = $response->xml->findvalue('/rsp/err/@code');
      $is_an_error = 1;
      # we need to fix our structure
      $response->structure($self->repository->get_closest_errortype($code ? $code : '' ));
    }
  }

  if ($style eq "throw" && $is_an_error)
  {
    $response->as_error->throw;
  }
  
  return $response;
}

# throws an error if the reponse isn't valid
sub _validate_response
{
  my $class    = shift;
  my $response = shift;

  # nothing?  Throw an error
  if ( ! $response ) {
    Froody::Error->throw("froody.invoke.badresponse", "No response");
  }

  # if we didn't get the right sort of response, throw an error.
  unless ( ref($response) && blessed($response)
            && $response->isa("Froody::Response")) {
    Froody::Error->throw("froody.invoke.badresponse", "Bad response $response");
  }
}

=item call( 'method', [ args ] )

Call a method (optionally with arguments) and return a
L<Froody::Response::Terse> response, as described in
L<Froody::DataFormats>.  This is a thin wrapper for the
->dispatch() method. 

=cut

sub call {
  my $self = shift;
  my $method = shift;
  my $args = ref $_[0] eq "HASH" ? shift : { @_ };

  $self->_fix_args($method, $args);

  my $rsp = $self->dispatch( method => $method, params => $args );

  return $rsp->as_terse->{content};
}

sub _fix_args {
  my ($self, $method, $args) = @_;
  for (keys %$args) {
    next unless (ref($args->{$_}) and blessed($args->{$_}));
    next if ($args->{$_}->isa("Froody::Upload"));
    if ($args->{$_}->isa("Class::DBI")) {
      # this is our typical DWIM case
      $args->{$_} = $args->{$_}->id;
    } else {
      # you can't do this.
      Froody::Error->throw(
        'froody.invoke.blessedRef',
        "Can't pass object '".ref($args->{$_})."' as the '$_' param to method $method",
      );
    }
  }
}

=item get_methods ( [@filters] )

Provides a list of L<Froody::Method> objects. Optionally, the methods are filtered
by a list of filter patterns.  If L<Froody::Method::config> was called with 
a list of filters, the methods will be pre-filtered by that list. If you wish
to override the configured filters, call this method with C<undef>, or use
the repository methods directly.

=cut

sub get_methods {
  my ($self, @filters) = @_;

  unless (@_ > 1 ) {
    @filters = $self->filters;
  }
  if (!defined $_[0]) {
    @filters = ();
  }
  return $self->repository->get_methods(@filters);
}


=item repository

Get/set the repository that we're calling methods on.  If this is set
to undef (as it is by default) then we will use the default repository
(see above.)

=cut

sub repository
{
  my $self = shift;

  unless (blessed($self))
   { Froody::Error->throw("perl.methodcall.class", "repository cannot be called as a class method") }
  
  unless (@_)
  {
     return $self->{repository} if defined $self->{repository};
     return $self->default_repository;
  }
  
  unless (!defined($_[0]) || blessed($_[0]) && $_[0]->isa("Froody::Repository"))
   { Froody::Error->throw("perl.methodcall.param", "repository must be passed undef or a Froody::Repository instance") }
  
  $self->{repository} = shift;
  return $self;
}

=item error_style

Get/set chained accessor that sets the style of errors that this should use. By
default this is C<response>, which causes all errors to be converted into valid
responses.  The other option is C<throw> which turns all errors into
Froody::Error objects which are then immediatly thrown.

=cut

sub error_style
{
   my $self = shift;
   return $self->{error_style} || "throw" unless @_;
   
   unless ($_[0] && ($_[0] eq "response" || $_[0] eq "throw"))
    { Froody::Error->throw("perl.methodcall.param", "Invalid error style") }
    
   $self->{error_style} = shift;
   return $self;
}

=back

=head1 BUGS

None known.

Please report any bugs you find via the CPAN RT system.
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Froody>

=head1 AUTHOR

Copyright Fotango 2005.  All rights reserved.

Please see the main L<Froody> documentation for details of who has worked
on this project.

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

=head1 SEE ALSO

L<Froody>, L<Froody::Method>

=cut

1;