Суть проста — выгрести из Армори последние ачивы, проверить — не постили ли раньше, запостить в ЖЖ.
Накидалось на коленке, я использую БД в расширенной версии скрипта — но решил и такой мелкий написать :)
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::Simple
my $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
];
}