WoW — гребем достижения в ЖЖ
Суть проста — выгрести из Армори последние ачивы, проверить — не постили ли раньше, запостить в ЖЖ.
Накидалось на коленке, я использую БД в расширенной версии скрипта — но решил и такой мелкий написать :)
UPD — чёт ппц криво получился этот сниппет в опубликованном виде. Аттачу ссылку на оригинал.
Plain-Text
#!/usr/bin/perl -w
use strict;
use Digest::MD5 qw[md5_hex];
use WWW::Curl::Easy;
use LJ::Simple; # Ставится из CPAN - cpan install LJ::Simplemy $wow_realm = q[Дракономор]; # Игровой реалм
my $wow_char = q[Юмаш]; # Имя на реалме
my $lj_login = q[дас юзернейм]; # Логин жежешечки
my $lj_pass = q[der пароль]; # Пароль в жежешечку
my @tag_list = qw (wow); # Теги записи - через пробел
my $lj_subject = q[Мои достижения в WoW]; # Заголовок записиmy $tmp_file = q[/tmp/wow.achieve.tmp]; # Чтоб ачивы не дублировались.
# Для винды - C:\\tmp\\wow.tmp, например
eval{`touch $tmp_file`}; # Потрогаем файлик, если его ещё нет.
# Завернуто в eval чтоб не гадил в stdout, если директория недоступна для записи
if (!-w $tmp_file){ # Ну тут очевидно :)
die (q[File $tmp_file недоступен для записи. Он нужен для того, чтобы не дублировались записи с ачивами.]);
}my $entry = q[]; # Тут будет сама запись
my $href = qq[http://eu.wowarmory.com/character-feed.atom?r=$wow_realm&cn=$wow_char&locale=ru_RU];
my $result = 'false'; # Это - для курла, хендл курловской багиopen my $oldout, «>&STDOUT» or die «Can't dup STDOUT: $!»;
close STDOUT;
open STDOUT, «> /dev/null»;
my $retcode;my $curl;
{
$curl = new WWW::Curl::Easy;
$curl->setopt (CURLOPT_URL, $href);
$curl->setopt (CURLOPT_CONNECTTIMEOUT, 60);
$curl->setopt (CURLOPT_TIMEOUT, 60);
$curl->setopt (CURLOPT_NOPROGRESS, 0);
$curl->setopt (CURLOPT_PROGRESSFUNCTION, sub {$_[2]>1_000_000?1:0});
$curl->setopt (CURLOPT_USERAGENT,q[AchieveBotGrabber 1.0]);
open (my $tmp_for_curl, «>», \$result);
$curl->setopt (CURLOPT_FILE,$tmp_for_curl);
$retcode = $curl->perform;
}close STDOUT;
open STDOUT, «>&», $oldout or die «Can't dup \$oldout: $!»;if ($retcode == 0 && $curl->getinfo (CURLINFO_HTTP_CODE) == 200){
my $old_achieves = {};
if (-e $tmp_file){
open FF,"<$tmp_file";
while (<FF>){
chop;
$old_achieves->{$_} = 1;
}
close FF;
}
open FF, «>$tmp_file»;
while ($result =~ /<entry>\s*.*?<updated>(\d{4}\-\d{2}\-\d{2}) T.*?<content type="html">(.*?)<\/content/ismg){
my $date = $1;
my $achieve = $2;
$achieve =~ s/\<!\[CDATA\[//;
$achieve =~ s/ class="achievement staticTip"//;
$achieve =~ s/\]>//;
$achieve =~ s/ id=[^"]«+»//;
my $achieve_md5 = md5_hex $achieve;
print FF qq[$achieve_md5
];
next if exists $old_achieves->{$achieve_md5};
$entry .= qq[$date — $achieve<br>];
}
close FF;
exit if $entry =~ /^\s*$/;
my %Results = ();
my %Event=();
my $lj = new LJ::Simple ({
user => $lj_login,
pass => $lj_pass,
site => undef,
});
(defined $lj) || die "$LJ::Simple::error
";
$lj->NewEntry (\%Event) || die "$LJ::Simple::error
";
$lj->Setprop_backdate (\%Event,1) || die "1 $LJ::Simple::error
";
$lj->SetSubject (\%Event, $lj_subject) || die "2 $LJ::Simple::error
";
$lj->Setprop_taglist (\%Event, @tag_list) || die "3 $LJ::Simple::error
";
$lj->SetEntry (\%Event,$entry) || die "5 $LJ::Simple::error
";
my ($item_id, $anum, $html_id) = $lj->PostEntry (\%Event);
(defined $item_id) || die "6 $LJ::Simple::error
";
print qq[http://$lj_login.livejournal.com/$html_id.html
];
}