Index: /lang/perl/Mozilla-Screenshot/trunk/t/02_proxy.t
===================================================================
--- /lang/perl/Mozilla-Screenshot/trunk/t/02_proxy.t (revision 114)
+++ /lang/perl/Mozilla-Screenshot/trunk/t/02_proxy.t (revision 114)
@@ -0,0 +1,29 @@
+use strict;
+use Test::Base;
+
+unless ($ENV{HTTP_PROXY}) {
+    plan skip_all => '$ENV{HTTP_PROXY} is not defined';
+}
+else {
+    plan tests => 3;
+}
+
+use Mozilla::Screenshot;
+
+my $moz = Mozilla::Screenshot->new({
+    profile_dir  => 't',
+    profile_name => 'proxy',
+    env_proxy    => 1,
+});
+
+my $pixbuf = $moz->fetch('http://www.google.co.jp/');
+ok $pixbuf;
+is ref($pixbuf) => 'Gtk2::Gdk::Pixbuf';
+
+my $image = $pixbuf->save_to_buffer('png');
+ok length($image) > 0;
+
+END {
+    require Path::Class::Dir;
+    Path::Class::Dir->new('t/proxy')->rmtree;
+}
Index: /lang/perl/Mozilla-Screenshot/trunk/t/00_compile.t
===================================================================
--- /lang/perl/Mozilla-Screenshot/trunk/t/00_compile.t (revision 114)
+++ /lang/perl/Mozilla-Screenshot/trunk/t/00_compile.t (revision 114)
@@ -0,0 +1,4 @@
+use strict;
+use Test::More tests => 1;
+
+BEGIN { use_ok 'Mozilla::Screenshot' }
Index: /lang/perl/Mozilla-Screenshot/trunk/t/91_podcoverage.t
===================================================================
--- /lang/perl/Mozilla-Screenshot/trunk/t/91_podcoverage.t (revision 114)
+++ /lang/perl/Mozilla-Screenshot/trunk/t/91_podcoverage.t (revision 114)
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
Index: /lang/perl/Mozilla-Screenshot/trunk/t/01_fetch.t
===================================================================
--- /lang/perl/Mozilla-Screenshot/trunk/t/01_fetch.t (revision 114)
+++ /lang/perl/Mozilla-Screenshot/trunk/t/01_fetch.t (revision 114)
@@ -0,0 +1,28 @@
+use strict;
+use Test::More;
+
+if ($ENV{HTTP_PROXY}) {
+    plan skip_all => '$ENV{HTTP_PROXY} is defined';
+}
+else {
+    plan tests => 3;
+}
+
+use Mozilla::Screenshot;
+
+my $moz = Mozilla::Screenshot->new({
+    profile_dir  => 't',
+    profile_name => 'fetch',
+});
+
+my $pixbuf = $moz->fetch('http://www.google.co.jp/');
+ok $pixbuf;
+is ref($pixbuf) => 'Gtk2::Gdk::Pixbuf';
+
+my $image = $pixbuf->save_to_buffer('png');
+ok length($image) > 0;
+
+END {
+    require Path::Class::Dir;
+    Path::Class::Dir->new('t/fetch')->rmtree;
+}
Index: /lang/perl/Mozilla-Screenshot/trunk/t/90_pod.t
===================================================================
--- /lang/perl/Mozilla-Screenshot/trunk/t/90_pod.t (revision 114)
+++ /lang/perl/Mozilla-Screenshot/trunk/t/90_pod.t (revision 114)
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
Index: /lang/perl/Mozilla-Screenshot/trunk/t/92_podspell.t
===================================================================
--- /lang/perl/Mozilla-Screenshot/trunk/t/92_podspell.t (revision 114)
+++ /lang/perl/Mozilla-Screenshot/trunk/t/92_podspell.t (revision 114)
@@ -0,0 +1,9 @@
+use Test::More;
+eval q{ use Test::Spelling };
+plan skip_all => "Test::Spelling is not installed." if $@;
+add_stopwords(map { split /[\s\:\-]/ } <DATA>);
+local $ENV{LANG} = 'C';
+all_pod_files_spelling_ok('lib');
+__DATA__
+NAKAGAWA Masaki
+Mozilla::Screenshot
Index: /lang/perl/Mozilla-Screenshot/trunk/MANIFEST
===================================================================
--- /lang/perl/Mozilla-Screenshot/trunk/MANIFEST (revision 114)
+++ /lang/perl/Mozilla-Screenshot/trunk/MANIFEST (revision 114)
@@ -0,0 +1,12 @@
+Changes
+examples/screenshot-httpd.pl
+examples/screenshot-httpd-poe.pl
+lib/Mozilla/Screenshot.pm
+lib/Mozilla/Screenshot/Browser.pm
+Makefile.PL
+MANIFEST			This list of files
+META.yml
+README
+t/00_compile.t
+t/01_fetch.t
+t/02_proxy.t
Index: /lang/perl/Mozilla-Screenshot/trunk/lib/Mozilla/Screenshot.pm
===================================================================
--- /lang/perl/Mozilla-Screenshot/trunk/lib/Mozilla/Screenshot.pm (revision 114)
+++ /lang/perl/Mozilla-Screenshot/trunk/lib/Mozilla/Screenshot.pm (revision 114)
@@ -0,0 +1,152 @@
+package Mozilla::Screenshot;
+
+BEGIN {
+    PKGCONFIG: unless ($ENV{MOZILLA_FIVE_HOME}) {
+        eval { require ExtUtils::PkgConfig; 1 } or last PKGCONFIG;
+        my %pkg = ExtUtils::PkgConfig->find(
+            map { "$_-gtkmozembed" } qw( mozilla firefox mozilla-firefox )
+        );
+
+        if (my $libs = $pkg{libs}) {
+            $libs = [ split /\s+/ => $libs ]->[0];
+            $libs =~ s/^-L//;
+            $ENV{MOZILLA_FIVE_HOME} = $libs;
+        }
+    }
+}
+
+use strict;
+use warnings;
+use base qw(Class::Accessor::Fast);
+use Gtk2::MozEmbed;
+use Mozilla::Screenshot::Browser;
+use Mozilla::UserPreferences;
+use Path::Class::Dir;
+use Path::Class::File;
+use URI;
+
+our $VERSION = '0.01';
+
+__PACKAGE__->mk_accessors(qw(
+    browser display
+    width height profile_dir profile_name
+));
+
+sub new {
+    my $class = shift;
+    my %args  = %{ @_ ? $_[0] : {} };
+    my $self  = $class->SUPER::new({
+        display      => $ENV{DISPLAY},
+        width        => 800,
+        height       => 600,
+        profile_dir  => $class->_profile_dir,
+        profile_name => __PACKAGE__,
+        %args,
+    });
+
+    $self->profile_dir(Path::Class::Dir->new($self->profile_dir)->absolute);
+    Gtk2::MozEmbed->set_profile_path($self->profile_dir, $self->profile_name);
+    $self->env_proxy if $args{env_proxy};
+
+    return $self;
+}
+
+sub env_proxy {
+    my $self = shift;
+
+    my $proxy = URI->new($ENV{REQUEST_METHOD} ? $ENV{CGI_HTTP_PROXY} : $ENV{HTTP_PROXY});
+    return unless $proxy->scheme =~ /^https?$/;
+
+    my $file = $self->_prefs_js;
+    $file->dir->mkpath;
+    $file->touch;
+
+    # modify prefs.js
+    my $prefs = Mozilla::UserPreferences->new($file);
+    $prefs->set('network.proxy.http' => $proxy->host);
+    $prefs->set('network.proxy.http_port' => $proxy->port);
+    $prefs->set('network.proxy.share_proxy_settings' => 'true');
+    $prefs->set('network.proxy.type' => 1);
+    $prefs->set('network.proxy.no_proxies_on' => $ENV{NO_PROXY}) if $ENV{NO_PROXY};
+    $prefs->save($file);
+}
+
+sub fetch {
+    my ($self, $uri) = @_;
+
+    $self->_prepare_browser;
+    $self->browser->prepare_fetch(\my $pixbuf);
+    $self->browser->fetch($uri);
+    $self->_finalize_browser;
+
+    return $pixbuf;
+}
+
+sub _prepare_browser {
+    my $self = shift;
+
+    local $ENV{DISPLAY} = $self->display || $ENV{DISPLAY};
+
+    $self->browser(Mozilla::Screenshot::Browser->new({
+        width  => $self->width,
+        height => $self->height,
+    }));
+}
+
+sub _finalize_browser {
+    my $self = shift;
+    $self->browser(undef);
+}
+
+sub _profile_dir {
+    my $name = lc __PACKAGE__;
+    $name =~ s/::/-/g;
+    return sprintf '%s/.%s' => $ENV{HOME}, $name;
+}
+
+sub _prefs_js {
+    my $self = shift;
+    return Path::Class::File->new($self->profile_dir, $self->profile_name, 'prefs.js');
+}
+
+1;
+
+=head1 NAME
+
+Mozilla::Screenshot - perl module.
+
+=head1 SYNOPSIS
+
+    use Mozilla::Screenshot;
+    my $shot = Mozilla::Screenshot->new;
+
+    # $pixbuf is Gtk2::Gdk::Pixbuf
+    my $pixbuf = $shot->fetch('http://example.com');
+    $pixbuf->save(...);
+    $pixbuf->save_to_buffer(...)
+
+=head1 METHODS
+
+=head2 new([\%args])
+
+=head2 fetch($uri)
+
+=head2 env_proxy
+
+=head1 AUTHOR
+
+NAKAGAWA Masaki, C<< <masaki@cpan.org> >>
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<http://gtk2-perl.sourceforge.net/doc/pod/Gtk2/Gdk/Pixbuf.html>,
+L<Gtk2::MozEmbed>, L<Mozilla::DOM>, L<Mozilla::UserPreferences>
+
+=cut
+
+__DATA__
Index: /lang/perl/Mozilla-Screenshot/trunk/lib/Mozilla/Screenshot/Browser.pm
===================================================================
--- /lang/perl/Mozilla-Screenshot/trunk/lib/Mozilla/Screenshot/Browser.pm (revision 114)
+++ /lang/perl/Mozilla-Screenshot/trunk/lib/Mozilla/Screenshot/Browser.pm (revision 114)
@@ -0,0 +1,130 @@
+package Mozilla::Screenshot::Browser;
+
+use strict;
+use warnings;
+use base qw(Class::Accessor::Fast);
+use Glib qw(TRUE FALSE);
+use Gtk2;
+use Gtk2::MozEmbed;
+use List::Util qw(max);
+use Mozilla::DOM;
+use Mozilla::Screenshot;
+
+our $VERSION = $Mozilla::Screenshot::VERSION;
+our $WAITFOR = 5;
+
+__PACKAGE__->mk_accessors(qw( embed width height ));
+
+sub new {
+    my $self = shift->SUPER::new(@_);
+
+    Gtk2->init;
+    my $window = $self->_make_gtk_window;
+    my $embed  = $self->_make_moz_embed;
+
+    $window->add($embed);
+    $self->embed($embed);
+
+    return $self;
+}
+
+sub prepare_fetch {
+    my ($self, $rpixbuf) = @_;
+
+    my $embed = $self->embed;
+
+    $embed->signal_connect(net_stop => sub {
+        my $window = $self->window;
+
+        my $width  = max $self->width, $window->GetInnerWidth;
+        my $height = max $self->height, $window->GetScrollMaxY + $window->GetInnerHeight;
+        $embed->set_size_request($width, $height);
+
+        my $i = $WAITFOR;
+        Glib::Timeout->add(1000, sub {
+            return TRUE if --$i > 0;
+
+            $embed->stop_load;
+
+            $width  -= 16;
+            $height -= 16 if $window->GetScrollMaxX > 0;
+            $$rpixbuf = Gtk2::Gdk::Pixbuf->get_from_drawable(
+                $embed->window, undef, (0) x 4, $width, $height,
+            );
+
+            Gtk2->main_quit;
+            return FALSE;
+        });
+    });
+}
+
+sub fetch {
+    my ($self, $uri) = @_;
+
+    my $embed = $self->embed;
+    $embed->parent->show_all;
+    $embed->load_url($uri);
+    Gtk2->main;
+}
+
+sub window {
+    my $self = shift;
+    return $self->embed->get_nsIWebBrowser->GetContentDOMWindow->QueryInterface(
+        Mozilla::DOM::WindowInternal->GetIID
+    );
+}
+
+sub _make_gtk_window {
+    my $self = shift;
+
+    my $window = Gtk2::Window->new;
+    $window->set_title(__PACKAGE__);
+    $window->set_border_width(1);
+    $window->resize(10, 10);
+
+    $window->signal_connect(delete_event => sub { Gtk2->main_quit });
+
+    return $window;
+}
+
+sub _make_moz_embed {
+    my $self = shift;
+
+    my $embed = Gtk2::MozEmbed->new;
+    $embed->set_size_request($self->width + 16, $self->height);
+
+    return $embed;
+}
+
+1;
+
+=head1 NAME
+
+Mozilla::Screenshot::Browser - perl module.
+
+=head1 METHODS
+
+=head2 new
+
+=head2 prepare_fetch
+
+=head2 fetch
+
+=head2 window
+
+=head1 AUTHOR
+
+NAKAGAWA Masaki, C<< <masaki@cpan.org> >>
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<Mozilla::Screenshot>, L<Gtk2::MozEmbed>, L<Mozilla::DOM>
+
+=cut
+
+__DATA__
Index: /lang/perl/Mozilla-Screenshot/trunk/Makefile.PL
===================================================================
--- /lang/perl/Mozilla-Screenshot/trunk/Makefile.PL (revision 114)
+++ /lang/perl/Mozilla-Screenshot/trunk/Makefile.PL (revision 114)
@@ -0,0 +1,21 @@
+use inc::Module::Install;
+name     'Mozilla-Screenshot';
+all_from 'lib/Mozilla/Screenshot.pm';
+
+requires 'Class::Accessor::Fast';
+requires 'ExtUtils::PkgConfig';
+requires 'Glib';
+requires 'Gtk2';
+requires 'Gtk2::MozEmbed';
+requires 'List::Util';
+requires 'Mozilla::DOM';
+requires 'Mozilla::UserPreferences';
+requires 'Path::Class::Dir';
+requires 'Path::Class::File';
+requires 'URI';
+
+build_requires 'Path::Class::Dir';
+build_requires 'Test::More';
+use_test_base;
+auto_include;
+WriteAll;
Index: /lang/perl/Mozilla-Screenshot/trunk/Changes
===================================================================
--- /lang/perl/Mozilla-Screenshot/trunk/Changes (revision 114)
+++ /lang/perl/Mozilla-Screenshot/trunk/Changes (revision 114)
@@ -0,0 +1,4 @@
+Revision history for Perl extension Mozilla::Screenshot
+
+0.01    2007-09-11T01:38:40+09:00
+        - original version
Index: /lang/perl/Mozilla-Screenshot/trunk/MANIFEST.SKIP
===================================================================
--- /lang/perl/Mozilla-Screenshot/trunk/MANIFEST.SKIP (revision 114)
+++ /lang/perl/Mozilla-Screenshot/trunk/MANIFEST.SKIP (revision 114)
@@ -0,0 +1,17 @@
+\bRCS\b
+\bCVS\b
+^MANIFEST\.
+^Makefile$
+~$
+\.old$
+^blib/
+^pm_to_blib
+^MakeMaker-\d
+\.gz$
+\.cvsignore
+\.shipit
+^t/9\d_.*\.t
+^inc/
+\.svn/
+^#
+\._
Index: /lang/perl/Mozilla-Screenshot/trunk/README
===================================================================
--- /lang/perl/Mozilla-Screenshot/trunk/README (revision 114)
+++ /lang/perl/Mozilla-Screenshot/trunk/README (revision 114)
@@ -0,0 +1,27 @@
+This is Perl module Mozilla::Screenshot.
+
+INSTALLATION
+
+Mozilla::Screenshot installation is straightforward. If your CPAN shell is set up,
+you should just be able to do
+
+    % cpan Mozilla::Screenshot
+
+Download it, unpack it, then build it as per the usual:
+
+    % perl Makefile.PL
+    % make && make test
+
+Then install it:
+
+    % make install
+
+DOCUMENTATION
+
+Mozilla::Screenshot documentation is available as in POD. So you can do:
+
+    % perldoc Mozilla::Screenshot
+
+to read the documentation online with your favorite pager.
+
+NAKAGAWA Masaki
Index: /lang/perl/Mozilla-Screenshot/trunk/examples/screenshot-httpd.pl
===================================================================
--- /lang/perl/Mozilla-Screenshot/trunk/examples/screenshot-httpd.pl (revision 114)
+++ /lang/perl/Mozilla-Screenshot/trunk/examples/screenshot-httpd.pl (revision 114)
@@ -0,0 +1,75 @@
+#!/usr/bin/perl
+
+BEGIN {
+    unless ($ENV{DISPLAY}) {
+        die q"can't find DISPLAY ($ENV{DISPLAY})";
+    }
+}
+
+use strict;
+use warnings;
+use Pod::Usage qw(pod2usage);
+use Getopt::Long qw(GetOptions);
+use Socket qw(INADDR_LOOPBACK inet_ntoa);
+use HTTP::Daemon;
+use HTTP::Status;
+use HTTP::Response;
+use Mozilla::Screenshot;
+
+GetOptions(
+    'h|help'    => sub { pod2usage 1 },
+    'p|port=i'  => \ (my $port = 3000),
+    'x|proxy=s' => \ my $proxy,
+) or pod2usage 1;
+
+$ENV{HTTP_PROXY} = $proxy if $proxy;
+
+my $browser = Mozilla::Screenshot->new({ env_proxy => $ENV{HTTP_PROXY} ? 1 : 0 });
+
+my $daemon = HTTP::Daemon->new(
+    LocalAddr => inet_ntoa(INADDR_LOOPBACK),
+    LocalPort => $port,
+);
+
+while (my ($c, $address) = $daemon->accept) {
+    while (my $req = $c->get_request) {
+        my $res = HTTP::Response->new;
+        $res->protocol('HTTP/1.0');
+        $res->request($req);
+        $res->date(time);
+        $res->header(Connection => 'close');
+
+        if (my $uri = $req->header('Content-Location')) {
+            my $image;
+            eval { $image = $browser->fetch($uri)->save_to_buffer('png') };
+            $@ ? $res->code(RC_INTERNAL_SERVER_ERROR) : do {
+                $res->code(RC_OK);
+                $res->content_type('image/png');
+                $res->content_length(length $image);
+                $res->content($image);
+            };
+        }
+        else {
+            $res->code(RC_BAD_REQUEST);
+        }
+
+        $c->send_response($res);
+    }
+}
+
+__END__
+
+=head1 NAME
+
+screenshot-httpd.pl - sample screenshot httpd with HTTP::Daemon
+
+=head1 SYNOPSIS
+
+screenshot-httpd.pl [options]
+
+ Options:
+   -h --help      display this help and exits
+   -p --port      port (defaults to 3000)
+   -x --proxy     proxy (defaults to $ENV{HTTP_PROXY})
+
+=cut
Index: /lang/perl/Mozilla-Screenshot/trunk/examples/screenshot-httpd-poe.pl
===================================================================
--- /lang/perl/Mozilla-Screenshot/trunk/examples/screenshot-httpd-poe.pl (revision 114)
+++ /lang/perl/Mozilla-Screenshot/trunk/examples/screenshot-httpd-poe.pl (revision 114)
@@ -0,0 +1,139 @@
+#!/usr/bin/perl
+
+BEGIN {
+    unless ($ENV{DISPLAY}) {
+        die q"can't find DISPLAY ($ENV{DISPLAY})";
+    }
+}
+
+use strict;
+use warnings;
+use Pod::Usage qw(pod2usage);
+use Getopt::Long qw(GetOptions);
+use Class::Inspector;
+use Socket qw(INADDR_LOOPBACK);
+use IO::Poll;
+use HTTP::Response;
+use HTTP::Status;
+use Mozilla::Screenshot;
+
+use POE qw(
+    Sugar::Args
+    Wheel::SocketFactory
+    Wheel::ReadWrite
+    Wheel::Run
+    Filter::Stream
+    Filter::HTTPD
+    Component::TSTP
+);
+
+GetOptions(
+    'h|help'    => sub { pod2usage 1 },
+    'p|port=i'  => \ (my $port = 3000),
+    'x|proxy=s' => \ my $proxy,
+) or pod2usage 1;
+
+$ENV{HTTP_PROXY} = $proxy if $proxy;
+
+POE::Component::TSTP->create;
+
+POE::Session->create(
+    inline_states  => {
+        _start => sub { sweet_args->kernel->yield('server_start') },
+    },
+    package_states => [ main => Class::Inspector->methods('main') ],
+    heap           => { port => $port },
+);
+
+POE::Kernel->sig($_ => sub { POE::Kernel->stop }) for qw( INT TERM HUP );
+POE::Kernel->run;
+exit;
+
+sub server_start {
+    my $poe = sweet_args;
+
+    $poe->heap->{server} = POE::Wheel::SocketFactory->new(
+        BindAddress  => INADDR_LOOPBACK,
+        BindPort     => $poe->heap->{port},
+        SuccessEvent => 'server_accept',
+        FailureEvent => 'server_error',
+        Reuse        => 'on',
+    );
+
+    $poe->heap->{ua} = Mozilla::Screenshot->new({ env_proxy => $ENV{HTTP_PROXY} ? 1 : 0 });
+}
+
+sub server_accept {
+    my $poe = sweet_args;
+
+    my $connection = POE::Wheel::ReadWrite->new(
+        Handle       => $poe->args->[0],
+        InputEvent   => 'client_input',
+        FlushedEvent => 'client_flush',
+        ErrorEvent   => 'client_error',
+        Filter       => POE::Filter::HTTPD->new,
+    );
+
+    $poe->heap->{connection}->{$connection->ID} = $connection;
+}
+
+sub server_error { delete sweet_args->heap->{server} }
+
+sub client_input {
+    my $poe = sweet_args;
+    my $req = $poe->args->[0];
+
+    my $res = HTTP::Response->new;
+    $res->protocol('HTTP/1.0');
+    $res->request($req);
+    $res->date(time);
+    $res->header(Connection => 'close');
+
+    if (my $uri = $req->header('Content-Location')) {
+        my $image;
+        eval { $image = $poe->heap->{ua}->fetch($uri)->save_to_buffer('png') };
+        $@ ? $res->code(RC_INTERNAL_SERVER_ERROR) : do {
+            $res->code(RC_OK);
+            $res->content_type('image/png');
+            $res->content_length(length $image);
+            $res->content($image);
+        };
+    }
+    else {
+        $res->code(RC_BAD_REQUEST);
+    }
+
+    $poe->heap->{connection}->{$poe->args->[1]}->put($res);
+}
+
+sub client_flush {
+    my $poe = sweet_args;
+    $poe->kernel->yield(client_close => $poe->args->[0]);
+}
+
+sub client_close {
+    my $poe = sweet_args;
+    delete $poe->heap->{connection}->{$poe->args->[0]};
+}
+
+sub client_error {
+    my $poe = sweet_args;
+    $poe->kernel->yield(client_close => $poe->args->[3]);
+}
+
+__END__
+
+=head1 NAME
+
+screenshot-httpd-poe.pl - sample screenshot httpd with POE
+
+=head1 SYNOPSIS
+
+screenshot-httpd-poe.pl [options]
+
+ Options:
+   -h --help      display this help and exits
+   -p --port      port (defaults to 3000)
+   -x --proxy     proxy (defaults to $ENV{HTTP_PROXY})
+
+=cut
