view release on metacpan or  search on metacpan

lib/ASP4/ConfigNode/Web.pm  view on Meta::CPAN

package ASP4::ConfigNode::Web;

use strict;
use warnings 'all';
use base 'ASP4::ConfigNode';
use Carp 'confess';
use JSON::XS;


sub new
{
  my $class = shift;
  
  my $s = $class->SUPER::new( @_ );
  $s->{handler_resolver}  ||= 'ASP4::HTTPContext::HandlerResolver';
  $s->{handler_runner}    ||= 'ASP4::HTTPContext::HandlerRunner';
  $s->{filter_resolver}   ||= 'ASP4::HTTPContext::FilterResolver';
  
  map {
    $_->{uri_match} = undef unless defined($_->{uri_match});
    $_->{uri_equals} = undef unless defined($_->{uri_equals});
    $_ = $class->SUPER::new( $_ );
  } $s->request_filters;
  map {
    $_->{uri_match} = undef unless defined($_->{uri_match});
    $_->{uri_equals} = undef unless defined($_->{uri_equals});
    $_->{disable_session} ||= 0;
    $_->{disable_application} ||= 0;
    $_ = $class->SUPER::new( $_ );
  } $s->disable_persistence;
  
  # Do we have "routes"?:
  eval { require Router::Generic };
  $s->{__has_router} = ! $@;
  
  return $s;
}# end new()


sub request_filters
{
  my $s = shift;
  
  @{ $s->{request_filters} };
}# end request_filters()


sub disable_persistence
{
  my $s = shift;
  
  @{ $s->{disable_persistence} };
}# end disable_persistence()


sub router
{
  my $s = shift;
  $s->_parse_routes() unless $s->{__parsed_routes}++;
  $s->{router};
}

sub routes
{
  my $s = shift;
  return unless $s->{__has_router};
  $s->_parse_routes() unless $s->{__parsed_routes}++;
  $s->{routes};
}# end routes()


sub _parse_routes
{
  my $s = shift;
  
  my @original = @{ $s->{routes} };
  my $app_root = $s->application_root;
  @{ $s->{routes} } = map {
    $_->{include_routes} ? do {
      my $item = $_;
      $item->{include_routes} =~ s/\@ServerRoot\@/$app_root/sg;
      $item->{include_routes} =~ s{\\\\}{\\}g;
      open my $ifh, '<', $item->{include_routes}
        or die "Cannot open '$item->{include_routes}' for reading: $!";
      local $/;
      my $json = eval { decode_json( scalar(<$ifh>) ) }
        or confess "Error parsing '$item->{include_routes}': $@";
      ref($json) eq 'ARRAY'
        or confess "File '$item->{include_routes}' should be an arrayref but it's a '@{[ ref($json) ]}' instead.";