dsegの日記: hatena 日記全消去スクリプト、v0.1
日記 by
dseg
#!/usr/bin/perl -w
#
# Title: hatena_rmjournals.pl
# About: tiny script to cleanup journal entries
# on http://d.hatena.ne.jp/<username>/
# Author: dseg <ds26 at mail.goo.ne.jp>
# $Id: hatena_rmjournals.pl,v 0.1 2003-12-21 15:17:55+09 dseg Exp dseg $
require 5;
use strict;
no strict 'vars';
use Fcntl qw/:DEFAULT :seek/;
use Getopt::Std;
use LWP::UserAgent;
use HTTP::Request::Common qw/POST/;
# --- Global variable ------------------------------------------------
use vars qw/$base_url/;
$base_url = 'http://d.hatena.ne.jp/';
# --- Parse command-line ---------------------------------------------
getopts('u:p:');
usage() and exit unless $opt_u && $opt_p;
# --- Try to login ---------------------------------------------------
my $ua = new LWP::UserAgent(
timeout=>10,
cookie_jar => {
file => 'hatena_cookie.txt',
autosave => 1,
hide_cookie2 => 1,
},
);
die "Failed to login to $base_url" unless hatena_login($ua, $opt_u, $opt_p);
# --- Login succeeded, auto-download whole journals as .CSV ----------
my $csv_dl_url = "${base_url}${opt_u}/source";
my $req = POST $csv_dl_url, [ submit => 'ダウンロード' ];
$ua->cookie_jar->add_cookie_header($req);
my $res = $ua->request($req);
my $csvname = sprintf '%s-%s_%s.csv', $opt_u, &now =~ /^(\d{8})(\d{6})$/;
sysopen(F_CSV, $csvname, O_RDWR | O_CREAT) or die "$!\n";
print F_CSV $res->content;
seek F_CSV, 0, SEEK_SET;
# skip first line
$_ = <F_CSV>;
my $date;
while(<F_CSV>) {
if(/^(\d\d\d\d-\d\d-\d\d),/) {
$date = $1;
$date =~ tr/-//d;
$req = POST "${base_url}${opt_u}/edit",
[ date => $date,
mode => 'delete',
edit => 'この日を削除',
];
$req->header('Referrer' => "${base_url}${opt_u}/edit?date=$date");
$res = $ua->request($req);
unless($res->is_error) {
print "entry successfully deleted: $date\n"
} else {
print STDERR "\tentry cannot be deleted: $date\n";
}
sleep 1;
}
}
exit;
# --- Subroutines ----------------------------------------------------
sub hatena_login {
my ($ua, $username, $password) = @_;
my $req = POST 'http://d.hatena.ne.jp/login',
[ key => $username,
password => $password,
submit => 'ログイン',
];
my $res = $ua->request($req);
if($res->is_redirect) {
$ua->cookie_jar->extract_cookies($res);
$ua->cookie_jar->save();
# $url = $res->header('Location');
} else {
warn "Warning: $res->status_line\n";
return 0;
}
1;
}
sub now {
sprintf '%04d%02d%02d%02d%02d%02d',
sub{($_[5]+1900, $_[4]+1, $_[3]), $_[2], $_[1], $_[0]}->(localtime);
}
sub usage {
print <<'USAGE';
delete_hatena_journal.pl -u <username> -p <password>
USAGE
}
#
# Title: hatena_rmjournals.pl
# About: tiny script to cleanup journal entries
# on http://d.hatena.ne.jp/<username>/
# Author: dseg <ds26 at mail.goo.ne.jp>
# $Id: hatena_rmjournals.pl,v 0.1 2003-12-21 15:17:55+09 dseg Exp dseg $
require 5;
use strict;
no strict 'vars';
use Fcntl qw/:DEFAULT :seek/;
use Getopt::Std;
use LWP::UserAgent;
use HTTP::Request::Common qw/POST/;
# --- Global variable ------------------------------------------------
use vars qw/$base_url/;
$base_url = 'http://d.hatena.ne.jp/';
# --- Parse command-line ---------------------------------------------
getopts('u:p:');
usage() and exit unless $opt_u && $opt_p;
# --- Try to login ---------------------------------------------------
my $ua = new LWP::UserAgent(
timeout=>10,
cookie_jar => {
file => 'hatena_cookie.txt',
autosave => 1,
hide_cookie2 => 1,
},
);
die "Failed to login to $base_url" unless hatena_login($ua, $opt_u, $opt_p);
# --- Login succeeded, auto-download whole journals as .CSV ----------
my $csv_dl_url = "${base_url}${opt_u}/source";
my $req = POST $csv_dl_url, [ submit => 'ダウンロード' ];
$ua->cookie_jar->add_cookie_header($req);
my $res = $ua->request($req);
my $csvname = sprintf '%s-%s_%s.csv', $opt_u, &now =~ /^(\d{8})(\d{6})$/;
sysopen(F_CSV, $csvname, O_RDWR | O_CREAT) or die "$!\n";
print F_CSV $res->content;
seek F_CSV, 0, SEEK_SET;
# skip first line
$_ = <F_CSV>;
my $date;
while(<F_CSV>) {
if(/^(\d\d\d\d-\d\d-\d\d),/) {
$date = $1;
$date =~ tr/-//d;
$req = POST "${base_url}${opt_u}/edit",
[ date => $date,
mode => 'delete',
edit => 'この日を削除',
];
$req->header('Referrer' => "${base_url}${opt_u}/edit?date=$date");
$res = $ua->request($req);
unless($res->is_error) {
print "entry successfully deleted: $date\n"
} else {
print STDERR "\tentry cannot be deleted: $date\n";
}
sleep 1;
}
}
exit;
# --- Subroutines ----------------------------------------------------
sub hatena_login {
my ($ua, $username, $password) = @_;
my $req = POST 'http://d.hatena.ne.jp/login',
[ key => $username,
password => $password,
submit => 'ログイン',
];
my $res = $ua->request($req);
if($res->is_redirect) {
$ua->cookie_jar->extract_cookies($res);
$ua->cookie_jar->save();
# $url = $res->header('Location');
} else {
warn "Warning: $res->status_line\n";
return 0;
}
1;
}
sub now {
sprintf '%04d%02d%02d%02d%02d%02d',
sub{($_[5]+1900, $_[4]+1, $_[3]), $_[2], $_[1], $_[0]}->(localtime);
}
sub usage {
print <<'USAGE';
delete_hatena_journal.pl -u <username> -p <password>
USAGE
}
hatena 日記全消去スクリプト、v0.1 More ログイン