#!/usr/bin/perl -w # Author: Jarle Bjørgeengen # Date: 2009-03-01 # License: GNU General Public license # Inngansportal til Frikanalen sine videoer i theora format # # http://wiki.nuug.no/grupper/video/pubfrikanalen use strict; use warnings; use XML::Simple; use CGI qw/:standard/; # SOAP:Lite må modifiseres til å gjøre ting på MS måten :-/ use SOAP::Lite on_action => sub {sprintf '%s/%s', @_}, ; use Data::Dumper; use Date::Parse; use POSIX qw(strftime); my $query = new CGI; my $nuug_frikanalen_url = 'http://www.nuug.no/pub/video/frikanalen/'; my $scripturl = url(); my $category = $query->param("category"); my $rss = $query->param("rss"); my $metainfo = "/home/ftp/pub/video/frikanalen/meta.xml"; my $ref = XMLin($metainfo); my $videodir = '/data/video/frikanalen'; binmode STDOUT, ":utf8"; if (defined $rss) { generate_rss(); exit 0; } else { &printheader; &printbody; &printfooter; exit 0; } ########################################### sub get_categories { # Returnerer referanse med "array of hashrefs". Hver hashref inneholder variablene 'Name' og 'Id'. # Kun 'Name' er brukt. my $soap = new SOAP::Lite -> uri('http://localhost/CommunitySiteService') -> proxy('http://communitysite1.frikanalen.tv/CommunitySiteFacade/CommunitySiteService.asmx'); my $res; my $obj = $soap->SearchCategories(SOAP::Data->name('searcher' => { } ) ); unless ($obj->fault) { my @categories; $res = $obj->result; #print Dumper($res); #foreach my $category (@{$res->{'Data'}->{'Category'}}) { # print "$category->{Name} $category->{Id}\n"; #} return $res->{'Data'}->{'Category'}; } else { print join ', ', $res->faultcode, $res->faultstring; } } sub searchvids { # Returnerer referanse med "array of hashrefs". Hashref inneholder metadata og urler # til videoer. Bruk Dumper til å titte på. my $returndata ; my $res; my $obj; my $soap = new SOAP::Lite -> uri('http://localhost/CommunitySiteService') -> proxy('http://communitysite1.frikanalen.tv/CommunitySiteFacade/CommunitySiteService.asmx'); if ($category) { $obj = $soap->SearchVideos( SOAP::Data->name('searcher' => { 'PredefinedSearchType' => 'Default', 'CategoryName' => $category, 'Take' => 10000, } ) ); } else { $obj = $soap->SearchVideos( SOAP::Data->name('searcher' => { 'PredefinedSearchType' => 'Default', 'Take' => 10000, } ) ); } unless ($obj->fault) { $res = $obj->result; return $res->{'Data'}->{'Video'}; } else { print join ', ', $res->faultcode, $res->faultstring; } } sub printheader { # Skrever ut toppen av forsiden inkludert kategorier med linker # tilbake til megselv?category=$category my $categories = &get_categories; my $cat = $category ? "category=$category" : ""; print "Content-type: text/html; charset=UTF-8\n\n"; print < Frikanalen - med åpne standarder

Frikanalen med åpne standarder

Dette er en alternativ presentasjon av filmene som sendes på Frikanalen i Norge. Denne alternative presentasjonen er laget av NUUGs videogruppe.

RSS for Miro

EOF print "Kategorier:
"; print ""; foreach my $category (@{$categories}) { print ""; } print "

Alle	{'Name'}\" >$category->{'Name'}

\n"; } sub printbody { # Returnerer kroppen til htmltabellen. Innholde er avhengig av $category my $videos = &searchvids($category); # print Dumper($videos); print" \n"; foreach my $video (@{$videos}) { my $title = $video->{'Title'}; my $id = $video->{'MetaDataVideoId'}; # Use local thumb JB. 10.03.09 #my $imageuri = $video->{'ImageUri'}; my $imageuri = './thumbs/'.$id.'.jpg'; my $ogvurl = "$nuug_frikanalen_url$id.ogv"; my $description = $video->{'Description'}; my $length = $video->{'MetaData'}->{'Length'}; my $seconds = ($length%60); my $minutes = int(($length%3600)/60); my $hours = int($length/3600); my $videouri = "${nuug_frikanalen_url}fetchvideo.cgi\?videoId=$id"; my $ogvfile = "$id.ogv"; my $num = $id; $num =~ s/^id_//; my $uploaddate = $video->{'Details'}->{'UploadDate'}; if (-e "$videodir/$ogvfile") { print "\n"; print "\n"; print "\n"; } } } sub printfooter { print < EOF } sub videosort { my $res = $b->{'Details'}->{'UploadDate'} cmp $a->{'Details'}->{'UploadDate'}; $res = $b->{'MetaDataVideoId'} <=> $a->{'MetaDataVideoId'} if 0 == $res; return $res; } sub generate_rss { print_rss_header(); my $videos = &searchvids($category); foreach my $video ( sort videosort @{$videos} ) { my $id = $video->{'MetaDataVideoId'}; my $videouri = "${nuug_frikanalen_url}fetchvideo.cgi\?videoId=$id"; my $ogvfile = "$id.ogv"; my $num = $id; $num =~ s/^id_//; # print STDERR Dumper($video); my $oggfilepath = "$videodir/$ogvfile"; my $date = format_rss_date($video->{'Details'}->{'UploadDate'}); if ( -e $oggfilepath ) { my $size = (stat($oggfilepath))[7]; item($video->{'Title'}, $date, $videouri, $video->{'Description'}, "$nuug_frikanalen_url$id.ogv", "application/ogg", $size, $video->{'ImageUri'}, int($video->{'MetaData'}->{'Length'})); } } print_rss_footer(); } sub format_rss_date { my ($isodate) = @_; $isodate =~ s/^(\d{4})(\d{2})(\d{2})/$1-$2-$3/; my $time = str2time($isodate); return strftime("%a, %d %b %Y %H:%M:%S %z", gmtime($time)); } sub item { my ($title, $date, $link, $desc, $enclurl, $encltype, $enclsize, $thumb, $duration) = @_; $enclurl = $link unless defined $enclurl; $title = escapeHTML($title); $desc = escapeHTML($desc); print < $title EOF print " $link\n" if $link; print " $link\n" if $link; print " $desc\n" if $desc; print " $date\n" if $date; print < EOF print " $duration\n" if ($duration); print < EOF } sub print_rss_header { my $selfurl = self_url(); my $cat = defined $category ? $category : ""; print < Frikanalen $cat http://www.frikanalen.no/ Frikanalen recordings. (c) nb Frikanalen Collected recordings Broadcasted on the public TV channel. Frikanalen post\@frikanalen.no Frikanalen, $cat Frikanalen $cat http://www.frikanalen.no/images/frikanal_logo_sv_bakgrunn_f.gif http://www.frikanalen.no/ no EOF } sub print_rss_footer { print < EOF }
"; print "$title"; if ($hours) { print "\ (Lengde: ".(sprintf('%2dt %2dm',$hours,$minutes)).')
'; } else { print "\ (Lengde: ".(sprintf('%2dm %2ds', $minutes, $seconds)).')
'; } print "Publisert: $uploaddate
\n" if $uploaddate; print "$description\n" if $description; print "