#!/usr/local/bin/perl # $Id$ # # Copyright (c) 2007 Daisuke Maki <[email protected]> # All rights reserved. use strict; use warnings; use Gungho; use Gungho::Request; use GunghoX::FollowLinks; use URI; main(); sub main { my $site = $ARGV[0]; $site = URI->new($site) unless eval { $site->isa('URI') } && !$@; Gungho->run({ provider => sub { my ($p, $c) = @_; if (! $p->{started}) { $c->send_request( Gungho::Request->new( GET => $site ) ); $p->{started} = 1; } else { my $requests = $p->requests; while (my $request = shift @$requests) { $request->uri->fragment(undef); # Make sure to use the original hostname my $original_uri = $request->original_uri; if ( $p->{seen}{$original_uri->as_string}++ ) { next; } $c->send_request( $request ); } } return 1; }, handler => sub { my ($h, $c, $req, $res) = @_; $c->follow_links($res); print STDERR "Fetched ", $res->request->uri->as_string, "\n"; }, components => [ '+GunghoX::FollowLinks', 'RobotRules', 'Throttle::Simple', ], throttle => { simple => { max_items => 1000, interval => 3600, } }, follow_links => { parsers => [ { module => "HTML", config => { merge_rule => "ALL", rules => [ { module => "HTML::SelectedTags", config => { tags => [ qw(a link) ] } }, { module => "URI", config => { match => [ { scheme => qr/^http$/i, host => $site->host, path => "^" . ($site->path || "/"), action_nomatch => "FOLLOW_DENY" } ] } }, { module => "MIME", config => { types => [ qw(text/html) ], unknown => "FOLLOW_ALLOW", } }, ] } } ] } }); }

use URI; use URI::Match; my $uri = URI->new("http://www.endeworks.jp"); if ($uri->match_parts( host => qr{^.+\.endeworks\.jp$},, path => qr{^/$} ) ){ # match }

# config components: - FollowLink follow_link: strategies: - module: IgnoreHost sites: - regex: \.amazon\.co.\.jp$ - module: FollowIfAnotherConditionMet # Handler code sub handle_response { my ($self, $c, $req, $res) = @_; $c->follow_link($res); }

sub new($$) { my($sClass, $sTxt) = @_; $errStr =''; my $oThis = {}; bless $oThis; return undef if($errStr = $oThis->init($sTxt)); return $oThis; }

package MyBarcode; use strict; use base qw(GD::Barcode::EAN13); sub new { my $class = shift; my $self = $class->SUPER::new(@_); bless $self, $class; return $self; }

sub plot($;%) { my($oThis, %hParam) = @_; #Barcode Pattern my $sPtn = $oThis->barcode(); #Create Image my $iHeight = ($hParam{Height})? $hParam{Height} : 50; my($oGd, $cBlack); if($hParam{NoText}) { ($oGd, $cBlack) = GD::Barcode::plot($sPtn, length($sPtn), $iHeight, 0, 0); } else { my($fW,$fH) = (GD::Font->Tiny->width,GD::Font->Tiny->height); my $iWidth = length($sPtn)+$fW+1; ($oGd, $cBlack) = GD::Barcode::plot($sPtn, $iWidth, $iHeight, $fH + 1, $fW+1); $oGd->string(GD::Font->Tiny, 0, $iHeight - $fH, substr($oThis->{text}, 0, 1), $cBlack); $oGd->string(GD::Font->Tiny, $fW +8 , $iHeight - $fH, substr($oThis->{text}, 1, 6), $cBlack); $oGd->string(GD::Font->Tiny, $fW +55, $iHeight - $fH, substr($oThis->{text}, 7, 6), $cBlack); } return $oGd; }

use Data::Decode; use Data::Decode::Chain; use Data::Decode::Encode::Guess; use Data::Decode::Encode::HTTP::Response; my $response = $ua->get($url); my $decoder = Data::Decode->new( strategy => Data::Decode::Chain->new( Data::Decode::Encode::HTTP::Response->new(), decoders => [ Data::Decode::Encode::Guess->new( encodings => [ qw(euc-jp sjis jis utf8) ] ), ] ) ); my $decoded_content = $decoder->decode( $response->content, { response => $response } );