Fayland and Programming /usr/bin/

I'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.

1. add job to crontab

when you have 4 columns in sql_query, and you want 3 columns as attributes. you'll get a failure. 0 size sphinx files.

SELECT id, radians(longitude) as long_radians, radians(latitude) as lat_radians, 'dumb' FROM table

OK. actually 'dumb' is dumb because it takes more disk than 'a'.

it's a story following the previous one. and this one will be shorter.## build methods on fly

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 ->query

        my $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 u

            my $n = 0; while ($url =~ /\%s/g) { $n++ }

            

            ## if is_u_repo, both ($user, $repo, @args) or (@args) should be supported

            if ( ($is_u_repo or index($url, '/repos/%s/%s') > -1) and @_ < $n + $args) {

                unshift @_, ($self->u, $self->repo);

            }

            # make url, replace %s with real args

            my @uargs = splice(@_, 0, $n);

            my $u = sprintf($url, @uargs);

            

            # args for json data POST

            my @qargs = $args ? splice(@_, 0, $args) : ();

            if ($check_status) { # need check Response Status

                my $old_raw_response = $self->raw_response;

                $self->raw_response(1); # need check header

                my $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);

            }

        } );

    }

}

it'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', [ [email protected]' ]);

sub emails { (shift)->query('/user/emails'); }

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.

$gh->set_default_user_repo('fayland', 'perl-net-github');

my @issues = $gh->issue->issues;

my @pulls    = $gh->pull_request->pulls;

# or one-off call

my @contributors = $gh->respo->contributors($user, $repo);

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.

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;

Facebook::Graph doesn't provide DELETE method by default. but we can do it for sure. below is one sample code:

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);

Note we have to set Content-Length to 0. or we'll get 400 Bad Request.

I'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

that's not new and many people may already know it. but it's really very helpful when some SQL locked.

tip 1. use -A to start faster

if mysql somedatabase command didn't return mysql> for you. you really can try it with -A. that loads faster.

tip 2: set pager for large result.

mysql> pager less;

so that if you do 'SHOW FULL PROCESSLIST' that you can find the exact one you want without scrolling back or missing anything.

for sure it can be configured into ~/.my.cnf like

[mysql]

pager=less -inFX

prompt='(\u@\h) [\d]> '

Thanks for Alex who sharing it.

BerkeleyDB is quit popular and nice to use.

use FindBin qw/$Bin/;

use BerkeleyDB;

my $berkeleydb_temp_file = "$Bin/tmp.berkeleydb"; # temp file for BerkeleyDB

tie my %data, 'BerkeleyDB::Hash',

    -Filename => $berkeleydb_temp_file,

    -Flags    => DB_CREATE|DB_TRUNCATE

        or die "Cannot create file: $! $BerkeleyDB::Error\n";

open(my $fh, '<', 'RealBigFile.log') or die "Can't open: $!";

while (my $line = <$fh>) {

    ## some code that %data will be a real very big hash

    ## we just need the first line and the last line which matches the $pattern

    my $pattern = get_pattern($line);

    if (exists $data{"start_$pattern"}) {

        $data{"end_$pattern"} = $line;

    } else {

        $data{"start_$pattern"} = $line;

    }

}

close($fh);

# now working on the %data

Case B: in forks

[email protected]:~/git/fayland.org/blogs$ perl right-forks-BerkeleyDB.t

ok 1

1..1

[email protected]:~/git/fayland.org/blogs$ perl wrong-forks-BerkeleyDB.t

not ok 1

#   Failed test at wrong-forks-BerkeleyDB.t line 30.

#          got: '656'

#     expected: '1000'

1..1

# Looks like you failed 1 test of 1.

[email protected]:~/git/fayland.org/blogs$ perl right-forks-BerkeleyDB.t

ok 1

1..1

[email protected]:~/git/fayland.org/blogs$ perl wrong-forks-BerkeleyDB.t

not ok 1

#   Failed test at wrong-forks-BerkeleyDB.t line 30.

#          got: '661'

#     expected: '1000'

1..1

# Looks like you failed 1 test of 1.

my $env = new BerkeleyDB::Env

    -Home   => $tmp_dir,

    -Flags  => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL

        or die "cannot open environment: $BerkeleyDB::Error\n";

my $db = tie my %data, 'BerkeleyDB::Hash',

    -Filename => $berkeleydb_temp_file,

    -Flags    => DB_CREATE,

    -Env      => $env

        or die "Cannot create file: $! $BerkeleyDB::Error\n";

my $lock = $db->cds_lock();

$data{$i} = $i * 2;

$db->db_sync();

$lock->cds_unlock();

BerkeleyDB is not only for Hash, it also supports Btree, Recno, Queue and others.