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::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
];
}

Комментировать

Войдите чтобы оставить комментарий.