パスワードを忘れた? アカウント作成
452784 journal

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
}
この議論は賞味期限が切れたので、アーカイブ化されています。 新たにコメントを付けることはできません。
typodupeerror

ソースを見ろ -- ある4桁UID

読み込み中...