root/websites/ustreamer/channel2json.cgi @ 591

#!/usr/local/bin/perl

# 2007-07-22 v0.01
# License : Same as Perl
# Sample : http://blog.bulkneets.net/misc/ustream/channel2json.pl

use lib qw(lib);

use strict;
use CGI;
use LWP::UserAgent;
use Cache::FileCache;
use URI::Fetch;
use JSON::Syck;

my $channels_limit = 70;

my $q = CGI->new;

my $cache = Cache::FileCache->new({
    'cache_root' => '.cache',
    'namespace'  => 'ustream2json',
    'default_expires_in' => 3600
});

my %scraper = (
    'usc' => qr{src="http://ustream\.tv/([^"]*?)\.usc"}o,
    'irc' => qr{name="channel" value="(\#[^,]*?)"}o,
);

my $mode = $q->param("mode") || 'usc';
my $channel_name = $q->param("channel_name");
my @channels = split(/,/, $channel_name);

if (scalar @channels > $channels_limit){
    output_json($q, "too large");
}

my %result = map {
    $_ => channel2any($_, $mode) 
} map {
    $_ =~ s{http://(?:www\.)?ustream.tv/channel/}{}; $_ 
} @channels;

output_json($q, \%result);

sub channel2any {
    my ($channel, $mode) = @_;
    my $content = channel_fetch($channel);
    $content =~ $scraper{$mode};
    return $1 ? $1 : undef;
}

sub channel_fetch {
    my $channel = shift;
    my $url = "http://www.ustream.tv/channel/" . $channel;
    my $ua = LWP::UserAgent->new;
    $ua->agent('ustream2json/0.01');
    
    my $res = URI::Fetch->fetch(
        $url,
        UserAgent => $ua,
        Cache     => $cache,
        NoNetwork => 3600
    );

    return $res->is_success ? $res->content : undef;
}

sub output_json {
    my ($q, $obj) = @_;
    print $q->header(
        "-type" => "text/javascript",
        "-charset" => 'utf-8'
    );
    my $json = JSON::Syck::Dump($obj);
    if(defined (my $p = $q->param('callback'))){
        $json = "$p($json);" if($p =~ /[a-zA-Z0-9\.\_\[\]]/);
    }
    print $json;
}