January 06, 2012
How to make group_by_in_perl?
purl in your heart
group_by_in_perl ()
{
perl -F\\t -lane 'BEGIN{$group_by=shift; $sum_by=shift} END { print for map{ join qq(\t), $_, $sum{$_}} keys %sum } $sum{join qq(\t), @F[eval($group_by)]} += $F[eval($sum_by)]' $*
}
BJ in snowing
December 27, 2011
xml-table-maker for Windows
purl in your heart
perl -e "use Win32::Clipboard; use DBIx::XHTML_Table; Win32::Clipboard::Set(DBIx::XHTML_Table->new(q(dbi:Oracle),qq(@ARGV))->exec_query(eval <STDIN>)->modify(table=>{border=>1, bordercolor=> q(#888888), cellspacing=>0})->output())"
December 04, 2011
Plack::Middleware::FileWrap
Fayland And Programming
December 03, 2011
git submodule
Fayland And ProgrammingWhen you include another open source in your own project, it's usually pretty hard to keep it up to date. it becomes even more harder if you have some modification on it.
kindergarden> git submodule add https://github.com/twitter/bootstrap.git static/bootstrapkindergarden> git add .gitmodules static/bootstrapkindergarden> git commit -a -m "remote bootstrap"kindergarden> git pushkindergarden> git submodule init
kindergarden$ git submodule initkindergarden$ git submodule update
December 01, 2011
2011 CN Perl Advent
Fayland And ProgrammingHi, it's time for advent again!
November 29, 2011
我们为你们所存的盼望是确定的
purl in your heart
PDC: 圣经说，爱是个习惯
| ||
The Bible Says Love Is a Habit 圣经说，爱是个习惯 | ||
“If you love those who love you, what credit is that to you? Even sinners love those who love them.” (Luke 6:32 NIV) 你们若单爱那爱你们的人，有什么可酬谢的呢？就是罪人也爱那爱他们的人。路加福音 6:32 If you only love on and off like a light switch, you do not love others like God wants you to love. Jesus said, “If you only love those who love you, what credit is that to you?” (Luke 6:32a NIV) 如果你的爱像电灯一样时开时关，那么你就没有按照神的心意去（活出�的）爱了。所以，耶稣这样说：“你们若单爱那爱你们的人，有什么可酬谢的呢？”（路加福音 6:32） His point is this: All of us can love those who love us back. Becoming a master lover means you learn to love the unlovable � when you love people who don’t love you, when you love people who irritate you, when you love people who stab you in the back or gossip about you. 他的意思是：我们每个人都能做的，就是爱那些知恩图报的人。而你若想要成为一个有博爱之心的人，就得学着去爱那些不可爱的人。也就是，去爱那些不爱你的人，包括那些常常触怒你的人，或是那些在你背后指指点点、说长道短的人。 This may seem like an impossible task, and it is � that’s why we need God’s love in us, so we can then love others: “We know and rely on the love God has for us” (1 John 4:16a NIV). 如果这听上去有点象天方夜谭，那你其实是清醒的。因为，无私的付出爱，并且一味的坚持，这真的需要神的爱先充满我们的心。所以，圣经这样说：“神爱我们的心，我们也知道也信”（约翰一书 4:16）。 When you realize how much God loves you � with an extravagant, irresistible, unconditional love � then his love will change your entire focus on life. If we don’t receive God’s love for us, we’ll have a hard time loving other people. I’m talking about loving people who are unlovely, difficult, irritable, and those who are different or demanding. 当你认识到神对自己的爱有多么丰盛、多么的坚忍、多么的无私，那么�的爱就能改变你对生命的关注点。如果我们不去接受神给我们的爱，那么关爱他人就是一件太难太难的事。注意，这里我们说的仍然是爱那些不可爱的、满是困难的、易于激怒人的、与常人迥异的、常常不满足的人。 You can’t do that until you have God’s love coming through you. You need to know God’s love so it can overflow out of your life into others. 没有神的爱在你心里运行，这些就真的太难了。你必须去认识神的爱，这样你的心里才能充满�的爱，直到这爱开始满溢，涌流出来，进入他人的生命中。 |
November 27, 2011
KinderGarden
Fayland And Programmingas talked yesterday, I get it uploaded into github. well, under PerlChina. https://github.com/PerlChina/kindergarden
November 26, 2011
Dancer::Template::Xslate
Fayland And ProgrammingI'm writing some toy once again with Plack and Dancer (and Mojo later).
Note there is always more than one way to do it.# config.ymltemplate: xslateengines:xslate:syntax: 'TTerse'extension: 'tt'header:- 'layout/header.tt'footer:- 'layout/footer.tt'module:- KinderGardenX::Text::Xslate::Bridge::KinderGarden# KinderGardenX::Text::Xslate::Bridge::KinderGardenpackage KinderGardenX::Text::Xslate::Bridge::KinderGarden;use strict;use warnings;use parent qw(Text::Xslate::Bridge);use Gravatar::URL;my %funtion_methods = (gravatar_url => \&gravatar_url,);__PACKAGE__->bridge(function => \%funtion_methods,);1;# template<img src="[% gravatar_url( email => user.email, size => 30) %]" /><img src="[% gravatar_url( email => user.email, size => 50) %]" /><img src="[% gravatar_url( email => user.email) %]" />
November 08, 2011
new baby
Fayland And ProgrammingI'm very happy to share the good news with all the world. my second kid, another boy, was born today. 9:45am Beijing Time, Nov 8th, 2011. 2800g. and everything is good. Thanks.
November 06, 2011
Psalm 16:7
purl in your heart
October 25, 2011
po4a for the translation of Perldoc
purl in your heart
To make a translation of perldoc, use the tool named po4a
[jjiang@fedora14 ~]$ pmvers Locale::Po4a::TransTractor
0.41
[jjiang@fedora14 ~]$ po4a-gettextize --help-format
List of valid formats:
- dia: uncompressed Dia diagrams.
- docbook: DocBook XML.
- guide: Gentoo Linux's XML documentation format.
- ini: INI format.
- kernelhelp: Help messages of each kernel compilation option.
- latex: LaTeX format.
- man: Good old manual page format.
- pod: Perl Online Documentation format.
- sgml: either DebianDoc or DocBook DTD.
- texinfo: The info page format.
- tex: generic TeX documents (see also latex).
- text: simple text document.
- wml: WML documents.
- xhtml: XHTML documents.
- xml: generic XML documents (see also docbook).
[jjiang@fedora14 ~]$ perldoc -l perlretut
/usr/share/perl5/pod/perlretut.pod
[jjiang@fedora14 ~]$ po4a-gettextize -f pod -m $(perldoc -l perlretut) | tee perlretut.po | wc -l
5155
[jjiang@fedora14 ~]$ vim perlretut.po
…
#. type: =head1
#: /usr/share/perl5/pod/perlretut.pod:1
msgid "NAME"
msgstr "名称"
#. type: textblock
#: /usr/share/perl5/pod/perlretut.pod:3
msgid "perlretut - Perl regular expressions tutorial"
msgstr "perlretut - Perl 正则表达式指南"
#. type: =head1
#: /usr/share/perl5/pod/perlretut.pod:5
msgid "DESCRIPTION"
msgstr "简介"
#. type: textblock
#: /usr/share/perl5/pod/perlretut.pod:7
msgid ""
"This page provides a basic tutorial on understanding, creating and using "
"regular expressions in Perl. It serves as a complement to the reference "
"page on regular expressions L<perlre>. Regular expressions are an integral "
"part of the C<m//>, C<s///>, C<qr//> and C<split> operators and so this "
"tutorial also overlaps with L<perlop/\"Regexp Quote-Like Operators\"> and "
"L<perlfunc/split>."
msgstr ""
"这篇文章用来介绍 Perl 正则表达式的解读、编写和使用方面的基础知识。相对于 L<perlre> 中的介绍来说，这篇文章更加侧重于提供一些增补知识。正则表达式，它是 C<m//>, C<s///>, C<qr//> 和 C<split> 这些操作符的主要兴趣所在，因此L<perlop/\"Regexp Quote-Like Operators\"> 和 L<perlfunc/split> 里面也有许多相关的描述。"
…
[jjiang@fedora14 ~]$ po4a-translate -k 0 -f pod -m $(perldoc -l perlretut) -p perlretut.po | less
October 20, 2011
Non-stop debugging of perl programs
purl in your heart
Package -e.
in @=main::abc(0) from -e:1
out @=main::abc(0) from -e:1
list context return from main::abc:
0 1
in @=main::abc(3) from -e:1
out @=main::abc(3) from -e:1
list context return from main::abc:
0 4
1 4
October 19, 2011
PDC:慷慨也是信心的表现
purl in your heart
| ||
Generosity is a Matter of Faith慷慨也是信心的表现 | ||
A generous man will prosper and he who refreshes others will himself be refreshed. Proverbs 11:25 (NIV) When you share with others, God shares with you. 当你与他人分享的时候，神也会与你分享。 The world says, “Get everything you can and you will be financially secure.” The Bible says share with others in need and you’ll sow what you reap: “Give and it will be given to you.” (Luke 6:38 NIV) 这个世界的逻辑是“尽可能的攫取，这样你就会富有”，而圣经的原则是要尽可能的与他人分享，这样你就会有丰厚的回报：“你们要给人，就必有给你们的”(路加福音 6:38) God says that when you give to somebody else, you're not throwing it away. It’s an investment in the lives of others. God says the one who gives will gain even more: “He who is kind to the poor, lends to the Lord and He will reward him for what he has done.” (Proverbs 19:17 NIV) 在神的眼中，当你给予别人的时候，并不是在舍弃什么，而是对其他人的生命进行投资。神会对那些慷慨付出的人给予更多回报：“怜悯贫穷的，就是借给耶和华。他的善行，耶和华必偿还”（箴言 19:17） When you see people in need and you give to them, God looks at this as if it were a loan to Him. He says, “I will reward back.” 所以，当你向那些需要的人伸出援手的时候，神会把这看成是对�自己的一次借贷。�就这样想：“我必须偿还他”。 God is always going to take care of you and your needs. Do you believe that is true? Generosity is a matter of faith. Will you take God at his Word? 神总是想要帮助你，满足你的需要。你相信这个道理么？慷慨也是信心的一种表现。你要不要在这个方面顺服神的吩咐呢？ |
October 13, 2011
remove/add job to crontab by commandline
Fayland And Programming1. add job to crontab
October 11, 2011
Psalm 118:24
purl in your heart
September 29, 2011
sphinx 0.99 bug (attributes count vs fields count)
Fayland And Programmingwhen you have 4 columns in sql_query, and you want 3 columns as attributes. you'll get a failure. 0 size sphinx files.
OK. actually 'dumb' is dumb because it takes more disk than 'a'.SELECT id, radians(longitude) as long_radians, radians(latitude) as lat_radians, 'dumb' FROM table
Draw the Cross in Unicode
purl in your heart
✞
September 25, 2011
Script to find the root directory usage, on system with lots of mounts
purl in your heart
sudo perl -MList::MoreUtils=any -lne 'BEGIN{@m=map {@F=split; qq(^$F[2])} map {$1 if m{(.*)}} qx{mount|tail --line=+2}; open STDIN, q(find / -maxdepth 3 -mindepth 1 |)} $p=$_; do {print join qq(\t), qx(du -s "$_")=~m{(.*)}} unless any {$p=~m{$_} or $_=~m{$p}} @m' | sort -k1 -nrg | head
Net-GitHub 0.40_02
Fayland And Programmingit's a story following the previous one. and this one will be shorter.
sub __build_methods {my $package = shift;my %methods = @_;foreach my $m (keys %methods) {my $v = $methods{$m};my $url = $v->{url};my $method = $v->{method} || 'GET';my $args = $v->{args} || 0; # args for ->querymy $check_status = $v->{check_status};my $is_u_repo = $v->{is_u_repo}; # need auto shift u/repo$package->meta->add_method( $m => sub {my $self = shift;# count how much %s inside umy $n = 0; while ($url =~ /\%s/g) { $n++ }## if is_u_repo, both ($user, $repo, @args) or (@args) should be supportedif ( ($is_u_repo or index($url, '/repos/%s/%s') > -1) and @_ < $n + $args) {unshift @_, ($self->u, $self->repo);}# make url, replace %s with real argsmy @uargs = splice(@_, 0, $n);my $u = sprintf($url, @uargs);# args for json data POSTmy @qargs = $args ? splice(@_, 0, $args) : ();if ($check_status) { # need check Response Statusmy $old_raw_response = $self->raw_response;$self->raw_response(1); # need check headermy $res = $self->query($method, $u, @qargs);$self->raw_response($old_raw_response);return index($res->header('Status'), $check_status) > -1 ? 1 : 0;} else {return $self->query($method, $u, @qargs);}} );}}
September 24, 2011
Net-GitHub 0.40_01
Fayland And Programmingit's a quite long story. but it's all about Net::GitHub
use Net::GitHub;my $gh = Net::GitHub->new( login => 'fayland', pass => 'secret' );my $data = $gh->query('/user');$gh->query('PATCH', '/user', { bio => 'another Perl Programmer and Father' });$gh->query('DELETE', '/user/emails', [ 'myemail@somewhere.com' ]);
2. more than half of the Github API is binded with :user/:repo. but it will be really very boring to type user/repo for every call.sub emails { (shift)->query('/user/emails'); }
I kicked out the version to public today. but there are still a lot of stuff missing. I released it because I want to hear some feedback from the users. below are some todos.$gh->set_default_user_repo('fayland', 'perl-net-github');my @issues = $gh->issue->issues;my @pulls = $gh->pull_request->pulls;# or one-off callmy @contributors = $gh->respo->contributors($user, $repo);
September 23, 2011
SQLite related 2 utilities, to fix the book & chapter names problems of Blackberry YouVersion bible reader
purl in your heart
SQLite.pl
#!/usr/bin/perl -w
use strict;
use DBI;
my @r;
my $d=DBI->connect(qq(dbi:SQLite:dbname=@{[shift]}), q(), q());
my $s=$d->prepare_cached(join q(),<STDIN>);
$s->execute(@ARGV);
$,=qq(\t); $\=qq(\n);
print STDERR @{$s->{NAME}}; print @r while @r=$s->fetchrow_array;
$s->finish; $d->disconnect;
Do-SQLite-for.pl
#!/usr/bin/perl -w
use strict;
use DBI;
my $d=DBI->connect(qq(dbi:SQLite:dbname=@{[shift]}), q(), q());
my $s= $d->prepare_cached(do { open(SQL, q(<), shift); join(q(),<SQL>) });
$,=qq(\t); $\=qq(\n);
while(<>) {
chomp;
my @F = split(qq(\t), $_, -1);
$s->execute(@F);
}
$s->finish; $d->disconnect; close SQL;
September 22, 2011
print raw TT2 syntax
Fayland And Programming
The tricky is TAGS: http://search.cpan.org/perldoc?Template#TAGS
[% a = 1 %]
var [% a %] blabla;
[% TAGS <$ $> %]
var [% a %] blabla
<$ TAGS [% %] $>
var [% a %] blabla;
var 1 blabla;
var [% a %] blabla
var 1 blabla;
September 15, 2011
1John 2:28
purl in your heart
September 13, 2011
Sample of XML::Dumper, working with xslt
purl in your heart
<?xml version="1.0" encoding="ISO-8859-1"?>
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
<xsl:template match="/perldata/hashref">
<html>
<body>
<table border="1">
<tr>
<th>Key</th>
<th>Value</th>
</tr>
<xsl:for-each select="item">
<tr>
<td><xsl:value-of select="@key"/></td>
<td><xsl:value-of select="."/></td>
</tr>
</xsl:for-each>
</table>
</body>
</html>
</xsl:template>
</xsl:stylesheet>
$ perl -MXML::Dumper -le 'print pl2xml(\%INC)' | xsltproc perlhash.xsl - | w3m -T text/html
September 10, 2011
pipeline for top 100 repeated word list in article/book
purl in your heart
perl -MList::MoreUtils=natatime -lane ’END{ $it = natatime 100, sort {$cnt{$b} <=> $cnt{$a}} keys %cnt; print for map {join qq(\t), $_, $cnt{$_}} $it->() } $cnt{$_}++ for @F’
September 08, 2011
Using this to find the depending module in a quick and dirty way
purl in your heart
{
pmpath $* | perl -MList::MoreUtils=uniq -lne 'BEGIN{$m=shift} print for sort map {($_)=$_=~m{(.*)}} uniq grep {!m{$m}} qx(grep -h ^use.*:: @{[s{\.pm$}{} && $_]}/*.pm)' $*
} $ basedon XML::XSH2
use File::Spec;
use File::Temp qw(tempfile tempdir);
use Filter::Simple;
use IO::File;
use Module::Compile -base;
use Parse::RecDescent;
use Scalar::Util;
use Tie::Scalar;
use URI::file;
use XML::LibXML::Iterator;
use XML::LibXML::NodeList;
use XML::LibXML;
use base qw(XML::LibXML::Iterator);$ basedon XML::LibXML
use IO::File;
use XML::SAX::Base;
use base qw(XML::SAX::Base);
September 07, 2011
DELETE post with Facebook::Graph
Fayland And ProgrammingFacebook::Graph doesn't provide DELETE method by default. but we can do it for sure. below is one sample code:
Note we have to set Content-Length to 0. or we'll get 400 Bad Request.use Facebook::Graph;use LWP::UserAgent;use HTTP::Request::Common ();my $fb = Facebook::Graph->new(app_id => $app_id,secret => $app_sec,postback => $postback_url,);my $uri = $fb->query->find($post_id)->uri_as_string;my $req = HTTP::Request::Common::DELETE($uri);$req->header('Content-Length', 0);my $response = LWP::UserAgent->new->request($req);
September 01, 2011
The pstree map of "zgrep abc /tmp/*.gz | wc -l"
purl in your heart
August 30, 2011
get unique content from duplicated *.tar.gz contents
purl in your heart
#!/usr/bin/perl -wln
$fn = $_;
do{ @F=split; $uniq{join qq(\t), @F[3,4,2]}||= join qq(\t), $fn, $F[5] } for grep {!m{^d}} map{ m{(.*)} } qx(zcat $_ | tar -tv);
END{ print join qq(\t), $_, $uniq{$_} for sort keys %uniq }
August 27, 2011
Ezekiel 3:10
purl in your heart
August 23, 2011
Mark 11:23
purl in your heart
August 21, 2011
HTML::Table in one-liner
purl in your heart
August 19, 2011
Mark 8:36
purl in your heart
August 12, 2011
tips for snaked
Fayland And ProgrammingI'm giving snaked a try today. it's my first time to try it. and I heard it from last year's CN Perl Advent: http://advent.perlchina.org/2010/snaked.html
August 10, 2011
MySQL two tips
Fayland And Programming
August 02, 2011
主祷文
purl in your heart
July 26, 2011
nohup-tee-tail-mail.pl
purl in your heart
#!/usr/bin/perl
use POSIX;
BEGIN{($cmd, $out, $mail, $append)=@ARGV}
my $child=fork;
die $! unless defined $child;
exit 0 if $child;
setsid;
close STDIN; #, q(<), q(/dev/null);
open STDERR, q(>&), STDERR;
open STDOUT, q(|-), qq(tee @{[$append && q(-a )]}$out|tail|mail -s $out $mail);
exec $cmd;
July 16, 2011
耶利米书 17:8
purl in your heart
July 11, 2011
从您的黑莓手机上获取圣经
purl in your heart
July 10, 2011
Habakkuk 2:2
purl in your heart
July 08, 2011
Jeremiah 11:19
purl in your heart
Jeremiah 11:7
July 01, 2011
Acts 2:28
purl in your heart
John 14:13
June 24, 2011
Children's Day, in office dinner room
purl in your heart
P&W 我心尊主为大
June 23, 2011
Philemon 1:16
purl in your heart
Titus 3:5
Titus 3:2
Proverbs 24:12
June 21, 2011
Psalm 93:4
purl in your heart
Esther 4:14
Song To The King by Pocket full of rocks
Song To The King
I've felt the thunder
speak of Your name
And I've watched the lightning
Your glory proclaim
I've gazed upon mountains
that testify of Your fame
And I've heard the waves on the ocean
echo their refrain
This is my song, my song to the King
And I stand in awe of Your majesty
And I don't have much
but I give everything
This is my song, my song to my King
It seems all creation
is longing for You
From here to the farthest star
they're worshipping You
And who am I God
that You are mindful of me
I'm simple in heart, simple in song
I'm a small offering
(chorus:)
And all of creation hesitates now
All of the angels
stop singing now
As the King of all glory
listens to my song
(chorus)
June 20, 2011
rotate vertical PDF 270 degrees into PNG, for the wide screen devices
purl in your heart
#!/usr/bin/perl -w
use CGI;
my $q = CGI->new;
my $f = $q->upload('upfile');
print "Content-Type: image/png\n\n";
open PDF, q(>), q(/tmp/t.pdf);
print PDF while (<$f>);
close PDF;
system qq(convert /tmp/t.pdf -rotate 270 /tmp/t.png);
print qx(cat /tmp/t.png);
Proverbs 19:27
Psalm 92:2
Song of Solomon 1:4
2 Timothy 3:11
