root/websites/coderepos.org/scripts/commit-ping-worker.pl @ 11713

#!/usr/bin/env perl
package CodeRepos::CommitPing::Worker;
use strict;
use warnings;
use base 'TheSchwartz::Worker';

use LWP::UserAgent;
use LWP::Simple;
use YAML;

my @servers = ();
my $last_update = 0;

sub load_servers {
    my $ua = LWP::UserAgent->new;
    $ua->timeout(2);

    my $res = $ua->get('http://coderepos.org/share/wiki/commit-ping/SITEINFO');
    return unless $res->is_success;

    @servers = ();
    my $html = $res->content;
    (undef, $html) = split m{<h2 id="CommitPingServers">Commit Ping Servers</h2>}, $html;
    while ($html =~ m!<a class="ext-link" href="(.+?)">!g) {
        push @servers, $1;
    }
}

sub work {
    my($class, $job) = @_;

    load_servers if $last_update + 3600 < time;
    my $yaml = Dump($job->arg);

    my $ua = LWP::UserAgent->new;
    $ua->timeout(2);
    for my $url (@servers) {
        $ua->post( $url, { yaml => $yaml } );
    }

    $job->completed;
}


package main;
use strict;
use warnings;

use TheSchwartz;

my $database = +{
    dsn  => shift,
    user => shift,
    pass => shift,
};

my $client = TheSchwartz->new( databases => [ $database ] );
$client->can_do( 'CodeRepos::CommitPing::Worker' );
$client->work while 1;