view release on metacpan or  search on metacpan

lib/Hyper/Developer/Server.pm  view on Meta::CPAN

package Hyper::Developer::Server;

use strict;
use warnings;

use base qw(HTTP::Server::Simple::CGI HTTP::Server::Simple::Static);

use File::Basename;
use Hyper;
use Hyper::Singleton::Context;
use Hyper::Template::HTC;
use Hyper::Developer::Model::Viewer;
use Hyper::Request::Default;
use Module::Refresh;

use Readonly;
Readonly my $PACKAGE => __PACKAGE__;

use CGI;
use File::Find;
use Hyper::Functions;

sub new {
    my $class   = shift;
    my $arg_ref = shift;
    my $config  = delete $arg_ref->{$PACKAGE};
    my $self    = HTTP::Server::Simple::new($class, %{$arg_ref});

    $self->{$PACKAGE} = {
        base_path => dirname((caller)[1]) . '/../../',
        refresh   => Module::Refresh->new(),
        %{$config}
    };

    return $self;
}

sub handler {
    my $self = shift;
    my $cgi  = CGI->new();

    { no warnings qw(redefine);
      $self->{$PACKAGE}->{refresh}->refresh();
    }

    # use server's cgi as cgi singleton
    { no warnings qw(redefine);
      *Hyper::Singleton::CGI::new
          = *Hyper::Singleton::CGI::singleton
          = sub { return $cgi; };
      *Hyper::Error::_is_eval_context = sub {
          return $_[3] && $_[3] eq '(eval)';
      };
    }

    print "HTTP/1.0 200 OK\n";
    eval {
        my $file         = $cgi->path_info();
           $file         =~ s{//}{/}xmsg;
        my $query_string = $cgi->query_string();
        my $config       = Hyper::Singleton::Context->new({
            file => $self->{$PACKAGE}->{config_file},
        })->get_config();
        my $namespace    = $config->get_namespace();
        my $base_path    = $config->get_base_path();

        if ( ! $file || $file eq '/' ) {
            $self->_show_index();
        }
        elsif ( $file =~ m{/Model/Viewer/([^/]+)/([^/]+)/([^/]+)}xms ) {
            $self->_model_viewer({
                namespace => $namespace,
                type      => $1,
                service   => $2,
                usecase   => $3,
            });
        }
        elsif ( $file eq '/cgi-bin/' . (lc $namespace) . '/index.pl' ) {
            do "$base_path/$file";
        }
        else {
            $self->serve_static($cgi, "$base_path/htdocs/");
        }
        Hyper::Request::Default::cleanup();
    };

    return;
}

sub _model_viewer {