Firefox の履歴を一覧表示する Perl スクリプト

Perl を始めて 2 ヶ月弱になりますが、それなりに動くものができたので、貼付けてみます。

これは、Firefox の履歴を一覧表示する Perl スクリプトです。24 時間以内に参照した URL の一覧を表示する、というようなことができます。ふと普段利用しているネットサービスを集計したくなったので作りました。

Firefox の履歴ファイルを取得する処理は、Mozilla::Backup を使用しており、Windows 2000 + Firefox 2 と OSX + Firefox 2 で動作するのを確認しました。

help

help はこんな感じです。

  -c, --count                履歴数のみを表示する
  -k, --key=KEY              指定したキーのみを表示する
                               (KEY=ID|URL|NAME|Hostname|FirstVisitDate|
                                LastVisitDate|VisitCount)
  -b, --boundary=HOUR        対象になる履歴を時間で指定する(デフォルト値は 24 )
  -u, --urllength=LENGTH     表示する URL の文字数を指定する(デフォルト値は 60 )
      --noheader             ヘッダを表示しない
  -v, --verbose              File::Mork を verbose モードで使用する
  -d, --debug                デバッグモードを指定する

使い方

オプションなしで実行すると、次のように 24 時間以内の履歴が表示されます。

$ ./firefoxhistory.pl 
ID     URL                                                          LastVisitDate                  VisitCount 
------ ------------------------------------------------------------ ------------------------------ ---------- 
24DA   http://b.hatena.ne.jp/entry/http://gigazine.net/index.php?/n Sat May 26  1:55:31 2007       -          
24D9   http://b.hatena.ne.jp/entry/http://phpspot.org/blog/archives Sat May 26  1:55:20 2007       -          


24 時間だと結構あるので、1 時間以内の履歴をみたい場合は、-b を使用します。逆に全てを対象にするには -b=0 と指定します。

$ ./firefoxhistory.pl -b=1


件数だけを見たい場合は、-c を使います。

$ ./firefoxhistory.pl -c  
51 histories.


基本的には、これだけの機能ですが、他に 60 文字じゃ URL がよく分からないよって時は、-u に文字数を指定します。

$ ./firefoxhistory.pl -u=70
ID     URL                                                                    LastVisitDate                  VisitCount 
------ ---------------------------------------------------------------------- ------------------------------ ---------- 
24DA   http://b.hatena.ne.jp/entry/http://gigazine.net/index.php?/news/commen Sat May 26  1:55:31 2007       -          
24D9   http://b.hatena.ne.jp/entry/http://phpspot.org/blog/archives/2007/05/p Sat May 26  1:55:20 2007       -          


特定のキーだけを見たい場合は、-k を使います。この場合は途中で切れません。

$ ./firefoxhistory.pl -k=URL
http://b.hatena.ne.jp/entry/http://gigazine.net/index.php?/news/comments/20070524_google_illegal/
http://b.hatena.ne.jp/entry/http://phpspot.org/blog/archives/2007/05/post_129.html


キーは、コロンで区切って複数指定すると、一覧表示と同じように出力されます。

$ ./firefoxhistory.pl -k=URL:VisitCount
URL                                                          VisitCount 
------------------------------------------------------------ ---------- 
http://b.hatena.ne.jp/entry/http://gigazine.net/index.php?/n -          
http://b.hatena.ne.jp/entry/http://phpspot.org/blog/archives -          


あとは、パイプと組み合わせれば、よく使ってるホストのランキングを知ることができます。

$ ./firefoxhistory.pl -k=Hostname -b=0 | sort | uniq -c | sort -r
 103 google.co.jp
  47 mail.google.com
  44 mixi.jp
  19 google.com
  18 edit.yahoo.com
  17 twitter.com
  15 flickr.com
  12 b.hatena.ne.jp
  11 spreadsheets.google.com
  10 dic.yahoo.co.jp
   9 d.hatena.ne.jp


他にも、一日のうちで一番ネットに接続している時間帯を見るなんてこともできるんじゃないかと思います。
そんなわけで、コードは次の通りです。

firefoxhistory.pl

#!/usr/local/bin/perl -w
use strict;

use Getopt::Long;
use File::Mork;
use Time::CTime qw{ctime_n};
use Mozilla::Backup;

my %context = ();

sub get_options {
    # default
    my %options = (
	'header' => 1,
	'boundary' => 24,
	'urllength' => 60,
    );
    
    GetOptions(
	?%options,
	'verbose',		# for File::Mork
	'list',
	'debug',
	'count',
	'header!',
	'boundary=i',
	'key=s',
	'urllength=i',
    );

    %context = (%context, %options);
}

sub initialize {
    my $moz = Mozilla::Backup->new();
    my $ini = $moz->type( type => 'firefox' );
    
    $context{filename} = $ini->profile_path('default') . '/history.dat';
    $context{colmun_length} = {
	ID => 6,
	URL => $context{urllength},
	FirstVisitDate => 30,
	LastVisitDate => 30,
	VisitCount => 10,
	Hostname => 50,
	NAME => 60,
    };
}

sub init_mork {
    -e $context{filename} or die;
    my $verbose = $context{verbose};
    my $boundary = $context{boundary};

    my $age = $boundary ? 60 * 60 * $boundary : undef;

    my $mork = File::Mork->new($context{filename}, verbose => $verbose, age => $age)
	or die $File::Mork::ERROR . "?n";

    return $mork;
}

sub execute {
    my $mork = shift;
    
    if( $context{list} ) {
	&execute_list($mork);
    }
    elsif( $context{count} ) {
	&execute_count($mork);
    }
    elsif( $context{key} ) {
	&execute_key($mork);
    }
    else {
	# default
	&execute_list($mork);
    }
}

sub execute_list {
    my $mork = shift;

    my @colmuns = qw{ ID URL LastVisitDate VisitCount };

    &list_entries($mork, @colmuns);
}

sub execute_count {
    my $mork = shift;
    printf( "%d histories.?n", scalar(@{$mork->{entries}}) );
}

sub execute_key {
    my $mork = shift;
    my @keys = split ':', $context{key};

    if(@keys == 1) {
	foreach my $entry ($mork->entries) {
		print $entry->{$keys[0]} ? $entry->{$keys[0]} : '-';
		print "?n";
	}
    }
    else{
	&list_entries($mork, @keys);
    }
}

sub list_entries {
    my ($mork, @colmuns) = @_;
    
    my $format;
    my $header_line;
    
    foreach my $key ( @colmuns ) {
	$format .= "%-${context{colmun_length}->{$key}}s ";
	$header_line .= '-' x $context{colmun_length}->{$key} . ' ';
    }

    if($context{header}) {
	printf( $format . "?n", @colmuns );
	print $header_line . "?n";
    }
    
    foreach my $entry ($mork->entries) {
	my @values = map {
	    $entry->{$_} ? substr(
		index($_, 'Date') >= 0 ? ctime_n($entry->{$_}) : $entry->{$_},
		0,
		$context{colmun_length}->{$_}) : '-'
	    } @colmuns;
	    
	printf($format . "?n", @values);
    }

    &execute_count($mork) if &is_debug();
}

sub is_debug {
    return $context{debug};
}

sub main {
    &get_options();
    &initialize();
    my $mork = &init_mork();
    &execute($mork);
}

&main();

"?n" と表示されているのは改行で "?" をバックスラッシュに置き換えて下さい。なんで "?" になるんだろう。

感想

Perl らしい書き方というのを意識したが、いまいちうまくいかない箇所がいくつかありました。「Perlベストプラクティス」などを読んで早く慣れたいところです。