PerlChina Wiki

% my $planet = "World";
Hello, <% $planet %>!

Hello, World!

 <%filter>
  s/href="([^"])+"/'href="' . add_session_id($1) . '"'/eg;
  s/action="([^"])+"/'href="' . add_session_id($1) . '"'/eg;
 </%filter>

 sub add_session_id {
     my $url = shift;

     return $url if $url =~ m{^\w+://}; # 不改变外部 URL

     if ($url =~ /\?/) {
       $url =~ s/\?/?session_id=$MasonBook::Session{_session_id}&/;
     } else {
         $url .= "?session_id=$MasonBook::Session{_session_id}";
     }

     return $url;
 }

 <%args>
  $scheme   => 'http'
  $username => undef
  $password => 
  $host     => undef
  $port     => undef
  $path
  %query    => ()
  $fragment => undef
 </%args>
 <%init>
  my $uri = URI->new;

  if ($host) {
      $uri->scheme($scheme);

      if (defined $username) {
          $uri->authority( "$username:$password" );
      }

      $uri->host($host);
      $uri->port($port) if $port;
  }

  # Sometimes we may want to include a path in a query string as part
  # of the path but the URI module will escape the question mark.
  my $q;

  if ( $path =~ s/\?(.*)$// ) {
      $q = $1;
  }

  $uri->path($path);

  # If there was a query string, we integrate it into the query
  # parameter.
  if ($q) {
      %query = ( %query, split /[&=]/, $q );
  }

  $query{session_id} = $UserSession{session_id};

  # $uri->query_form doesn't handle hash ref values properly
  while ( my ( $key, $value ) = each %query ) {
      $query{$key} = ref $value eq 'HASH' ? [ %$value ] : $value;
  }

  $uri->query_form(%query) if %query;

  $uri->fragment($fragment) if $fragment;
 </%init>
 <% $uri->canonical | n %>\

 <%args>
  $filename
 </%args>
 <%init>
  local *FILE;
  open FILE, "< $filename" or die "Cannot open $filename: $!";
  $m->autoflush(1);
  while (<FILE>) {
      $m->print($_);
  }
  $m->autoflush(0);
 </%init>

 <%args>
  $filename
 </%args>
 <%init>
  local *FILE;
  open FILE, "< $filename" or die "Cannot open $filename: $!";
  while (<FILE>) {
      $m->print($_);
      $m->flush_buffer unless $. % 10;
  }
  $m->flush_buffer;
 </%init>

 <html>
 <head>
 <title>Mason Book AuthCookie Login Form</title>
 </head>
 <body>

 <form action="/AuthCookieLoginSubmit">
 <input type="hidden" name="destination" value="<% $r->prev->uri %>">

 </form>

 </body>
 </html>

 PerlSetVar MasonBookLoginScript /AuthCookieLoginForm.comp

 <location /authcookieloginsubmit>
   AuthType MasonBook::AuthCookieHandler
   AuthName MasonBook
   SetHandler  perl-script
   PerlHandler MasonBook::AuthCookieHandler->login
 </location>

 <location /protected>
   AuthType MasonBook::AuthCookieHandler
   AuthName MasonBook
   PerlAuthenHandler MasonBook::AuthCookieHandler->authenticate
   PerlAuthzHandler  MasonBook::AuthCookieHandler->authorize
   require valid-user
 </location>

 package MasonBook::AuthCookieHandler;

 use strict;

 use base qw(Apache::AuthCookie);

 use Digest::SHA1;

 my $secret = "You think I'd tell you?  Hah!";

 sub authen_cred {
     my $self = shift;
     my $r = shift;
     my ($username, $password) = @_;

     # implementing _is_valid_user() is out of the scope of this chapter
     if ( _is_valid_user($username, $password) ) {
         my $session_key =
           $username . '::' . Digest::SHA1::sha1_hex( $username, $secret );
         return $session_key;
     }
 }

 sub authen_ses_key {
     my $self = shift;
     my $r = shift;
     my $session_key = shift;

     my ($username, $mac) = split /::/, $session_key;

     if ( Digest::SHA1::sha1_hex( $username, $secret ) eq $mac ) {
         return $session_key;
     }
 }

 <%args>
  $username => 
  $password => 
  $redirect_to => 
  @errors => ()
 </%args>
 <html>
 <head>
 <title>Mason Book Login</title>
 </head>

 <body>

 % if (@errors) {

 %   foreach (@errors) {
 <% $_ | h %>

 %   }
 % }

 <form action="login_submit.html">
 <input type="hidden" name="redirect_to" value="<% $redirect_to %>">

 </form>

 </body>
 </html>

 <%args>
  $username
  $password
  $redirect_to
 </%args>
 <%init>
  if (my @errors = check_login($username, $password) {
      $m->comp( 'redirect.mas',
                 path => 'login_form.html',
                 query => { errors => \@errors,
                            username => $username,
                            password => $password,
                            redirect_to => $redirect_to } );
  }

  $MasonBook::Session{username} = $username;
  $MasonBook::Session{token} =
      Digest::SHA1::sha1_hex( 'My secret phrase', $username );

  $m->comp( 'redirect.mas',
            path => $redirect_to );
 </%init>

 if ( $MasonBook::Session{token} ) {
     if ( $MasonBook::Session{token} eq
          Digest::SHA1::sha1_hex( 'My secret phrase',
                                  $MasonBook::Session{username} ) {

         # R<... valid login, do something here>
     } else {
         # R<... someone is trying to be sneaky!>
     }
 } else { # no token
      my $wanted_page = $r->uri;

      # Append query string if we have one.
      $wanted_page .= '?' . $r->args if $r->args;

      $m->comp( 'redirect.mas',
                 path => '/login/login_form.html',
                 query => { redirect_to => $wanted_page } );
 }

 <%init>
  my $user = get_user();  # again, hand waving

  my $required_access = $m->base_comp->attr('required_access');

  unless ( $user->has_access_level($required_access) ) {
     # R<... do something like send them to another page>
  }

  $m->call_next;
 </%init>
 <%attr>
  required_access => 'Guest'
 </%attr>

 <%attr>
  required_access => 'Admin'
 </%attr>

 use Apache::DBI

 #!/usr/bin/perl -w

 use strict;

 use Cwd;
 use File::Spec;
 use HTML::Mason;
 use User::pwent;

 my $comp_root =
     File::Spec->rel2abs( File::Spec->catfile( cwd(), 'config' ) );

 my $output;
 my $interp =
     HTML::Mason::Interp->new( comp_root  => $comp_root,
               out_method => \$output,
                 );

 my $user = getpwuid($<);

 $interp->exec( '/httpd.conf.mas', user => $user );

 my $file =  File::Spec->catfile( $user->dir, 'etc', 'httpd.conf' );
 open FILE, ">$file" or die "Cannot open $file: $!";
 print FILE $output;
 close FILE;

 ServerRoot <% $user->dir %>

 PidFile <% File::Spec->catfile( $user->dir, 'logs', 'httpd.pid' ) %>

 LockFile <% File::Spec->catfile( $user->dir, 'logs', 'httpd.lock' ) %>

 Port <% $user->uid + 5000 %>

 # loads Apache modules, defines content type handling, etc.
 <& standard_apache_config.mas &>

 <perl>
  use lib <% File::Spec->catfile( $user->dir, 'project', 'lib' ) %>;
 </perl>

 DocumentRoot <% File::Spec->catfile( $user->dir, 'project', 'htdocs' ) %>

 PerlSetVar MasonCompRoot <% File::Spec->catfile( $user->dir, 'project', 'htdocs' ) %>
 PerlSetVar MasonDataDir <% File::Spec->catfile( $user->dir, 'mason' ) %>

 PerlModule HTML::Mason::ApacheHandler

 <filesmatch "\.html$">
  SetHandler perl-script
  PerlHandler HTML::Mason::ApacheHandler
 </filesmatch>

 <%args>
 $user
 </%args>

Username:	<input type="text" name="credential_0" size="10" maxlength="10">
Password:	<input type="password" name="credential_1" size="8" maxlength="8">
<input type="submit" value="Continue">

Login:	<input type="text" name="username" value="<% $username %>">
Password:	<input type="password" name="password" value="<% $password %>">
<input type="submit" value="Login">

PerlChina Wiki

Programming with Mason

取自 PerlChina.org - wiki

[编辑] Errors

查看

个人工具

导航

文章管理

搜索

工具箱