Question

我创建了一个CGI扩展，支持HTTP请求的简单路由，代码在github.com https://github.com/kristiannissen/CGIRouter/blob/master/CGI/Router.pm上，在这里

package CGI::Router;

use strict;
use warnings;

use parent 'CGI';
use Cwd 'abs_path';
use Carp;

use Data::Dumper;

sub setup {
  my ( $self, $config ) = @_;

  $self->{config} = {
    db => $config->{db} //= {},
    log => $config->{log} //= {},
    layout => $config->{layout} //= {},
    hooks => $config->{hooks} //= {}
  };
}

sub connect {
  my ( $self, $req, $subr ) = @_;

  $self->{routes} //= {};
  $self->{env} //= \%ENV;

  if ( ! exists $self->{routes}->{$req} ) {
    $self->{routes}->{$req} = {
      handler => $subr,
      pattern => $self->build_pattern( $req ),
      method => $req =~ /^(GET|PUT|POST|DELETE)/
    };
  } else {
    Carp::croak( "Similar request already exists $req!" );
  }

  # Get current request destination
  # TODO: Add that stupid IIS HTTP header
  $self->{destination} = $self->{env}->{REQUEST_URI};
  $self->{method} = $self->{env}->{REQUEST_METHOD};
}

sub render_txt {
  my ( $self, $txt ) = @_;

  print $txt;
}

sub set_header {
  my ( $self, $content_type ) = @_;

  if ( lc $content_type eq 'html' ) {
    print $self->header( -type => 'text/html', -charset => 'utf-8' );
  }
}

sub mapper {
  my $self = shift;

  my $router;
  my @params;

  foreach my $key ( keys %{ $self->{routes} } ) {
    my $route = $self->{routes}->{$key};

    if ( $self->{method} eq $route->{method} &&
      $self->{destination} =~ $route->{pattern} ) {

      @params = $self->{destination} =~ $route->{pattern};

      $router = $route;
    }
  }

  # Run hooks
  $self->run_hooks;

  return $router->{handler}->( @params );
}

sub run_hooks {
  my $self = shift;
  my $hooks = $self->{config}->{hooks};

  $self->logger( 'Running hooks before_each' );
  # Run each subroutine
  $hooks->{before_each}->( $self ) if ref $hooks->{before_each} eq 'CODE';
}

sub build_pattern {
  my ( $self, $pattern ) = @_;
  # Remov method from pattern, substitute it with nothing
  $pattern =~ s/(GET|POST|PUT|DELETE)\s?//i;
  # do block returns complex regex
  $pattern = do {
    # Replace something like /word/:token with /word/(^:([a-z]+))
    $pattern =~ s!
      (\:([a-z]+))
    !
      if ( $2 ) {
        "([^/]+)"
      }
    !gex;

    "^$pattern\$";
  };

  return $pattern;
}

sub run {
  my $self = shift;

  return $self->mapper();
}

1;

我的问题是;如何在不覆盖CGI导出的方法的情况下将我的模块方法作为Exporter的一部分添加，例如：standard？

我希望connect方法可以像

一样使用

connect( 'GET /', sub {});

而不是必须使用CGI :: Router的实例来调用它。

补充问题;我试图在调用header方法时更改charset

header( -type => 'text/html', -charset => 'utf-8' );

通过HTTP响应保持ISO无关紧要。

Perl扩展模块和使用导出器

0 个答案: