Designing Opeation Oriented Web Applications / YAPC::Asia Tokyo 2011

print STDERR “timeoutn”;

timeout

warn(“timeout”);

timeout at test.pl line 8.

sub logf {
my ($level,$message) = @_;
my ($pkg,$file,$line) = caller;
my @time = localtime;
warn sprintf "%04d-%02d-%02dT%02d:%02d:%02d
[%s] %s at %s line %d.n",
$time[5]+1900, $time[4]+1, @time[3,2,1,0],
$level, $message,
$file, $line;
}

logf(“WARN”,”timeout”);
logf(“INFO”,”foo bar”);

2011-10-05T09:41:30 [WARN] timeout at test.pl line 10.
2011-10-05T09:41:30 [INFO] foo bar at test.pl line 11.

2011-10-05T09:41:30
[WARN]
[/entry/foobar]
failed request: http://ad.net/ read timeout
at /path/to/Controler/Entry.pm line 10.

use Log::Minimal;

# stack trace
debugf(‘blah blah blah’);
infof(“server start $$”);
critf("%s","foo");
warnf("%d %s", 1, "foo");

# stack trace
debugff(‘blah blah blah’);
infoff(“server start $$”);
critff("%s","foo");
warnff("%d %s", 1, "foo");

use Log::Minimal;

debugf(‘blah blah blah’); #

local $ENV{LM_DEBUG} = 1;
debugf(‘blah blah blah’); #

2011-10-05T09:41:30 [DEBUG] blah.. at test.pl line 11.

#
local $Log::Minimal::PRINT = sub {
my ( $time, $type, $message, $trace) = @_;
warn(“$time [$type] $message $tracen”);
};

#
open( my $fh, ">>", "app.log");
my ( $time, $type, $msg, $tr, $r_msg ) = @_;
print $fh “$time [$type] $r_msg $trn”;
};

#
local $Log::Minimal::AUTODUMP = 1;
warnf(“response => %s”,$res);

2011-05-11T15:56:14 [WARN] response => [200,
['Content-Type','text/plain'],['OK']] at ..

#
local $Log::Minimal::COLOR = 1;
warnf(“hirose31”);

2011-05-11T15:56:14 [WARN] hirose31 at ..

use Log::Minimal;
use Plack::Builder;
builder {
   enable "Log::Minimal", autodump => 1;
   sub {
   my $env = shift;
   warnf("warn");
   debugf("debug");
   ...
   }
};

$ plackup -a demo.psgi
2011-05-11T16:32:24 [WARN] [/foo/bar/baz] warn at /tmp/
demo.psgi line 8
2011-05-11T16:32:24 [DEBUG] [/foo/bar/baz] debug at /tmp/
demo.psgi line 9

use Log::Minimal;
use Parallel::Prefork;

my $pm = Parallel::Prefork->new();
while ( $pm->signal_received ne 'TERM' ) {
$pm->start(sub {
local $Log::Minimal::AUTODUMP = 1;
local $Log::Minimal::COLOR = 1;
while (1) {
my $job = $queue->dequeue;
my ( $time, $type, $message, $trace) = @_;
warn(“$$ [“,$job->name,”] [$type] $message $trace”);
};
...
}
});
}

SELECT * FROM entries
WHERE created_at >= '2011-10-05 00:00:00'
AND created_at < '2011-10-06 00:00:00'
AND status != 0;

Data::Entry->search({
-and => [
created_at => {'>=','2011-10-05 00:00:00' },
created_at => {'<','2011-10-06 00:00:00' },
],
status => { '!=', 0 }
});

my $dbh = DBIx::Sunny->connect(
‘dsn’,‘user’,‘passwd’,
);

✓ RaiseError => 1
✓ PrintError= > 0
✓ ShowErrorStatement => 1
✓ AutoInactiveDestroy => 1
✓ sqlite_unicode/mysql_enable_utf8 => 1
✓ mysql_auto_reconnect => 0

my $sth = $dbh->prepare(“SELECT *
FROM entries
WHERE ..”);

SELECT /* test.pl line 941 */ *
FROM entries
WHERE ..

selectrow_arrayref($query, {}, @bind);

selectrow_hashref($query, {}, @bind);

selectall_arrayref($query, { Slice => {} }, @bind);

prepare($query) && execute(@bind)

my $builder = SQL::Maker->new(
driver => 'mysql',
);
my $dbh = DBIx::Sunny->connect(...);

my ($sql, @binds) = $builder->select(
'user',
['*'],
{name => 'john'},
{order_by => 'user_id DESC'}
);

my $rows = $dbh->select_row($sql,@binds);

my $dbh = DBI->connect($dsn,$user,$pass,{...});
while ( my $job = $queue->dequeue ) {
....
}

my $DBH;
sub get_dbh {
$DBH ||= DBI->connect($dsn,$user,$pass,{...});
$DBH;
}
my $dbh = get_dbh();
....
}

sub get_dbh {
DBI->connect_cached($dsn,$user,$pass,{...});
}
....
}

my $sc = start_scope_container(); #
scope_container(‘key1’,‘value1’);
$value = scope_container(‘key1’); #value

sub hoge {
scope_container(‘key2’,‘foobar’);
}

{
my $sc2 = start_scope_container(); #
scope_container(‘key1’,‘blahblah’);
hoge();
$value = scope_container(‘key1’); #blahblah
$value = scope_container(‘key2’); #foobar
undef $sc2;
}

$value = scope_container(‘key2’); #undefined

my %DATA; #
$DATA{'key1'} = 'value1';
$value = $DATA{'key1'} #value

sub hoge {
$DATA{'key2'} = 'foobar';
}

