Perl is not the whole part of life. I know!
Labels: Foorum
my $ad = DBICx::AutoDoc->new(Full code can be found in http://foorum.googlecode.com/svn/trunk/bin/misc/dbicx_autodoc.pl
schema => 'Foorum::Schema',
output => File::Spec->catdir($Bin, '..', '..', 'docs'),
);
# rewrite the Schema pm POD
use Template;
my $tt2 = Template->new( { INCLUDE_PATH => $ad->include_path, POST_CHOMP => 0, PRE_CHOMP => 0 } );
my $vars = $ad->get_vars;
# first get the lists of all Foorum::Schema pm files
my @sources = @{ $vars->{sources} };
foreach my $source (@sources) {
my $class = $source->{class}; # Foorum::Schema::User
# make file dir
my @parts_of_modules = split('::', $class);
$parts_of_modules[-1] .= '.pm';
my $file_dir = File::Spec->catfile( $Bin, '..', '..', 'lib', @parts_of_modules );
my $output;
$tt2->process('pod.html', { source => $source }, \$output)
|| die $tt2->error(), "\n";
# replace POD in real module
open(my $fh, '<', $file_dir);
local $/ = undef;
my $in = <$fh>;
close($fh);
my ($code, $pod) = split(/\n1;\n/, $in);
open(my $fh2, '>', $file_dir);
print $fh2 "$code\n1;\n__END__\n\n$output\n";
close($fh2);
print "working on $class\n";
}
Labels: Foorum
Labels: Foorum
Labels: Foorum
Labels: Foorum
Labels: Foorum
Labels: Foorum
Labels: Foorum
Labels: Foorum
Labels: Foorum
svn checkout http://foorum.googlecode.com/svn/trunk/ FoorumLabels: Foorum
__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 ] );
}
my @a = ( 'a', $c->req->param('a'), 'b', $c->req->param('b'), 'c', undef , 'd',, 'f' );$c->res->body(Dumper(\@a));when we try "?b=1", output:$VAR1 = [
'a',
'b',
'1',
'c',
undef,
'd',
'f'
];
$rs->update( {
column1 => $c->req->param('column1'),
column2 => $c->req->param('column2')
} ); then if column1 param is not specified, this would raise error because $rs try to update column1, column2, $c->req->param('column2'). we want 4 but u give me 3.Labels: DBIx-Class, Foorum
Labels: Foorum
Labels: Foorum
# 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;
