Skip to content

Instantly share code, notes, and snippets.

View karupanerura's full-sized avatar
👷‍♂️
Please assign issue to me. but, I may be slow to respond.

karupanerura karupanerura

👷‍♂️
Please assign issue to me. but, I may be slow to respond.
View GitHub Profile
@karupanerura
karupanerura / morecat.pl
Created March 28, 2011 15:02
ファイル名と行番号を付加してテキストを出力。grepと組み合わせる事を想定。
use 5.12.1;
use common::sense;
use Path::Class qw(file);
use File::Spec;
use File::Basename;
my $dir = File::Spec->rel2abs(dirname(__FILE__));
my @files;
if(@ARGV){
@karupanerura
karupanerura / gist:921220
Created April 15, 2011 06:10
Compress::LZO vs Compress::Zlib
use common::sense;
use Benchmark qw(timethese cmpthese);
use Compress::LZO;
use Compress::Zlib;
my $data = 'data' x 1000;
cmpthese timethese(500000, +{
lzo => sub{
my $comp = Compress::LZO::compress($data);
@karupanerura
karupanerura / sleep_sort
Created May 19, 2011 14:57
AnyEventでsleep_sort/自前で簡易イベントループ実装したの巻/List::Utilいらなくね?/もう何も要らなくね←いまここ
sub array_dumper(@){
my @array = @_;
my $str = '[';
if(@array){
foreach my $p (@array){
if(defined $p){
if(ref($p)){
if(ref($p) eq 'ARRAY'){
$str .= array_dumper(@$p) . ', ';
@karupanerura
karupanerura / All.pm
Created July 2, 2011 16:30
Exporter::All
package Exporter::All;
use strict;
use warnings;
sub import {
my $class = shift;
my $caller = caller;
{
no strict 'refs';
@karupanerura
karupanerura / gist:1068597
Created July 6, 2011 23:35
正規表現にマッチする正規表現(未完成)
#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/say/;
my $char = qr{[^\|\+\*\(\)\[\}\\]|(?:\\[\|\+\*\(\)\[\}\\])};
my $str = qr{(?:${char}(?:[\+\*\?][^\+\*\?]?)?)+};
my $char_set = qr{\[${char}+\]};
my $regexp = qr{(?:(?:\(\R(?:\|\R)*\))|(?:\R(?:\|\R)*)|(?:${str}|${char_set})+)*};
@karupanerura
karupanerura / gist:1124954
Created August 4, 2011 10:52
get_all_dispatch.pl
use strict;
use warnings;
use Data::Dumper;
use Class::Load;
my $wantclass = shift(@ARGV) or die;
Class::Load::load_class($wantclass);
print Dumper[grep { /^dispatch_/ } get_all_methods($wantclass)];
@karupanerura
karupanerura / gist:1125305
Created August 4, 2011 14:39
get_all_isa
sub get_all_isa($) { ## no critic
_get_all_isa(shift, +{});
}
sub _get_all_isa {
my($class, $searched_hash) = @_;
my @class_isa = do {
no strict 'refs';
grep { not exists $searched_hash->{$_} } @{"${class}::ISA"};
@karupanerura
karupanerura / benchmark.pl
Created August 20, 2011 01:52
can vs hash table
package Tokyo;
package Chiba;
package main;
use strict;
use warnings;
use Benchmark qw/cmpthese timethese/;
my $table = +{
@karupanerura
karupanerura / CondMerge.pm
Created September 2, 2011 01:28
DBIx::Skinny::Utils::CondMerge
package DBIx::Skinny::Utils::CondMerge;
use strict;
use warnings;
use Hash::Merge;
our @EXPORT_OK = qw/skinny_cond_merge/;
use Exporter::Lite;
### XXX: 全てのケースを試したわけではないのでバグあるかも
@karupanerura
karupanerura / compress_bench.pl
Created September 2, 2011 05:20
Compress::LZW VS Compress::LZF VS Compress::LZO VS Compress::Zlib(memGzip) VS Compress::Snappy
use common::sense;
use Benchmark qw(timethese cmpthese);
use List::Util qw/max/;
use Compress::LZO ();
use Compress::LZF ();
use Compress::LZW ();
use Compress::Zlib ();
use Compress::Snappy ();
my $data = 'data' x 10000;