Skip to content

Instantly share code, notes, and snippets.

@ktat
ktat / gist:3871233
Created October 11, 2012 09:29
patch for regexp parentheses problem of Router::Simple
diff --git a/lib/Router/Simple/Route.pm b/lib/Router/Simple/Route.pm
index 6c5ba4a..09103cc 100644
--- a/lib/Router/Simple/Route.pm
+++ b/lib/Router/Simple/Route.pm
@@ -41,6 +41,7 @@ sub new {
$row->{_regexp_capture} = 1;
$pattern;
} else {
+ my $n = -1;
$pattern =~ s!
@ktat
ktat / gist:3871091
Created October 11, 2012 08:55
Router Simple regexp with parentheses test
diff --git a/t/01_simple.t b/t/01_simple.t
index 1c6e110..2fd5dd7 100644
--- a/t/01_simple.t
+++ b/t/01_simple.t
@@ -7,6 +7,7 @@ my $r = Router::Simple->new();
$r->connect('home', '/' => {controller => 'Root', action => 'show'}, {method => 'GET', host => 'localhost'});
$r->connect('blog_monthly', '/blog/{year}/{month}', {controller => 'Blog', action => 'monthly'}, {method => 'GET'});
$r->connect('/blog/{year:\d{1,4}}/{month:\d{2}}/{day:\d\d}', {controller => 'Blog', action => 'daily'}, {method => 'GET'});
+$r->connect('/regexp/{year:(\d{1,4})}/{month:(\d{2})}/{day:(\d\d)}', {controller => 'Blog', action => 'daily'}, {method => 'GET'});
$r->connect('/comment', {controller => 'Comment', 'action' => 'create'}, {method => 'POST'});
@ktat
ktat / gist:3499604
Created August 28, 2012 16:10
Text::Xslateの謎な挙動
#!/usr/bin/perl
use strict;
use warnings;
use Text::Xslate;
use utf8;
use Encode;
my %vpath;
$vpath{"test.tt"} = <<_TMPL_;
@ktat
ktat / gist:3339545
Created August 13, 2012 11:04
Email::MIME bug?
#!/usr/bin/perl
# Using Transport::SMTP, body is grabled with some case.
# With same code,
# Transport::Sendmail is ok(not garbled)
# Transport::SMTP is ng(garbled)
use strict;
use Carp;
use warnings;
@ktat
ktat / gist:3046579
Created July 4, 2012 10:24
Teng alias patch
diff --git a/lib/Teng.pm b/lib/Teng.pm
index de2f878..a2b3207 100644
--- a/lib/Teng.pm
+++ b/lib/Teng.pm
@@ -33,14 +33,10 @@ sub load_plugin {
$class = ref($class) if ref($class);
- my $alias = delete $opt->{alias};
+ my $alias = delete $opt->{alias} || {};
@ktat
ktat / gist:2893362
Created June 8, 2012 03:24
DBIx::QueryLog add_skip_packages patch
diff --git a/lib/DBIx/QueryLog.pm b/lib/DBIx/QueryLog.pm
index 747cdd5..cf5e379 100644
--- a/lib/DBIx/QueryLog.pm
+++ b/lib/DBIx/QueryLog.pm
@@ -8,6 +8,7 @@ use DBI;
use Time::HiRes qw(gettimeofday tv_interval);
use Term::ANSIColor qw(colored);
use Data::Dumper ();
+use Module::Find ();
@ktat
ktat / gist:2699821
Created May 15, 2012 07:49
print IP address to error_log for psgi application
package Hoge::PSGIErrors;
use strict;
use IO::Handle;
sub new {
my $class = shift;
my $env = shift;
my %self;
$self{io} = IO::Handle->new;
@ktat
ktat / gist:1566118
Created January 5, 2012 16:56
Benchmark of Query Builder
#!/usr/bin/perl
use strict;
use warnings;
use SQL::Maker;
use SQL::Abstract;
use SQL::Abstract::More;
use Benchmark qw/cmpthese/;
my $sql_abstract_more = new SQL::Abstract::More();
@ktat
ktat / gist:1430680
Created December 4, 2011 16:59
Teng::Plugin::SearchBySQLAbstractMore
package Teng::Plugin::SearchBySQLAbstractMore;
use strict;
use warnings;
use utf8;
use Carp ();
use Teng::Iterator;
use Data::Page;
use SQL::Abstract::More;
our @EXPORT = qw/search_by_sql_abstract_more search_by_sql_abstract_more_with_pager/;
@ktat
ktat / gist:1430656
Created December 4, 2011 16:50
Teng::Plugin::Pager::MySQLFoundRows::WithSQL
package Teng::Plugin::Pager::MySQLFoundRows::WithSQL;
use strict;
use warnings;
use utf8;
use Carp ();
use Teng::Iterator;
use Data::Page;
our @EXPORT = qw/search_by_sql_with_pager/;