Perl is not the whole part of life. I know!
sub test : Local {
my ($self, $c) = @_;
my $test = {
a => $c->req->param('a'),
b => $c->req->param('b'),
c => $c->req->param('c'),
};
$c->res->body(Dumper(\$test));
} $VAR1 = \{
'1' => 'c',
'a' => 'b'
}; sub test : Local {
my ($self, $c) = @_;
my $test = {
a => $c->req->params->{'a'},
b => $c->req->params->{'b'},
c => $c->req->params->{'c'},
};
$c->res->body(Dumper(\$test));
} $VAR1 = \{
'a' => undef,
'b' => '1',
'c' => undef
};Labels: Catalyst
sub test_body : Local {
my ($self, $c) = @_;
$c->res->body(\*STDOUT);
print "a\n";
print "b\n";
}Labels: Catalyst
Labels: Catalyst
Labels: Catalyst
stats => {
user_counts => {
20071201 => 510,
20071202 => 640,
20071203 => ...$(function () {
[% i = 0 %]
[% FOREACH ctype IN stats.keys %]
$('body').append("<h2>[% ctype %]</h2><div class='placeholder' id='placeholder[% i %]' style='height:300px;'></div>");
var d[% i %] = [];
[% FOREACH key IN stats.${ctype}.keys.sort %]
d[% i %].push([[% key %], [% stats.${ctype}.$key %]]);
[% END %]
$.plot($("#placeholder[% i %]"), [
{
data: d[% i %],
lines: { show: true },
points: { show: true }
}
]);
[% i = i + 1 %]
[% END %]
});use Catalyst qw/Authentication ../;authentication:
default_realm: 'members'
realms:
members:
credential:
class: 'Password'
password_field: 'password'
password_type: "hashed"
password_hash_type: "SHA-1"
store:
class: 'FromSub::Hash'
model_class: "UserAuth"package Foorum::Model::UserAuth;
use base 'Catalyst::Model';
sub auth {
my ($self, $c, $userinfo) = @_;
my $where;
if (exists $userinfo->{user_id}) {
$where = { user_id => $userinfo->{user_id} };
} elsif (exists $userinfo->{username}) {
$where = { username => $userinfo->{username} };
} else { return; }
my $user = $c->model('User')->get( $c, $where );
return $user;
}Labels: Catalyst
Labels: Catalyst
package Foorum::TheSchwartz::Worker::ResizeProfilePhoto;
use TheSchwartz::Job;
use base qw( TheSchwartz::Worker );
use Foorum::ExternalUtils qw/schema/;
use File::Spec;
use Image::Magick;
use Cwd qw/abs_path/;
use File::Copy;
my (undef, $path) = File::Spec->splitpath(__FILE__);
sub work {
my $class = shift;
my TheSchwartz::Job $job = shift;
my @args = $job->arg;
my $schema = schema();
# get upload from db
my $upload_id = shift @args;
if ($upload_id !~ /^\d+$/) {
return $job->failed("Wrong upload_id: $upload_id");
}
my $upload = $schema->resultset('Upload')->find( { upload_id => $upload_id } );
unless ($upload) {
return $job->failed("No upload for $upload_id");
}
# get file dir
my $directory_1 = int( $upload_id / 3200 / 3200 );
my $directory_2 = int( $upload_id / 3200 );
my $file = abs_path("$path/../../../../root/upload/$directory_1/$directory_2/" . $upload->filename);
# resize photo
my $p = new Image::Magick;
$p->Read($file);
$p->Scale(geometry=>'120x120');
$p->Sharpen(geometry=>'0.0x1.0');
$p->Set(quality=>'75');
my ($width, $height, $size) = $p->Get('width', 'height', 'filesize');
my $tmp_file = $file . '.tmp';
$p->Write($tmp_file);
move($tmp_file, $file);
# update db
$schema->resultset('UserProfilePhoto')->search( {
type => 'upload',
value => $upload_id,
} )->update( {
width => $width,
height => $height,
} );
($size) = ( $size =~ /^(\d+\.?\d{0,1})/ ); # float(6,1)
$upload->update( { filesize => $size } );
$job->completed();
}
sub max_retries { 3 };
1;
package Foorum::ExternalUtils;
# ... etc.
use TheSchwartz;
sub theschwartz {
$config = config() unless ($config);
my $theschwartz = TheSchwartz->new(
databases => [ {
dsn => $config->{theschwartz_dsn}, # dbi:mysql:theschwartz
user => $config->{dsn_user},
pass => $config->{dsn_pwd},
} ],
verbose => 1,
);
return $theschwartz;
}
use Foorum::ExternalUtils qw/theschwartz/;
use Foorum::TheSchwartz::Worker::ResizeProfilePhoto;
my $client = theschwartz();
$client->can_do('Foorum::TheSchwartz::Worker::ResizeProfilePhoto');
$client->work();
package Foorum::Controller::Profile;
use Foorum::ExternalUtils qw/theschwartz/;
sub xxx : Local {
# ... etc.
my $client = theschwartz();
$client->insert('Foorum::TheSchwartz::Worker::ResizeProfilePhoto', $new_upload_id);
}
sub work {
my $class = shift;
my TheSchwartz::Job $job = shift;
my @args = $job->arg;
# do something
$job->completed();
}Labels: Catalyst, TheSchwartz
my $controller = MyApp->controller('MyController');
my $c = MyApp->prepare();
# Monkey with $c to set up a fake context (set req->uri, or params)
my $result = $controller->method_to_test($c, @args);Labels: Catalyst
__PACKAGE__->setup();Full code please check Foorum.pm
__PACKAGE__->log->levels('error', 'fatal'); # for real server
if( __PACKAGE__->config->{debug_mode} ) {
__PACKAGE__->log->enable('debug', 'info', 'warn'); # for developer server
{
# these code are copied from Catalyst.pm setup_log
no strict 'refs';
my $class = __PACKAGE__;
*{"$class\::debug"} = sub { 1 };
}
my @extra_plugins = qw/ StackTrace DBIC::Schema::Profiler /;
__PACKAGE__->setup_plugins( [ @extra_plugins ] );
}
__PACKAGE__->mk_accessors(qw/id config obj store/);
# .skip
bless {
id => $id,
config => $config,
obj => $user_obj,
}, $class;
sub AUTOLOAD {
my $self = shift;
(my $method) = (our $AUTOLOAD =~ /([^:]+)$/);
return if $method eq "DESTROY";
$self->obj->$method(@_);
}. when we call ->username of $c->user. it will call sub username in Catalyst::Plugin::Authentication::Store::DBIC::User. then sub AUTOLOAD works here, it call $self->obj->$method(@_) indeed. ($self is $c->user).Labels: Catalyst, DBIx-Class
search( {}, {
rows => 6,
offset => 5
} );that would be what u want.Labels: Catalyst, DBIx-Class
# internationalization
$c->stash->{lang} = $c->req->cookie('pref_lang')->value if ($c->req->cookie('pref_lang'));
$c->stash->{lang} ||= $c->user->lang if ($c->user_exists);
$c->stash->{lang} ||= $c->config->{default_pref_lang};
if (my $lang = $c->req->param('set_lang')) {
$lang =~ s/\W+//isg;
if (length($lang) == 2) {
$c->res->cookies->{pref_lang} = { value => $lang };
$c->stash->{lang} = $lang;
}
}
$c->languages( [ $c->stash->{lang} ] );
package Catalyst::Plugin::PageCacheWithI18N;
use strict;
use warnings;
use Class::C3;
use vars qw/$VERSION/;
$VERSION = '0.01';
use base qw/Catalyst::Plugin::PageCache/;
sub _get_page_cache_key {
my ($c) = @_;
my $key = $c->next::method(@_);
my $lang = $c->req->cookie('pref_lang')->value if ($c->req->cookie('pref_lang'));
$lang ||= $c->user->lang if ($c->user_exists);
$lang ||= $c->config->{default_pref_lang};
if (my $set_lang = $c->req->param('set_lang')) {
$set_lang =~ s/\W+//isg;
if (length($set_lang) == 2) {
$lang = $set_lang;
}
}
$key .= '#' . $lang if ($lang);
return $key;
}
1;
my $storage = $cfg->{memcached_obj} || Cache::Memcached::Managed->new(
data => "localhost:11211",
namespace => "catalyst_session",
group_names => [qw(user_id)],
%{ $cfg->{memcached_new_args} || {} },
),so that we can set user_id when set a memcache key.$c->_session_memcached_storage->set(at end, delete_session_data_by_user_id is pretty simple.
@{ $c->_session_memcached_arg_fudge },
(
$key =~ /^(?:expires|session|flash)/
? ( expiration => $c->session_expires )
: ()
),
id => $key,
value => $data,
user_id => $user_id,
)
sub delete_session_data_by_user_id {
my ( $c, $user_id ) = @_;
return unless ($user_id > 0);
$c->_session_memcached_storage->delete_group( user_id => $user_id );
}# Root.pm如果有其他 pm 的 sub end 覆盖了 Root.pm 的 end 的话，那还要在那个
sub begin : Private { my ($self, $c) = @_; $c->stash->{start_t0} =
[gettimeofday]; }
sub end : Private { my ($self, $c) = @_;
if ($c->res->body || $c->res->location) {
$c->model('Log')->log_path($c, tv_interval(
$c->stash->{start_t0}, [gettimeofday] ) ); # log path
return;
}
# code here
$c->forward($c->view('TT'));
$c->model('Log')->log_path($c, tv_interval( $c->stash->{start_t0},
[gettimeofday] ) ); # log path
}
package Catalyst::Action::PathLogger;而 Root.pm 的 sub end 将不在用 :Private 而是 sub end :
use strict;use warnings;
use base 'Catalyst::Action';
use Time::HiRes qw( gettimeofday tv_interval );
sub execute {
my $self = shift;
my ( $controller, $c ) = @_;
$self->NEXT::execute( @_ );
$c->model('Log')->log_path($c, tv_interval( $c->stash->{start_t0},
[gettimeofday] ) );
}
Labels: Catalyst
captcha:然后弄一个 captcha 的 Global 函数。
session_name: captcha_string
new:
width: 80
height: 30
lines: 1
gd_font: giant
create:
- normal
- rect
particle:
- 100
out:
force: jpeg
sub captcha : Global {
my ($self, $c) = @_;
$c->create_captcha();
}create_captcha 返回的是一个 img 的 source, 也就是验证码那个图片的内容。<input type='text' name='captcha' size='12' /><img src='/captcha' />img 的地址就是刚才的 Global 所弄的函数。插件将这个图片实际上的字符串内容放到了当前的 session 里。
$c->session->{ $c->config->{captcha}->{session_name} } = $random_string;然后它提供的 validate_captcha method 就是比较 user 输入的东西跟这个 session 的内容。看看源代码就觉得非常清晰。Labels: Catalyst
sub end : Private {
my ( $self, $c ) = @_;
# for login using!
if ($c->res->location and $c->res->location eq '/login') {
$c->res->location('/login?referer=/' . $c->req->path);
}
return if ($c->res->body || $c->res->redirect);Logon.pm after $c->login OK, use# redirectand in Template: try to put "<input type='hidden' name='referer' value='[% c.req.param('referer') %]' />" in your action='/login' form.
my $referer = $c->req->param('referer');
if ($referer) {
$c->res->redirect($referer);
} else {
$c->res->redirect('/');
}
Labels: Catalyst
sub render {
my $self = shift;
my ( $c, $template, $args ) = @_;
# view Catalyst::View::TT for more details
my $vars = {
(ref $args eq 'HASH' ? %$args : %{ $c->stash() }),
};
if ($vars->{no_wrapper}) {
$self->template->service->{WRAPPER} = [];
} else {
$self->template->service->{WRAPPER} = ['wrapper.html'];
}
$self->NEXT::render(@_);
}so that u can use something like:my $email_body= $c->view('TT')->render($c, 'email/example.html', {
no_wrapper => 1,
another_var => $another_var,
} );or set $c->stash->{no_wrapper} = 1 in Admin.pmpackage Catalyst::Plugin::Session::State::URI;将这段代码随便放到某个 Controller/Model/Plugin 的 pm 里都可以。因为在 Catalyst 里所有的模块都是一次性载入的。
no warnings 'redefine';
sub _session_rewriting_html_tag_map {
return {
a => "href",
form => "action",
# link => "href",
# img => "src",
# script => "src",
};
}
Labels: Catalyst