{
local %DATA; #
$value = $DATA{'key1'} #value
$DATA{'key1'} = ‘blahblah’
hoge();
$value = $DATA{'key1'}; #blahblah
$value = $DATA{'key2'} #foobar
}

$value = $DATA{'key1'}; #value
$value = $DATA{'key2'}; #undefined

sub get_dbh {
my $dsn = shift

my $cache = scope_container($dsn);
reutrn $cache if $cache;

my $dbh = DBIx:Sunny->connect($dsn,$user,$pass);
scope_container($dsn, $dbh);
return $dbh;
}

my $sc = start_scope_container();
my $dbh = get_dbh(); #new connection
my $dbh2 = get_dbh(); #cached
..
# disconnect
}

use Scope::Container;
use Scope::Container::DBI;

sub get_dbh {
Scope::Container::DBI->connect($dsn,$user,$pass,{}):
}

for my $id (1..$max) {
my $sc = start_scope_container();

get_dbh()->do(...); #new connection
get_dbh()->select_row(...); #cache

undef $sc; #
}

# DBI
local $Scope::Container::DBI::DBI_CLASS = “Amon2::DBI”;
my $dbh = Scope::Container::DBI->connect(
$dsn,$user,$pass,{});

# slave 1
my $dbh = Scope::Container::DBI->connect(
[$dsn1,$user,$pass,{}],
);

use Plack::Builder;

builder {
enable “Scope::Container”;
$app;
};

# Plack::Middleware::Scope::Container
sub call {
my ( $self, $env) = @_;
my $container = start_scope_container();
$self->app->($env);
}

key1 key2 key3 key4 key5 key6 key7 key8 key9

memcached1 memcached2 memcached3

App App App App

mem DB mem

App App App App

mem DB mem DB

use Cache::Memcached::IronPlate;
use Cache::Memcached::Fast;

my $memd = Cache::Memcached::IronPlate->new(
cache => Cache::Memcached::Fast->new(...),
);

$memd->get
$memd->get_multi
$memd->set
$memd->add
$memd->replace
$memd->append
$memd->prepend
$memd->incr
$memd->counter
$memd->decr
$memd->delete

set(‘key:dup’,val,exp) get(‘key:dup’)

IronPlate IronPlate

set key:dist:{1..3} get key:dist:{1..3}

mem1 mem2 mem3 mem1 mem2 mem3

set(‘key:dist’,val,exp) get(‘key:dist’)

IronPlate IronPlate

set key:dist:{1..30} get key:dist:rand(30)

mem1 mem2 mem3 mem1 mem2 mem3

use Cache::Isolator;

my $isolator = Cache::Isolator->new(
);

$isolator->get(key);
$isolator->set(key,val,expires);

set(‘key’,val,30) set(‘key’,val,30)

Isolator Isolator

set key 30 set key:earlyexp 20

mem1 mem2 mem1 mem2


early_expires_ratio => 10,
expires_before => 10
);

$isolator->get(key);
$isolator->set(key,val,expires);


concurrency => 3,
);

$isolator->get_or_set(key, sub {
$dbh->select_all(heavy_sql);
}, expires);

use Plack::Builder;
use File::Temp;

builder {
enable "ServerStatus::Lite",
path => '/___server-status',
allow => [‘127.0.0.1’,‘192.168.0.0/16’],
scoreboard => File::Temp::tempdir(CLEANUP => 1);
$app
};

$ curl http://localhost:5000/___server-status
Uptime: 1318372692
BusyWorkers: 3
IdleWorkers: 27
--
pid status remote_addr host method uri protocol
1522 A 127.0.0.1 localhost:5000 GET /___server-status HTTP/1.1
1523 _ 192.168.67.3 192.168.67.4:5000 GET /foo/bar HTTP/1.0
1526 _ 192.168.67.5 192.168.67.4:5000 GET /foo/bar HTTP/1.0
...

use Parallel::Scoreboard;

my $sb = Parallel::Scoreboard->new(
base_dir => ‘/var/run/example_worker’ );

my $pm = Parallel::Prefork->new({...});
while ( $pm->signal_received !~ m!^(?:TERM|INT)$! ) {
$pm->start(sub{
$sb->update('.');
while(1) {
$sb->update('A');
#work work work
$sb->update('.');
}
});
}

use Parallel::Scoreboard;


my $pm = Parallel::Prefork->new({...});
while ( $pm->signal_received !~ m!^(?:TERM|INT)$! ) {
$pm->start(sub{ idle
$sb->update('.');
while(1) {
$sb->update('A');
#work work work busy
$sb->update('.');
}
}); idle
}

# scoreboard.psgi
sub {
my $env = shift;
my $stats = $scoreboard->read_all();
my $busy = 0;
my $idle = 0;
for my $pid ( sort { $a <=> $b } keys %$stats) {
if ( $stats->{$pid} =~ m!^A! ) {
$busy++;
} else { busy
$idle++;
}
}
return [200,['Content-Type'=>'plain/text'],
["BusyWorkers: $busynIdleWorkers: $idle"]];
};

#
$ plackup -p 5001 -a scoreboard.psgi

#
$ curl http://localhost:5001/___server-status
BusyWorkers: 6
IdleWorkers: 4

192.188.67.2
idle

busy

Designing Opeation Oriented Web Applications / YAPC::Asia Tokyo 2011

More Related Content

What's hot (20)

Similar to Designing Opeation Oriented Web Applications / YAPC::Asia Tokyo 2011 (20)

More from Masahiro Nagano (20)

Recently uploaded (20)

Designing Opeation Oriented Web Applications / YAPC::Asia Tokyo 2011

Editor's Notes