diff --git a/trunk/download.pl b/trunk/download.pl
index 7498036..cd2b796 100644
--- a/trunk/download.pl
+++ b/trunk/download.pl
@@ -26,12 +26,17 @@ if($query->param('id'))
$dbh->do(qq{update videos set downloadcount=downloadcount+1 where id = ? }, undef, $query->param('id')) or die $dbh->errstr;
}
- #in both cases - do some slurp-eaze to the browser
+ #open video file
$file = open(FILE, "<$root/videos/".$query->param('id'));
if($file)
{
+ #TODO: replace all of this with fastcgi x-sendfile
+ #get video filesize
$filesize = -s "$root/videos/".$query->param('id');
+
+ #get http query range
+ #TODO: also allow range end
$range = $query->http('range');
$range =~ s/bytes=([0-9]+)-/$1/;
@@ -45,6 +50,7 @@ if($query->param('id'))
}
else
{
+ #print correct http partial header
print $query->header(-type=>'application/ogg',
-content_length=> $filesize-$range,
-status=>'206 Partial Content',
@@ -52,18 +58,21 @@ if($query->param('id'))
-accept_ranges=> "bytes",
-content_range=> "bytes $range-".($filesize-1)."/$filesize"
);
-
+
+ #seek file to the requested position
seek FILE, $range, 0;
}
}
else
{
+ #print normal header
print $query->header(-type=>'application/ogg',
-content_length=> $filesize,
-attachment=>$title.".ogv"
);
}
+ #in both cases - do some slurp-eaze to the browser
while (my $BytesRead = read (FILE, $buff, 8192))
{
print $buff;
@@ -72,6 +81,7 @@ if($query->param('id'))
}
else
{
+ #the requested file should be there but is not - throw server error
print $session->header(
-status=>'500 Internal Server Error'
)
@@ -79,6 +89,7 @@ if($query->param('id'))
}
else
{
+ #no such video exists - 404
print $session->header(
-status=>'404 Not found'
)
@@ -86,5 +97,6 @@ if($query->param('id'))
}
else
{
+ #no if was supplied
print $query->redirect("index.pl?error=error_202c");
}
diff --git a/trunk/functions.pl b/trunk/functions.pl
index b6242e6..1b5e0d7 100644
--- a/trunk/functions.pl
+++ b/trunk/functions.pl
@@ -28,9 +28,11 @@ sub get_page_array
my $page = XML::LibXML::Element->new( "page" );
+ #get user language from browser http_accept string
my ($lang) = $query->http('HTTP_ACCEPT_LANGUAGE') =~ /^[^,]+,([^;]*);/;
$page->setAttribute( "lang", $lang ? $lang : "en" );
+ #TODO: set namespace for each site on its own
$page->setAttribute( "username", $userinfo->{'username'} );
$page->setNamespace("http://www.w3.org/1999/xhtml", "xhtml", 0);
$page->setNamespace("http://web.resource.org/cc/", "cc", 0);
@@ -86,6 +88,7 @@ sub fill_results
$license, $filesize, $duration, $width, $height, $fps, $viewcount,
$downloadcount) = $sth->fetchrow_array())
{
+ #build xml node structure
my $result = XML::LibXML::Element->new( "result" );
$result->setAttribute( "thumbnail", $config->{"url_root"}."/video-stills/thumbnails/$id" );
$result->setAttribute( "preview", $config->{"url_root"}."/video-stills/previews/$id" );
@@ -181,6 +184,7 @@ sub get_sqlquery
(@tags) = $strquery =~ / tag:(\w+)/gi;
($order) = $strquery =~ / order:(\w+)/i;
($sort) = $strquery =~ / sort:(\w+)/i;
+ #TODO: add those options
#($title) = $strquery =~ /title:(\w+)/i;
#($description) = $strquery =~ /description:(\w+)/i;
#($creator) = $strquery =~ /creator:(\w+)/i;
@@ -199,13 +203,16 @@ sub get_sqlquery
from_unixtime( v.timestamp ), v.creator, v.subject,
v.source, v.language, v.coverage, v.rights, v.license, filesize,
duration, width, height, fps, viewcount, downloadcount";
-
+
+ #only continue with a valid query string
if($strquery)
{
+ #select all videos
if($strquery eq "*")
{
$dbquery .= " from videos as v, users as u where u.id = v.userid";
}
+ #search
else
{
$dbquery .= ", match(v.title, v.description, v.subject) against( ? in boolean mode) as relevance";
@@ -214,18 +221,21 @@ sub get_sqlquery
push @args, $strquery, $strquery;
}
+ #match tags if present
if(@tags)
{
$dbquery .= " and match(v.subject) against (? in boolean mode)";
push @args, "@tags";
}
+ #match publisher
if($publisher)
{
$dbquery .= " and match(u.username) against (? in boolean mode)";
push @args, "$publisher";
}
+ #give results the right order
if($order)
{
if($order eq 'filesize')
@@ -340,6 +350,7 @@ sub output_page
}
}
+#output info message
sub message
{
my ($type, $text, $value) = @_;
diff --git a/trunk/include.pl b/trunk/include.pl
index 935d229..014f1e4 100644
--- a/trunk/include.pl
+++ b/trunk/include.pl
@@ -1,5 +1,6 @@
#!/usr/bin/perl -w
+#TODO: make this script specific when we use fastcgi
use CGI qw(:standard);
use CGI::Session;
use DBI;
@@ -14,6 +15,7 @@ use LWP::UserAgent;
use HTTP::Request;
use CGI::Carp qw(fatalsToBrowser set_message);
+#send error message to user
set_message("It's not a bug, it's a feature!!
(include this error message in your bugreport here: Yolanda bugtracker)");
# change this as you install it somewhere else
@@ -25,5 +27,6 @@ use lib qw(/var/www/yolanda);
$config = XMLin("$root/config/backend.xml", KeyAttr => {string => 'id'}, ForceArray => [ 'string' ], ContentKey => '-content');
$config = $config->{"strings"}->{"string"};
+#set database connection string
$dbh = DBI->connect("DBI:mysql:".$config->{"database_name"}.":".$config->{"database_host"}, $config->{"database_username"}, $config->{"database_password"}) or die $DBI::errstr;
1;
diff --git a/trunk/index.pl b/trunk/index.pl
index 52a0756..35343c8 100644
--- a/trunk/index.pl
+++ b/trunk/index.pl
@@ -11,8 +11,10 @@ my $doc = XML::LibXML::Document->new( "1.0", "UTF-8" );
my $page = get_page_array(@userinfo);
+#TODO: make the element unneccesary
$page->appendChild(XML::LibXML::Element->new( "frontpage" ));
+#if a message box is to be shown
if($query->param('information'))
{
$page->appendChild(message("information", $query->param('information'), $query->param('value')));
@@ -26,6 +28,7 @@ elsif($query->param('warning'))
$page->appendChild(message("warning", $query->param('warning'), $query->param('value')));
}
+#new tagcloud xml element
my $tagcloud = XML::LibXML::Element->new( "tagcloud" );
#prepare query
@@ -34,9 +37,10 @@ my $sth = $dbh->prepare(qq{select text, count from tagcloud }) or die $dbh->errs
#execute it
$sth->execute() or die $dbh->errstr;
-#get every returned value
+#get every returned value and append it to tagcloud
while (my ($text, $count) = $sth->fetchrow_array())
{
+ #TODO: why not use text
my $tag = XML::LibXML::Element->new( "tag" );
$tag->appendTextChild("text", $text);
$tag->appendTextChild("count", $count);
@@ -48,6 +52,7 @@ $sth->finish() or die $dbh->errstr;
$page->appendChild($tagcloud);
+#now get the frontpage video queries from config and process them
foreach $strquery ($config->{"search_frontpage_one_query"}, $config->{"search_frontpage_two_query"}, $config->{"search_frontpage_three_query"})
{
#new results block
@@ -70,6 +75,7 @@ foreach $strquery ($config->{"search_frontpage_one_query"}, $config->{"search_fr
$license, $filesize, $duration, $width, $height, $fps, $viewcount,
$downloadcount) = $sth->fetchrow_array())
{
+ #construct xml
my $result = XML::LibXML::Element->new( "result" );
$result->setAttribute( "thumbnail", $config->{"url_root"}."/video-stills/thumbnails/$id" );
$result->setAttribute( "preview", $config->{"url_root"}."/video-stills/previews/$id" );
diff --git a/trunk/login.pl b/trunk/login.pl
index 02a101e..8221ea8 100644
--- a/trunk/login.pl
+++ b/trunk/login.pl
@@ -15,6 +15,7 @@ if($query->param('action') eq "logout")
#remove sid from database
$dbh->do(qq{update users set sid = '' where id = ?}, undef, $userinfo->{'id'}) or die $dbh->errstr;
$session->delete();
+
print $query->redirect("index.pl?information=information_logged_out");
}
#check if user is logged in
@@ -27,14 +28,17 @@ elsif($query->param('pass') eq '' and $query->param('user')=~m/^http:\/\//)
{
#create our openid consumer object
$con = Net::OpenID::Consumer->new(
- ua => LWPx::ParanoidAgent->new, # FIXME - use LWPx::ParanoidAgent
- cache => undef, # or File::Cache->new,
- args => $query,
- consumer_secret => $session->id, #is this save? don't know...
- required_root => $config->{"url_root"} );
+ ua => LWPx::ParanoidAgent->new,
+ cache => undef, # or File::Cache->new,
+ args => $query,
+ consumer_secret => $session->id, #is this save? don't know...
+ required_root => $config->{"url_root"}
+ );
#claim identity
$claimed = $con->claimed_identity($query->param('user'));
+
+ #if claim failed, redirect
if(!defined($claimed))
{
print $query->redirect("/index.pl?error=error_openid_".$con->errcode);
@@ -55,22 +59,26 @@ elsif($query->param('action') eq 'openid')
{
#create our openid consumer object
$con = Net::OpenID::Consumer->new(
- ua => LWPx::ParanoidAgent->new, # FIXME - use LWPx::ParanoidAgent
- cache => undef, # or File::Cache->new,
- args => $query,
- consumer_secret => $session->id, #is this save? don't know...
- required_root => $config->{"url_root"} );
+ ua => LWPx::ParanoidAgent->new,
+ cache => undef, # or File::Cache->new,
+ args => $query,
+ consumer_secret => $session->id, #is this save? don't know...
+ required_root => $config->{"url_root"}
+ );
+ #redirect to setup url
if($setup_url = $con->user_setup_url)
{
#redirect to setup url - user will give confirmation there
print $query->redirect($setup_url);
}
+ #or cancel process
elsif ($con->user_cancel)
{
#cancelled - redirect to login form
print $query->redirect("index.pl");
}
+ #or verify identity
elsif ($vident = $con->verified_identity)
{
#we are verified!!
@@ -79,6 +87,7 @@ elsif($query->param('action') eq 'openid')
#check if this openid user already is in database
my $sth = $dbh->prepare(qq{select 1 from users where username = ? limit 1 });
$sth->execute($verified_url);
+
if($sth->fetchrow_array())
{
#store session id in database
@@ -100,9 +109,10 @@ elsif($query->param('action') eq 'openid')
}
}
#else it's a normal login
+#check if password is not empty and username is neither beginning with http nor empty
elsif($query->param('pass') ne '' and $query->param('user')!~m/^http:\/\// and $query->param('user') ne '')
{
- #prepare query - empty password are openid users so omit those entries
+ #prepare query
my $sth = $dbh->prepare(qq{select id from users
where password = password( ? ) and username = ? limit 1 });
diff --git a/trunk/pingback.pl b/trunk/pingback.pl
index 0a06f3e..314edd5 100644
--- a/trunk/pingback.pl
+++ b/trunk/pingback.pl
@@ -5,18 +5,24 @@ CGI::Session->name($config->{"page_cookie_name"});
$query = new CGI;
$session = new CGI::Session;
+#we receive a POST request (this MUST contain a content/type definiton to be recognized)
if ($query->param("POSTDATA"))
{
- my $xmlpost = XMLin($query->param("POSTDATA"), ForceArray => 0, KeyAttr => 0);
+ #use xml::simple to process rpc request
+ eval { my $xmlpost = XMLin($query->param("POSTDATA"), ForceArray => 0, KeyAttr => 0) };
+ #if everything worked
if (!$@)
{
+ #set internal variables
my $method = $xmlpost->{"methodName"};
my $source = $xmlpost->{"params"}->{"param"}[0]->{"value"}->{"string"};
my $target = $xmlpost->{"params"}->{"param"}[1]->{"value"}->{"string"};
+ #if this is really a pingback rpc request
if ($method eq "pingback.ping")
{
+ #if there are valid target and source nodes
if ($source =~ /^http:\/\// and $target =~ /^http:\/\//)
{
#fetch the source URI to verify that the source does indeed link to the target.
@@ -24,6 +30,7 @@ if ($query->param("POSTDATA"))
my $ua = LWP::UserAgent->new;
my $response = $ua->request($request);
+ #if the url indeed exists
if ($response->is_success)
{
#TODO: sanitize regex to grep site content
@@ -32,11 +39,13 @@ if ($query->param("POSTDATA"))
#check data to ensure that the target exists and is a valid entry.
my ($vid) = $target =~ /^$config->{'url_root'}\/video\/.*\/(\d+)\/.*/;
+ #query database if we have such a video
my $sth = $dbh->prepare("select id from videos where id = ? limit 1");
my $rowcount = $sth->execute($vid) or die $dbh->errstr;
$sth->finish() or die $dbh->errstr;
+ #if we have what the client wants to ping
if ($rowcount)
{
#check that the pingback has not already been registered.
@@ -44,12 +53,14 @@ if ($query->param("POSTDATA"))
$rowcount = $sth->execute($vid) or die $dbh->errstr;
$sth->finish() or die $dbh->errstr;
+ #if this is a new request
if ($rowcount eq "0E0")
{
#record the pingback.
$dbh->do(qq{insert into pingbacks (source, videoid, text, timestamp) values (?, ?, ?, unix_timestamp())}, undef,
$source, $vid, $text) or die $dbh->errstr;
+ #construct xml::simple hash
my $xml = ();
$xml->{'params'}->{'param'}->{'value'}->{'string'} = ["Pingback from $source to $target registered. Keep the web talking! :-)"];
@@ -109,7 +120,8 @@ else
sub send_error
{
my ($faultCode, $faultString) = @_;
-
+
+ #construct xml::simple hash
my $xml = ();
push @{$xml->{'fault'}->{'value'}->{'struct'}->{'member'}},
{
diff --git a/trunk/search.pl b/trunk/search.pl
index b69f10a..f6c89be 100644
--- a/trunk/search.pl
+++ b/trunk/search.pl
@@ -14,21 +14,27 @@ my $page = get_page_array(@userinfo);
#check if query is set
if($query->param('query'))
{
+ #construct querystring and arguments from user query
my ($dbquery, @args) = get_sqlquery($query->param('query'));
+ #if successful
if($dbquery)
{
+ #fill xml with search results
$page->appendChild(fill_results($dbquery, @args));
$page->setAttribute('query', $query->param('query'));
$doc->setDocumentElement($page);
+ #get all results
my @results = $doc->findnodes( "//results/result" );
+ #if result count is zero
if($#results == -1)
{
print $query->redirect("index.pl?warning=warning_no_results");
}
+ #if there is only one results, redirect to video directly
elsif(($#results == 0) and (not $query->param('page') or $query->param('page') == 1))
{
print $query->redirect(@{$doc->findnodes( "//results/result/rdf:RDF/cc:Work/dc:identifier/text()" )}[0]->data);
@@ -43,10 +49,6 @@ if($query->param('query'))
print $query->redirect("index.pl?error=error_no_query");
}
}
-elsif($query->param('advanced'))
-{
- print $query->redirect("index.pl?error=error_202c");
-}
else
{
print $query->redirect("index.pl?error=error_no_query");
diff --git a/trunk/settings.pl b/trunk/settings.pl
index 191a9cc..3d7d6d9 100644
--- a/trunk/settings.pl
+++ b/trunk/settings.pl
@@ -1,5 +1,7 @@
require "functions.pl";
+#TODO: are settings obsolete?
+
#initialize session data
CGI::Session->name($config->{"page_cookie_name"});
$query = new CGI;
diff --git a/trunk/tools/daemon.pl b/trunk/tools/daemon.pl
index 9cc8ccd..beb8024 100755
--- a/trunk/tools/daemon.pl
+++ b/trunk/tools/daemon.pl
@@ -53,7 +53,7 @@ while(1)
{
#video height is either the maximum video height
#or (when the original is smaller than that) the original height
- #check for multiple by 8
+ #check for multiple of 8
$vheight = $height <= $config->{"video_height_max"} ? int($height/8 + .5)*8 : $config->{"video_height_max"};
$vwidth = int($vheight*($width/$height)/8 + .5)*8;
diff --git a/trunk/tools/tagcloud.pl b/trunk/tools/tagcloud.pl
index c4d14a2..d3479e4 100755
--- a/trunk/tools/tagcloud.pl
+++ b/trunk/tools/tagcloud.pl
@@ -11,21 +11,20 @@ $config = $config->{"strings"}->{"string"};
$dbh = DBI->connect("DBI:mysql:".$config->{"database_name"}.":".$config->{"database_host"}, $config->{"database_username"}, $config->{"database_password"}) or die $DBI::errstr;
+#get all subjects
$sth = $dbh->prepare("select subject from videos");
$sth->execute();
+
#cycle through all video subjects
while(($subject) = $sth->fetchrow_array())
{
+ #TODO: make split char configureable
@subject = split(' ', $subject);
#cycle through all tags of video
foreach my $val (@subject)
{
- #strip whitespaces
- $val =~ s/^\s*(.*?)\s*$/$1/;
- if(length($val) >= $config->{"page_tag_lenght_min"})
- {
- %hash->{$val}++;
- }
+ #add/increment correct hash value
+ %hash->{$val}++;
}
}
$sth->finish();
@@ -33,9 +32,11 @@ $sth->finish();
#sort by count
@sorted = sort {$hash{$b} cmp $hash{$a}} keys %hash;
+#clean tagcloud
$dbh->do("delete from tagcloud");
+
$sth = $dbh->prepare("insert into tagcloud (text, count) values (?, ?)");
-#insert tags into tagcloud table
+#insert "page_tag_count" tags into tagcloud table
for($i=0;$i<$config->{"page_tag_count"} and $i<=$#sorted;$i++)
{
$sth->execute( $sorted[$i], %hash->{$sorted[$i]} );
diff --git a/trunk/upload.pl.bak b/trunk/upload.pl.bak
index 7ccdfc0..97f856a 100644
--- a/trunk/upload.pl.bak
+++ b/trunk/upload.pl.bak
@@ -28,6 +28,7 @@ if($userinfo->{'username'})
@unique{ @subject } = ();
foreach $tag (keys %unique)
{
+ $tag =~ s/^\s*(.*?)\s*$/$1/;
if(length($tag) >= $config->{"page_tag_lenght_min"})
{
$subject.=$tag." ";
diff --git a/trunk/uploader.pl b/trunk/uploader.pl
index cc02437..6df214a 100644
--- a/trunk/uploader.pl
+++ b/trunk/uploader.pl
@@ -92,6 +92,7 @@ if($userinfo->{'id'} && $query->param("DC.Title") &&
}
else
{
+ #generate unique hash
$sha = new Digest::SHA(256);
$sha->addfile("/tmp/$id");
$sha = $sha->hexdigest;
@@ -112,12 +113,15 @@ if($userinfo->{'id'} && $query->param("DC.Title") &&
}
else
{
+ #get video container and duration
($container, $duration) = $info =~ /Input \#0, (\w+),.+?\n.+?Duration: (\d{2}:\d{2}:\d{2}\.\d)/;
+ #get audio, video, idth, height and fps
#these two regexes have to be applied seperately because nobody knows which stream (audio or video) comes first
($audio) = $info =~ /Audio: (\w+)/;
($video, $width, $height, $fps) = $info =~ /Video: ([\w\d]+),.+?(\d+)x(\d+),.+?(\d+\.\d+) fps/;
+ #if there is no video stream or no duration
if(!$video or !$duration)
{
#delete from uploaded table
@@ -125,6 +129,7 @@ if($userinfo->{'id'} && $query->param("DC.Title") &&
unlink "/tmp/$id";
print $query->redirect("index.pl?error=error_upload_invalid_stream");
}
+ #if the video width is smaller than allowed
elsif($width < $config->{"video_width_min"})
{
#delete from uploaded table
@@ -132,6 +137,7 @@ if($userinfo->{'id'} && $query->param("DC.Title") &&
unlink "/tmp/$id";
print $query->redirect("index.pl?error=error_upload_video_width_too_small&value=".$config->{"video_width_min"});
}
+ #if the video height is smaller than allowed
elsif($height < $config->{"video_height_min"})
{
#delete from uploaded table
@@ -141,6 +147,7 @@ if($userinfo->{'id'} && $query->param("DC.Title") &&
}
else
{
+ #get video filesize
$filesize = -s "/tmp/$id";
#convert hh:mm:ss.s duration to full seconds - thanks perl for making this so damn easy!
@@ -148,7 +155,7 @@ if($userinfo->{'id'} && $query->param("DC.Title") &&
$duration =~ /^(\d{2}):(\d{2}):(\d{2})\.(\d)$/;
$duration = int($1*3600 + $2*60 + $3 + $4/10 + .5);
- #create thumbnail
+ #get thumbnail position
$thumbnailsec = int(rand($duration));
$previewsec = $thumbnailsec;
@@ -157,6 +164,7 @@ if($userinfo->{'id'} && $query->param("DC.Title") &&
$tnheight = $config->{"video_thumbnail_height"};
$tnwidth = int($tnheight*($width/$height)/2 + .5)*2;
+ #create thumbnail and preview in original size
$ffthumb = system "ffmpeg -i /tmp/$id -vcodec mjpeg -vframes 1 -an -f rawvideo -ss $thumbnailsec -s ".$tnwidth."x$tnheight $root/video-stills/thumbnails/$id";
$ffprev = system "ffmpeg -i /tmp/$id -vcodec mjpeg -vframes 1 -an -f rawvideo -ss $previewsec $root/video-stills/previews/$id";
@@ -166,8 +174,10 @@ if($userinfo->{'id'} && $query->param("DC.Title") &&
#check if the upload already is in the right format and smaller/equal max-width/height
if ($container eq 'ogg' and $video eq 'theora' and ($audio eq 'vorbis' or not $audio) and $height <= $config->{"video_height_max"} and $width <= $config->{"video_width_max"})
{
+ #if so, move to destination
if(move("/tmp/$id", "$root/videos/$id"))
{
+ #if move was successful
#add video to videos table
$dbh->do(qq{insert into videos select id, title, description, userid, timestamp, creator,
subject, source, language, coverage, rights, license, ?, ?, ?, ?, ?, ?, 0, 0
diff --git a/trunk/video.pl b/trunk/video.pl
index 44cf2db..885c031 100644
--- a/trunk/video.pl
+++ b/trunk/video.pl
@@ -14,6 +14,7 @@ my $page = get_page_array(@userinfo);
#check if id or title is passed
if($query->url_param('id'))
{
+ #initiate database query
$dbquery = "select v.id, v.title, v.description, u.username, from_unixtime( v.timestamp ),
v.creator, v.subject, v.source, v.language, v.coverage, v.rights,
v.license, filesize, duration, width, height, fps, viewcount, downloadcount
@@ -22,9 +23,11 @@ if($query->url_param('id'))
@args = ($query->url_param('id'));
$sth = $dbh->prepare($dbquery);
+
+ #test wether the video exists
$rowcount = $sth->execute(@args) or die $dbh->errstr;
- #if there are still no results
+ #if there are no results
if($rowcount == 0)
{
#check if maybe the video has not yet been converted
@@ -35,12 +38,16 @@ if($query->url_param('id'))
#if id is found
if($rowcount == 1)
{
+ #calculate the overall length of video to be encoded
$sth = $dbh->prepare("select sum(duration) from uploaded where id < ?");
$sth->execute($query->url_param('id')) or die $dbh->errstr;
($length) = $sth->fetchrow_array();
+
+ #convert hours, minutes and seconds fromoverall seconds
$h = int($length/3600);
$m = int($length/60-$h*60);
$s = int($length-$m*60-$h*3600);
+
print $query->redirect("/index.pl?information=information_video_not_yet_available&value=".$h."h ".$m."m ".$s."s");
}
else
@@ -52,6 +59,7 @@ if($query->url_param('id'))
}
elsif($rowcount == 1)
{
+ #set embed attribute if requested
if($query->param('embed') eq "video")
{
$page->setAttribute( "embed", "video" );
@@ -60,14 +68,6 @@ if($query->url_param('id'))
{
$page->setAttribute( "embed", "preview" );
}
-
- #if there was a single result, display the video
- my ($id, $title, $description, $publisher, $timestamp, $creator, $subject,
- $source, $language, $coverage, $rights, $license,
- $filesize, $duration, $width, $height, $fps, $viewcount, $downloadcount) = $sth->fetchrow_array();
-
- #finish query
- $sth->finish() or die $dbh->errstr;
#if user is logged in
if($userinfo->{'username'})
@@ -75,17 +75,25 @@ if($query->url_param('id'))
#check if a comment is about to be created
if($query->param('comment'))
{
+ #prepare new dtd
my $dtd = XML::LibXML::Dtd->new(0, "$root/site/comment.dtd");
$dom = XML::LibXML->new;
$dom->clean_namespaces(1);
+
+ #try to parse user's comment
eval { $doc = $dom->parse_string("".$query->param('comment')."") };
+
+ #die if error
if ($@)
{
die $@;
}
else
{
+ #try to validate against dtd
eval { $doc->validate($dtd) };
+
+ #die if error
if ($@)
{
die $@;
@@ -100,7 +108,9 @@ if($query->url_param('id'))
$userinfo->{'id'}, $id, $query->param('comment')) or die $dbh->errstr;
#send pingbacks to every url in the comment
- my (@matches) = $query->param('comment') =~ /]+href="(http:\/\/\S+)"[^>]*>.+?<\/a>/gi;
+ my (@matches) = $query->param('comment') =~ /]*href="(http:\/\/\S+)"[^>]*>.+?<\/a>/gi;
+
+ #for every match send a pingback
foreach $match (@matches)
{
#ask for http header only - if pingbacks are implemented right, then we wont need the full site
@@ -109,6 +119,7 @@ if($query->url_param('id'))
my $response = $ua->request($request);
+ #if successful response
if ($response->is_success)
{
my $pingbackurl = $response->header("x-pingback");
@@ -119,6 +130,7 @@ if($query->url_param('id'))
$request = HTTP::Request->new(GET => $match);
$response = $ua->request($request);
+ #get the link if response was successful
if ($response->is_success)
{
($pingbackurl) = $response->content =~ //;
@@ -131,6 +143,7 @@ if($query->url_param('id'))
#TODO: expand xml entities < > & " in $pingbackurl
#contruct the xml-rpc request
+ #TODO: do this with xml::libxml
my $xmlpost = ();
$xmlpost->{"methodName"} = ["pingback.ping"];
push @{$xmlpost->{'params'}->{'param'} },
@@ -167,7 +180,16 @@ if($query->url_param('id'))
}
}
}
+
+ #if there was a single result, display the video
+ my ($id, $title, $description, $publisher, $timestamp, $creator, $subject,
+ $source, $language, $coverage, $rights, $license,
+ $filesize, $duration, $width, $height, $fps, $viewcount, $downloadcount) = $sth->fetchrow_array();
+ #finish query
+ $sth->finish() or die $dbh->errstr;
+
+ #construct video xml
my $video = XML::LibXML::Element->new( "video" );
$video->setAttribute('thumbnail', $config->{"url_root"}."/video-stills/thumbnails/$id");
$video->setAttribute('preview', $config->{"url_root"}."/video-stills/previews/$id");
@@ -242,6 +264,7 @@ if($query->url_param('id'))
$node->appendText($title);
$work->appendChild($node);
+ #TODO: add license conditions
my $license = XML::LibXML::Element->new( "License" );
$license->setNamespace("http://web.resource.org/cc/", "cc");
$license->setNamespace("http://www.w3.org/1999/02/22-rdf-syntax-ns#", "rdf", 0);
@@ -254,18 +277,27 @@ if($query->url_param('id'))
$page->appendChild($video);
- #get comments
+ #get comments - this will also include newly created comments
my $comments = XML::LibXML::Element->new( "comments" );
$sth = $dbh->prepare(qq{select comments.id, comments.text, users.username, from_unixtime( comments.timestamp )
from comments, users where
comments.videoid=? and users.id=comments.userid}) or die $dbh->errstr;
+
$sth->execute($id) or die $dbh->errstr;
+
+ #for every comment in the db
while (my ($commentid, $text, $username, $timestamp) = $sth->fetchrow_array())
{
+ #create new xml node
my $dom = XML::LibXML->new;
+
+ #parse database string to xml
my $doc = $dom->parse_string("".$text."");
+
my $comment = $doc->documentElement();
+
+ #add xhtml namespace prefix to every node
foreach $node ($comment->getElementsByTagName("*"))
{
$node->setNamespace("http://www.w3.org/1999/xhtml", "xhtml");