daisuke@beefcake ~$ perlbrew list
  perl-5.12.2
  perl-5.12.2-threaded
  perl-5.12.3
  perl-5.12.3-threaded
* perl-5.14.0-RC1
  perl-5.8.9
  /usr/local/bin/perl (5.8.9)
  /usr/bin/perl (5.10.0)

return {
    app_id => "XXX your app ID",
    secret  => "XXX your app secret"
};

use strict;
use Data::Dumper;
use Facebook::Graph;
use Plack::Request;

my $config = require "config.pl";
my $fb = Facebook::Graph->new(
    app_id => $config->{app_id},
    secret => $config->{secret},
    postback => "http://localhost:5000/"
);

return sub {
    my $env = shift;
    my $req = Plack::Request->new($env);

    if ( my $code = $req->param('code') ) {
      warn "requesting access_token";
        $fb->request_access_token( $code );
        my $dump = Dumper({
            %$config,
            access_token => $fb->access_token
        });
        $dump =~ s/\$VAR = //;

        open my $fh, '>', "config.pl" or
            die;
        print $fh $dump;
        close $fh;
        return [ 200, [], [ $fb->access_token ] ];
    }
      warn "redirect";

    return [
        302,
        [
            Location => $fb->authorize
                ->extend_permissions( "publish_stream" )

                ->uri_as_string
        ],
        []
    ];
}

use strict;
use Text::Xslate;
use JSON;
use Coro;
use Coro::Select;
use Furl::HTTP;
use Facebook::Graph;
use Data::Dumper::Concise;

my $config = require "config.pl";
my $fb = Facebook::Graph->new(
    app_id => $config->{app_id},
    secret => $config->{secret},
    access_token => $config->{access_token},
);
my $data = $fb->query->find("me/friends")->request->as_hashref;

my $furl = Furl::HTTP->new;
my @coros;
foreach my $friend ( @{ $data->{data} } ) {
    my $q = $fb->query->find( "$friend->{id}/feed" );
    push @coros, async {
        my (undef, $code, undef, undef, $body ) = $furl->get( $q->uri_as_string 
);
        return unless $code eq 200;
        return decode_json $body;
    } $q->uri_as_string;
}

my @spots;
foreach my $coro (@coros) {
    my $feed = $coro->join;
    next unless $feed;
    foreach my $entry ( @{ $feed->{data} } ) {
        if ( $entry->{caption} eq 'tou.ch' ) {
            push @spots, $entry->{link};
        }
    }

}

my $xslate = Text::Xslate->new(
    path => [ "." ],
    syntax => 'TTerse',
);

print $xslate->render_string( <<'EOM', { spots => \@spots } );
<script type="text/javascript" src="jquery-1.5.2.min.js">
<script type="text/javascript">
var urls = [ [% FOREACH spot IN spots %]"[% spot %]"[% IF ! loop.last %],[% END %][% END %] ];

$(document).ready( function() {
    var delay = 200;
    var f = function() {
        url = urls.pop();
        url = url.replace( /\/$/, "" );
        url = url.replace(/\/spot/, "/widget/spot");
        var iframe = $('<iframe frameborder="0" scrolling="no" allowtransparency="ture" height="321" width="350" src="' + url + '?i=0&m=1&t=blue&width=350"></iframe>');
        $("#container").append( iframe );
        setInterval(f, delay);
    };
    f();
} );

</script>
<div id="container"></div>
EOM

タグ ：

#cpan

#Facebook

#Perl

#perlcasual

     while ( $loop ) {
         my $sth = $dbh->prepare( .... );
         $sth->execute();
         while ( $sth->fetchrow_arrayref ) {
              ....
         }
     }

    use POSIX qw(:signal_h); # import SIGINT, SIGTERM, and other signal related stuff

    my $sth; # declare now to make it accessible
    my $sigset = POSIX::SigSet->new( SIGINT ); # specify which sig we're handling
    my $cancel = POSIX::SigAction->new(sub { # the handler
        if ( $loop ) {
            eval { $sth->cancel };
            eval { $dbh->disconnect };
            $loop = 0;
        }
    }, $sigset, &POSIX::SA_NOCLDSTOP);
    POSIX::sigaction( SIGINT, $cancel ); # register them handler

    while( $loop ) {
        $sth = $dbh->prepare( ... );
        $sth->execute();
        while ( $sth->fetchrow_arrayref ) {
             ....
        }
     }

use strict;
use Benchmark qw(cmpthese);

cmpthese -1, {
    sysread => sub {
        my $buf;
        open my $fh, '<', __FILE__; 
        sysread $fh, $buf, -s __FILE__;
    },
    slurp_local => sub {
        local $/;
        open my $fh, '<', __FILE__;
        my $buf = <$fh>;
    }
};

     open my $fh, '<', "/path/to/file.txt"
         or die "failed to open file: $!";
     my $content = do { local $/; <$fh> };

     open my $fh, '<', "/path/to/file.txt"
         or die "failed to open file: $!";
     my @lines = split /\n/, do { local $/; <$fh> };

    open my $fh, '<', "/path/to/file.txt"
         or die "failed to open file: $!";
    while (my $ln = <$fh>) {
         ....
    }

     InactiveDestroy => 1

    AutoInactiveDestory => 1