$ cd /minicpan && ( for dir in */*/*; do
echo -e `ls $dir/*.tar.gz 2>/dev/null | perl -ne's/-[^A-Za-z_].+//;
$m{$_}++; END{print 0+keys %m}'`\\t${dir#*/*/}; done ) | sort -rn | head -10
213 ADAMK
212 ZOFFIX
206 RJBS
169 MIYAGAWA
124 SMUELLER
122 NUFFIN
117 BINGOS
111 GUGOD
109 MARCEL
100 TOKUHIROM
SELECT store_name, CASE store_name
WHEN 'Los Angeles' THEN sales*2
WHEN 'San Diego' THEN sales*1.5
ELSE sales
END AS new_sales
FROM store;
my @store = (
{store_name=>'Los Angeles', sales=>100_000},
{store_name=>'San Diego', sales=>100_000},
{store_name=>'Anaheim', sales=>100_000}
);
for my $s (@store) {
printf "%s %d %d\n", $s->{store_name}, $s->{sales}, do {
local $_ = $s->{store_name};
if (/Angel/) { $s->{sales}*2 }
elsif ($_ eq 'San Diego') { $s->{sales}*1.5 }
else { $s->{sales} }
};
}for my $s (@store) {
printf "%s %d %d\n", $s->{store_name}, $s->{sales}, do {
my $tmp;
given($s->{store_name}) {
when (/Angel/) { $tmp = $s->{sales}*2 }
when ('San Diego') { $tmp = $s->{sales}*1.5 }
default { $tmp = $s->{sales} }
}
$tmp
};
}for my $s (@store) {
printf "%s %d %d\n", $s->{store_name}, $s->{sales}, sub {
given ($s->{store_name}) {
when (/Angel/) { return $s->{sales}*2 }
when ('San Diego') { return $s->{sales}*1.5 }
default { return $s->{sales} }
}
}->();
}
$ perl -MStorable=dclone -MData::Dumper -e'
print "Storable version = $Storable::VERSION\n";
$re = qr/abc/;
print Dumper $re;
print Dumper dclone $re;'
Storable version = 2.21
$VAR1 = qr/(?-xism:abc)/;
$VAR1 = bless( do{\(my $o = undef)}, 'Regexp' );
$ perl -MStorable=freeze -E'say "yikes" if freeze(qr/a/) eq freeze(qr/b/)'
yikes
$ perl -MData::Dumper -MStorable=dclone -MRegexp::Copy -E'say "Regexp::Copy version = $Regexp::Copy::VERSION"; say Dumper dclone([qr/a/, qr/b/])'
Regexp::Copy version = 0.06
$VAR1 = [
qr/(?-xism:b)/,
qr/(?-xism:b)/
];
$config = { foo=>'ujan', bar=>'kemarau' };
...
{
local $config->{foo} = 'blah';
sini();
sana();
}
print $config->{foo}; # 'ujan' lagi
use feature 'state';use feature ':5.10'; # jangan lupa kutipnya ya...sub config_vars {
[qw/
recurse_hash
recurse_array
parse_prefix
...
/]
}$ perl -le'sub f { [1,2,3,4,5,6,7,8,9,10] } print f for 1..5'
ARRAY(0x9d1c40)
ARRAY(0xa083c8)
ARRAY(0xa083b0)
ARRAY(0xa08398)
ARRAY(0xa08380)sub config_vars {
state $a = [qw/
recurse_hash
recurse_array
parse_prefix
...
/];
}$ perl -lE'sub f { state $f = [1,2,3,4,5,6,7,8,9,10] } print f for 1..5'
ARRAY(0x12ffc40)
ARRAY(0x12ffc40)
ARRAY(0x12ffc40)
ARRAY(0x12ffc40)
ARRAY(0x12ffc40)$ perl -MParse::BACKPAN::Packages -e'$p = Parse::BACKPAN::Packages->new(); printf "BACKPAN is %.1fGB\n", $p->size/1024/1024/1024'
BACKPAN is 12.4GB-noconfig command-line option in mplayer. But this has two drawbacks:prefix_merge({foo=>1, bar=>2}, {"!foo"=>undef, bar=>3, baz=>1});{bar=>3, baz=>1}! prefix tells Data::ModeMerge to do a DELETE mode merging. So the final result will lack the foo key.^):prefix_merge({"^bar"=>2, "^baz"=>1}, {bar=>3, "!baz"=>0, quux=>7});{bar=>2, baz=>1, quux=>7}bar and baz from being overriden/deleted/etc.+), CONCAT (prefix .), SUBTRACT (prefix -), as well as the plain ol' NORMAL/override (optional prefix *).[+ $foo +][+ do { local $escmode = 0; $foo } +]http://cpants.perl.org/dist/used_by/Your-DistName$ cat merge.yaml
foo: 1
bar: 2
<<:
baz: 3
$ perl -MYAML::Tiny -MFile::Slurp -e'print Dump Load(scalar read_file "merge.yaml")'
---
<<:
baz: 3
bar: 2
foo: 1
$ perl -MYAML -MFile::Slurp -e'print Dump Load(scalar read_file "merge.yaml")'
---
<<:
baz: 3
bar: 2
foo: 1
$ perl -MYAML::Syck -MFile::Slurp -e'print Dump Load(scalar read_file "merge.yaml")'
---
<<:
baz: 3
bar: 2
foo: 1
$ perl -MYAML::XS -MFile::Slurp -e'print Dump Load(scalar read_file "merge.yaml")'
---
<<:
baz: 3
bar: 2
foo: 1
$ ruby -ryaml -e'print YAML::load(File.open("merge.yaml").read).to_yaml'
---
baz: 3
foo: 1
bar: 2yaml and YAML::Syck both use why's syck library, which has not been updated for quite a while.
$ module-starter --module=Foo::Bar --author="Your Name" --email="you@example.com"Foo-Bar directory. Easy enough right?[!new]
author = Your Name
copyright_holder = Your Name
initial_version = 0.01
[!release]
user = YOUR-PAUSE-ID
password = YOUR-PAUSE-PASSWORDmodule-starter, you run dzil new to start your new distribution:$ dzil new Foo-BarFoo-Bar/, there's now just one file, dist.ini:name = Foo-Bar
version = 0.01
author = youruser
license = Perl_5
copyright_holder = youruser
[@Classic]dist.ini, as well as for adding some lines:name = Foo-Bar
version = 0.01
author = Your Name <you@example.com>
license = Perl_5
copyright_holder = Your Name
[@Classic]
[PodWeaver]
[ReadmeFromPod]$ mkdir -p lib/Foo tt/. Default tests generated from module-starter like 00-load.t might be a good start.Changes file. You can copy paste from the one generated by module-starter:0.01 2009-11-11
First version, released on an unsuspecting world.
lib/Foo/Bar.pm, here's what I use for template. You can just fill out the [[...]] parts:package Foo::Bar;
# ABSTRACT: [[Abstract of module]]
use strict;
use warnings;
[[YOUR CODE]]
1;
__END__
=head1 SYNOPSIS
[[YOUR SYNOPSIS]]
=head1 DESCRIPTION
[[YOUR DESCRIPTION]]
=cutlib/Foo/Bar.pm. Add some tests in t/. Add other files when needed.dzil test.dzil build. This will create Foo-Bar-0.01.tar.gz which contains all the necessary goodies of a standard classic distribution, like README, LICENSE, MANIFEST, META.yml, etc.dzil release. This will upload your module to CPAN. Sweet!dist.ini and $VERSION in your main module file. Don't forget to add an entry to Changes. Repeat dzil test, build, release.alias m='mplayer -fixed-vo -osdlevel 3'
alias mn='mplayer -fixed-vo -osdlevel 3 -nosound'
alias m11='m -speed 1.1'
alias m12='m -speed 1.2'
alias m20='m -xy 2'
alias m21='m20 -speed 1.1'
...
# k
#!/bin/bash
exec konsole "$@"
$ ln -s public p
$ ln -s proj/perl pp
$ ln -s sites/steven.builder.localdomain/www .
...
# in SAAS.pm
use Spanel::API::Account::Shared;
use Package::Alias 'SAAS'=>'Spanel::API::Account::Shared';
1;
$ perl -MSpanel::API::Account::Shared -e'Spanel::API::Account::Shared::foo()'
$ perl -MSpanel::API::Account::Shared=foo -e'foo()'
$ perl -MSAAS -e'Spanel::API::Account::Shared::foo()'
$ perl -MSAAS -e'SAAS::foo()'
$ perl -MSAAS=foo -e'foo()'
while (1) {
do_stuff;
do_some_checks;
do { warn error 1; last } if not OK;
do_more_stuff;
do_some_checks;
do { warn error 2; last } if not OK;
do_even_more_stuff;
do_some_checks;
do { warn error 3; last } if not OK;
...
#finally
last;
}do_stuff;
do_some_checks;
if (!OK) {
warn error 1;
} else {
do_more_stuff;
do_some_checks;
if (!OK) {
warn error 2;
} else {
do_even_more_stuff;
do_some_checks;
if (!OK) {
...
}
# finally
success!
}
}
while (1) { ... last ... } style is clearer and avoids extraneous indentation. The only thing biting me in the past when using this construct is that sometimes I forgot to add the final last, resulting in an infinite loop. But this series-of-checks-and-early-bail pattern happens so often in my code that the construct quickly became second nature.given-when)?
$? and $! in Perl. This has drawbacks of its own, like in multithreaded/reentrant code.($status, $result) = foo(...);
return ($status, $extra_info, $result);
$status is a 3-digit integer values, with values taken as much as possible from the HTTP spec: 200 means success, 4xx means generic "client side" (i.e. caller side) error like missing or invalid arguments, 404 means not found, 403 means forbidden, 5xx means error in the "server side" (our side, the sub side), 501 means unimplemented, and so on.$extra_info is a hashref which contains, well... extra info, like error string, debugging messages, or intermediate results. This is the equivalent of HTTP response headers. But it can be an undef too if the sub does not offer extra information. So it will avoid creating unnecessary hashref.$result is the actual result.my @resp = process_stuff(@stuffs);
if ($resp[0] != 200) {
die "Failed ($resp[1]{errstr})";
} else {
print "Number of stuffs input: ", scalar(@stuffs);
print "Number of stuffs processed: ", $resp[2];
}
my @resp = search_stuff($stuff);
if ($resp[0] == 404) {
die "Stuff $stuff not found";
} elsif ($resp[0] != 200) {
die "Failed";
} else {
print "Stuff $stuff found in $resp[2]";
}
if (wantarray) {
return ($status, $extra_info, $result);
} else {
return $result;
}my $result = foo(...); # don't care about status, assume always success
$self->logger_dump->trace(
"<!-- result of mech request #$i ($method ".Dump($args)."):\n".
$mech->response->status_line."\n".
$mech->response->headers->as_string."\n".
"-->\n".
$mech->content
);
$mech is a WWW::Mechanize object. I use $self->logger for "normal" log messages and $self->logger_dump specifically for dumping contents. Both the logger and logger_dump attributes can be supplied by the module user, e.g.:
my $ibank = Finance::Bank::ID::BCA->new(
...
logger => Log::Log4perl->get_logger("Messages"),
logger_dump => Log::Log4perl->get_logger("Dumps"),
);
log4perl.logger.Messages=TRACE, SCREEN, LOGFILE
log4perl.logger.Dumps=TRACE, LOGDIR
log4perl.appender.SCREEN=Log::Log4perl::Appender::ScreenColoredLevels
log4perl.appender.SCREEN.layout=PatternLayout
log4perl.appender.SCREEN.layout.ConversionPattern=[\%r] %m%n
log4perl.appender.LOGFILE=Log::Log4perl::Appender::File
log4perl.appender.LOGFILE.filename=/path/to/logs/main.log
log4perl.appender.LOGFILE.layout=PatternLayout
log4perl.appender.LOGFILE.layout.ConversionPattern=[\%d] %m%n
log4perl.appender.LOGDIR=Log::Dispatch::Dir
log4perl.appender.LOGDIR.dirname=/path/to/logs/dumps
log4perl.appender.LOGDIR.layout=PatternLayout
log4perl.appender.LOGDIR.layout.ConversionPattern=%m
;-p. Cuma, kode PHP-nya untuk kantor dan gak dirilis (dan mungkin gak akan pernah dirilis, karena saya males memaintain kode PHP utk publik).
As with a lot of coders out there, I've moved on from no source control, to CVS, to Subversion, and recently to one of the distributed ones. In fact, I tried both Bazaar and git roughly at the same time a couple of years back and have been quite comfortably using both to manage my projects.
Last week though, I've migrated all but one of my projects to git. The only bzr repository left is the one for $work where I want to avoid retraining people to use git since they are not coders.
I had no real complaints with bzr. Sure, it's generally slower than git, the repository size is slightly larger than git's, and branching is a bit more cumbersome than in git, but all of those have never bothered me enough to part with bzr.
The clincher, however, came when I needed to write some post-commit hook to post my commit messages to an internal web-based bulletin board. In bzr you need to write a plugin written in Python. Not that there's anything wrong with it, but I don't think I even want a Perl-based SCM where I need to write a Perl plugin for everything when a two-line shell script will do. Add to that fact that bzr doesn't provide a template/skeleton for the plugin and I have to spend a few minutes to google around the plugin API (in addition to refreshing my memory on Python syntax), etc.
I think I'm much more comfortable with git nowadays.
Yup, garing abis judulnya, tapi yang kepikir dalam 10 detik cuma itu sih.
Blog ini pertama dibuat untuk ikutan Perl Iron Man Blogging Challenge. Karena gw gak yakin bisa keep up ngeblog sendirian seminggu sekali (tepatnya, 4 post dalam 32 hari) maka gw buat nama blog ini mewakili komunitas Perl Indonesia.
Bila Anda cinta/suka Perl, ingin berbagi tentang Perl, atau sedang belajar Perl, saya harapkan mau ikut bergabung ngeblog di blog ini. Posting boleh dalam bahasa Indonesia maupun English. Gak harus murni tentang Perl, yang kira-kira cuma 10-20% berhubungan dengan Perl juga gpp. Dan sekali-kali OOT juga no problem. Bahasa gak harus resmi, yang penting enak dibaca dan komunikatif. Level post gak harus advanced, semua level diterima.
Berminat? Silakan hubungi Steven di: steven2 setrip id setrip perl et masterweb titik net. Nanti 'tak tambahkan akun Google Anda ke dalam daftar anggota tim blog ini supaya bisa ikutan ngepost. Yuk?
Buat para pembaca, enjoy dan doakan kita2x!