added comments everywhere

git-svn-id: http://yolanda.mister-muffin.de/svn@330 7eef14d0-6ed0-489d-bf55-20463b2d70db
This commit is contained in:
josch 2008-04-29 07:02:07 +00:00
parent 84fcdbd516
commit 5b231dcfc0
13 changed files with 143 additions and 41 deletions

View file

@ -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; $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')); $file = open(FILE, "<$root/videos/".$query->param('id'));
if($file) if($file)
{ {
#TODO: replace all of this with fastcgi x-sendfile
#get video filesize
$filesize = -s "$root/videos/".$query->param('id'); $filesize = -s "$root/videos/".$query->param('id');
#get http query range
#TODO: also allow range end
$range = $query->http('range'); $range = $query->http('range');
$range =~ s/bytes=([0-9]+)-/$1/; $range =~ s/bytes=([0-9]+)-/$1/;
@ -45,6 +50,7 @@ if($query->param('id'))
} }
else else
{ {
#print correct http partial header
print $query->header(-type=>'application/ogg', print $query->header(-type=>'application/ogg',
-content_length=> $filesize-$range, -content_length=> $filesize-$range,
-status=>'206 Partial Content', -status=>'206 Partial Content',
@ -53,17 +59,20 @@ if($query->param('id'))
-content_range=> "bytes $range-".($filesize-1)."/$filesize" -content_range=> "bytes $range-".($filesize-1)."/$filesize"
); );
#seek file to the requested position
seek FILE, $range, 0; seek FILE, $range, 0;
} }
} }
else else
{ {
#print normal header
print $query->header(-type=>'application/ogg', print $query->header(-type=>'application/ogg',
-content_length=> $filesize, -content_length=> $filesize,
-attachment=>$title.".ogv" -attachment=>$title.".ogv"
); );
} }
#in both cases - do some slurp-eaze to the browser
while (my $BytesRead = read (FILE, $buff, 8192)) while (my $BytesRead = read (FILE, $buff, 8192))
{ {
print $buff; print $buff;
@ -72,6 +81,7 @@ if($query->param('id'))
} }
else else
{ {
#the requested file should be there but is not - throw server error
print $session->header( print $session->header(
-status=>'500 Internal Server Error' -status=>'500 Internal Server Error'
) )
@ -79,6 +89,7 @@ if($query->param('id'))
} }
else else
{ {
#no such video exists - 404
print $session->header( print $session->header(
-status=>'404 Not found' -status=>'404 Not found'
) )
@ -86,5 +97,6 @@ if($query->param('id'))
} }
else else
{ {
#no if was supplied
print $query->redirect("index.pl?error=error_202c"); print $query->redirect("index.pl?error=error_202c");
} }

View file

@ -28,9 +28,11 @@ sub get_page_array
my $page = XML::LibXML::Element->new( "page" ); my $page = XML::LibXML::Element->new( "page" );
#get user language from browser http_accept string
my ($lang) = $query->http('HTTP_ACCEPT_LANGUAGE') =~ /^[^,]+,([^;]*);/; my ($lang) = $query->http('HTTP_ACCEPT_LANGUAGE') =~ /^[^,]+,([^;]*);/;
$page->setAttribute( "lang", $lang ? $lang : "en" ); $page->setAttribute( "lang", $lang ? $lang : "en" );
#TODO: set namespace for each site on its own
$page->setAttribute( "username", $userinfo->{'username'} ); $page->setAttribute( "username", $userinfo->{'username'} );
$page->setNamespace("http://www.w3.org/1999/xhtml", "xhtml", 0); $page->setNamespace("http://www.w3.org/1999/xhtml", "xhtml", 0);
$page->setNamespace("http://web.resource.org/cc/", "cc", 0); $page->setNamespace("http://web.resource.org/cc/", "cc", 0);
@ -86,6 +88,7 @@ sub fill_results
$license, $filesize, $duration, $width, $height, $fps, $viewcount, $license, $filesize, $duration, $width, $height, $fps, $viewcount,
$downloadcount) = $sth->fetchrow_array()) $downloadcount) = $sth->fetchrow_array())
{ {
#build xml node structure
my $result = XML::LibXML::Element->new( "result" ); my $result = XML::LibXML::Element->new( "result" );
$result->setAttribute( "thumbnail", $config->{"url_root"}."/video-stills/thumbnails/$id" ); $result->setAttribute( "thumbnail", $config->{"url_root"}."/video-stills/thumbnails/$id" );
$result->setAttribute( "preview", $config->{"url_root"}."/video-stills/previews/$id" ); $result->setAttribute( "preview", $config->{"url_root"}."/video-stills/previews/$id" );
@ -181,6 +184,7 @@ sub get_sqlquery
(@tags) = $strquery =~ / tag:(\w+)/gi; (@tags) = $strquery =~ / tag:(\w+)/gi;
($order) = $strquery =~ / order:(\w+)/i; ($order) = $strquery =~ / order:(\w+)/i;
($sort) = $strquery =~ / sort:(\w+)/i; ($sort) = $strquery =~ / sort:(\w+)/i;
#TODO: add those options
#($title) = $strquery =~ /title:(\w+)/i; #($title) = $strquery =~ /title:(\w+)/i;
#($description) = $strquery =~ /description:(\w+)/i; #($description) = $strquery =~ /description:(\w+)/i;
#($creator) = $strquery =~ /creator:(\w+)/i; #($creator) = $strquery =~ /creator:(\w+)/i;
@ -200,12 +204,15 @@ sub get_sqlquery
v.source, v.language, v.coverage, v.rights, v.license, filesize, v.source, v.language, v.coverage, v.rights, v.license, filesize,
duration, width, height, fps, viewcount, downloadcount"; duration, width, height, fps, viewcount, downloadcount";
#only continue with a valid query string
if($strquery) if($strquery)
{ {
#select all videos
if($strquery eq "*") if($strquery eq "*")
{ {
$dbquery .= " from videos as v, users as u where u.id = v.userid"; $dbquery .= " from videos as v, users as u where u.id = v.userid";
} }
#search
else else
{ {
$dbquery .= ", match(v.title, v.description, v.subject) against( ? in boolean mode) as relevance"; $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; push @args, $strquery, $strquery;
} }
#match tags if present
if(@tags) if(@tags)
{ {
$dbquery .= " and match(v.subject) against (? in boolean mode)"; $dbquery .= " and match(v.subject) against (? in boolean mode)";
push @args, "@tags"; push @args, "@tags";
} }
#match publisher
if($publisher) if($publisher)
{ {
$dbquery .= " and match(u.username) against (? in boolean mode)"; $dbquery .= " and match(u.username) against (? in boolean mode)";
push @args, "$publisher"; push @args, "$publisher";
} }
#give results the right order
if($order) if($order)
{ {
if($order eq 'filesize') if($order eq 'filesize')
@ -340,6 +350,7 @@ sub output_page
} }
} }
#output info message
sub message sub message
{ {
my ($type, $text, $value) = @_; my ($type, $text, $value) = @_;

View file

@ -1,5 +1,6 @@
#!/usr/bin/perl -w #!/usr/bin/perl -w
#TODO: make this script specific when we use fastcgi
use CGI qw(:standard); use CGI qw(:standard);
use CGI::Session; use CGI::Session;
use DBI; use DBI;
@ -14,6 +15,7 @@ use LWP::UserAgent;
use HTTP::Request; use HTTP::Request;
use CGI::Carp qw(fatalsToBrowser set_message); use CGI::Carp qw(fatalsToBrowser set_message);
#send error message to user
set_message("It's not a bug, it's a feature!!<br />(include this error message in your bugreport here: <a href=\"http://yolanda.mister-muffin.de/newticket\">Yolanda bugtracker</a>)"); set_message("It's not a bug, it's a feature!!<br />(include this error message in your bugreport here: <a href=\"http://yolanda.mister-muffin.de/newticket\">Yolanda bugtracker</a>)");
# change this as you install it somewhere else # 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 = XMLin("$root/config/backend.xml", KeyAttr => {string => 'id'}, ForceArray => [ 'string' ], ContentKey => '-content');
$config = $config->{"strings"}->{"string"}; $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; $dbh = DBI->connect("DBI:mysql:".$config->{"database_name"}.":".$config->{"database_host"}, $config->{"database_username"}, $config->{"database_password"}) or die $DBI::errstr;
1; 1;

View file

@ -11,8 +11,10 @@ my $doc = XML::LibXML::Document->new( "1.0", "UTF-8" );
my $page = get_page_array(@userinfo); my $page = get_page_array(@userinfo);
#TODO: make the <frontpage> element unneccesary
$page->appendChild(XML::LibXML::Element->new( "frontpage" )); $page->appendChild(XML::LibXML::Element->new( "frontpage" ));
#if a message box is to be shown
if($query->param('information')) if($query->param('information'))
{ {
$page->appendChild(message("information", $query->param('information'), $query->param('value'))); $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'))); $page->appendChild(message("warning", $query->param('warning'), $query->param('value')));
} }
#new tagcloud xml element
my $tagcloud = XML::LibXML::Element->new( "tagcloud" ); my $tagcloud = XML::LibXML::Element->new( "tagcloud" );
#prepare query #prepare query
@ -34,9 +37,10 @@ my $sth = $dbh->prepare(qq{select text, count from tagcloud }) or die $dbh->errs
#execute it #execute it
$sth->execute() or die $dbh->errstr; $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()) while (my ($text, $count) = $sth->fetchrow_array())
{ {
#TODO: why not use <tag count="">text</tag>
my $tag = XML::LibXML::Element->new( "tag" ); my $tag = XML::LibXML::Element->new( "tag" );
$tag->appendTextChild("text", $text); $tag->appendTextChild("text", $text);
$tag->appendTextChild("count", $count); $tag->appendTextChild("count", $count);
@ -48,6 +52,7 @@ $sth->finish() or die $dbh->errstr;
$page->appendChild($tagcloud); $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"}) foreach $strquery ($config->{"search_frontpage_one_query"}, $config->{"search_frontpage_two_query"}, $config->{"search_frontpage_three_query"})
{ {
#new results block #new results block
@ -70,6 +75,7 @@ foreach $strquery ($config->{"search_frontpage_one_query"}, $config->{"search_fr
$license, $filesize, $duration, $width, $height, $fps, $viewcount, $license, $filesize, $duration, $width, $height, $fps, $viewcount,
$downloadcount) = $sth->fetchrow_array()) $downloadcount) = $sth->fetchrow_array())
{ {
#construct xml
my $result = XML::LibXML::Element->new( "result" ); my $result = XML::LibXML::Element->new( "result" );
$result->setAttribute( "thumbnail", $config->{"url_root"}."/video-stills/thumbnails/$id" ); $result->setAttribute( "thumbnail", $config->{"url_root"}."/video-stills/thumbnails/$id" );
$result->setAttribute( "preview", $config->{"url_root"}."/video-stills/previews/$id" ); $result->setAttribute( "preview", $config->{"url_root"}."/video-stills/previews/$id" );

View file

@ -15,6 +15,7 @@ if($query->param('action') eq "logout")
#remove sid from database #remove sid from database
$dbh->do(qq{update users set sid = '' where id = ?}, undef, $userinfo->{'id'}) or die $dbh->errstr; $dbh->do(qq{update users set sid = '' where id = ?}, undef, $userinfo->{'id'}) or die $dbh->errstr;
$session->delete(); $session->delete();
print $query->redirect("index.pl?information=information_logged_out"); print $query->redirect("index.pl?information=information_logged_out");
} }
#check if user is logged in #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 #create our openid consumer object
$con = Net::OpenID::Consumer->new( $con = Net::OpenID::Consumer->new(
ua => LWPx::ParanoidAgent->new, # FIXME - use LWPx::ParanoidAgent ua => LWPx::ParanoidAgent->new,
cache => undef, # or File::Cache->new, cache => undef, # or File::Cache->new,
args => $query, args => $query,
consumer_secret => $session->id, #is this save? don't know... consumer_secret => $session->id, #is this save? don't know...
required_root => $config->{"url_root"} ); required_root => $config->{"url_root"}
);
#claim identity #claim identity
$claimed = $con->claimed_identity($query->param('user')); $claimed = $con->claimed_identity($query->param('user'));
#if claim failed, redirect
if(!defined($claimed)) if(!defined($claimed))
{ {
print $query->redirect("/index.pl?error=error_openid_".$con->errcode); 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 #create our openid consumer object
$con = Net::OpenID::Consumer->new( $con = Net::OpenID::Consumer->new(
ua => LWPx::ParanoidAgent->new, # FIXME - use LWPx::ParanoidAgent ua => LWPx::ParanoidAgent->new,
cache => undef, # or File::Cache->new, cache => undef, # or File::Cache->new,
args => $query, args => $query,
consumer_secret => $session->id, #is this save? don't know... consumer_secret => $session->id, #is this save? don't know...
required_root => $config->{"url_root"} ); required_root => $config->{"url_root"}
);
#redirect to setup url
if($setup_url = $con->user_setup_url) if($setup_url = $con->user_setup_url)
{ {
#redirect to setup url - user will give confirmation there #redirect to setup url - user will give confirmation there
print $query->redirect($setup_url); print $query->redirect($setup_url);
} }
#or cancel process
elsif ($con->user_cancel) elsif ($con->user_cancel)
{ {
#cancelled - redirect to login form #cancelled - redirect to login form
print $query->redirect("index.pl"); print $query->redirect("index.pl");
} }
#or verify identity
elsif ($vident = $con->verified_identity) elsif ($vident = $con->verified_identity)
{ {
#we are verified!! #we are verified!!
@ -79,6 +87,7 @@ elsif($query->param('action') eq 'openid')
#check if this openid user already is in database #check if this openid user already is in database
my $sth = $dbh->prepare(qq{select 1 from users where username = ? limit 1 }); my $sth = $dbh->prepare(qq{select 1 from users where username = ? limit 1 });
$sth->execute($verified_url); $sth->execute($verified_url);
if($sth->fetchrow_array()) if($sth->fetchrow_array())
{ {
#store session id in database #store session id in database
@ -100,9 +109,10 @@ elsif($query->param('action') eq 'openid')
} }
} }
#else it's a normal login #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 '') 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 my $sth = $dbh->prepare(qq{select id from users
where password = password( ? ) and username = ? limit 1 }); where password = password( ? ) and username = ? limit 1 });

View file

@ -5,18 +5,24 @@ CGI::Session->name($config->{"page_cookie_name"});
$query = new CGI; $query = new CGI;
$session = new CGI::Session; $session = new CGI::Session;
#we receive a POST request (this MUST contain a content/type definiton to be recognized)
if ($query->param("POSTDATA")) 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 (!$@) if (!$@)
{ {
#set internal variables
my $method = $xmlpost->{"methodName"}; my $method = $xmlpost->{"methodName"};
my $source = $xmlpost->{"params"}->{"param"}[0]->{"value"}->{"string"}; my $source = $xmlpost->{"params"}->{"param"}[0]->{"value"}->{"string"};
my $target = $xmlpost->{"params"}->{"param"}[1]->{"value"}->{"string"}; my $target = $xmlpost->{"params"}->{"param"}[1]->{"value"}->{"string"};
#if this is really a pingback rpc request
if ($method eq "pingback.ping") if ($method eq "pingback.ping")
{ {
#if there are valid target and source nodes
if ($source =~ /^http:\/\// and $target =~ /^http:\/\//) if ($source =~ /^http:\/\// and $target =~ /^http:\/\//)
{ {
#fetch the source URI to verify that the source does indeed link to the target. #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 $ua = LWP::UserAgent->new;
my $response = $ua->request($request); my $response = $ua->request($request);
#if the url indeed exists
if ($response->is_success) if ($response->is_success)
{ {
#TODO: sanitize regex to grep site content #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. #check data to ensure that the target exists and is a valid entry.
my ($vid) = $target =~ /^$config->{'url_root'}\/video\/.*\/(\d+)\/.*/; 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 $sth = $dbh->prepare("select id from videos where id = ? limit 1");
my $rowcount = $sth->execute($vid) or die $dbh->errstr; my $rowcount = $sth->execute($vid) or die $dbh->errstr;
$sth->finish() or die $dbh->errstr; $sth->finish() or die $dbh->errstr;
#if we have what the client wants to ping
if ($rowcount) if ($rowcount)
{ {
#check that the pingback has not already been registered. #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; $rowcount = $sth->execute($vid) or die $dbh->errstr;
$sth->finish() or die $dbh->errstr; $sth->finish() or die $dbh->errstr;
#if this is a new request
if ($rowcount eq "0E0") if ($rowcount eq "0E0")
{ {
#record the pingback. #record the pingback.
$dbh->do(qq{insert into pingbacks (source, videoid, text, timestamp) values (?, ?, ?, unix_timestamp())}, undef, $dbh->do(qq{insert into pingbacks (source, videoid, text, timestamp) values (?, ?, ?, unix_timestamp())}, undef,
$source, $vid, $text) or die $dbh->errstr; $source, $vid, $text) or die $dbh->errstr;
#construct xml::simple hash
my $xml = (); my $xml = ();
$xml->{'params'}->{'param'}->{'value'}->{'string'} = ["Pingback from $source to $target registered. Keep the web talking! :-)"]; $xml->{'params'}->{'param'}->{'value'}->{'string'} = ["Pingback from $source to $target registered. Keep the web talking! :-)"];
@ -110,6 +121,7 @@ sub send_error
{ {
my ($faultCode, $faultString) = @_; my ($faultCode, $faultString) = @_;
#construct xml::simple hash
my $xml = (); my $xml = ();
push @{$xml->{'fault'}->{'value'}->{'struct'}->{'member'}}, push @{$xml->{'fault'}->{'value'}->{'struct'}->{'member'}},
{ {

View file

@ -14,21 +14,27 @@ my $page = get_page_array(@userinfo);
#check if query is set #check if query is set
if($query->param('query')) if($query->param('query'))
{ {
#construct querystring and arguments from user query
my ($dbquery, @args) = get_sqlquery($query->param('query')); my ($dbquery, @args) = get_sqlquery($query->param('query'));
#if successful
if($dbquery) if($dbquery)
{ {
#fill xml with search results
$page->appendChild(fill_results($dbquery, @args)); $page->appendChild(fill_results($dbquery, @args));
$page->setAttribute('query', $query->param('query')); $page->setAttribute('query', $query->param('query'));
$doc->setDocumentElement($page); $doc->setDocumentElement($page);
#get all results
my @results = $doc->findnodes( "//results/result" ); my @results = $doc->findnodes( "//results/result" );
#if result count is zero
if($#results == -1) if($#results == -1)
{ {
print $query->redirect("index.pl?warning=warning_no_results"); 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)) 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); 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"); print $query->redirect("index.pl?error=error_no_query");
} }
} }
elsif($query->param('advanced'))
{
print $query->redirect("index.pl?error=error_202c");
}
else else
{ {
print $query->redirect("index.pl?error=error_no_query"); print $query->redirect("index.pl?error=error_no_query");

View file

@ -1,5 +1,7 @@
require "functions.pl"; require "functions.pl";
#TODO: are settings obsolete?
#initialize session data #initialize session data
CGI::Session->name($config->{"page_cookie_name"}); CGI::Session->name($config->{"page_cookie_name"});
$query = new CGI; $query = new CGI;

View file

@ -53,7 +53,7 @@ while(1)
{ {
#video height is either the maximum video height #video height is either the maximum video height
#or (when the original is smaller than that) the original 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"}; $vheight = $height <= $config->{"video_height_max"} ? int($height/8 + .5)*8 : $config->{"video_height_max"};
$vwidth = int($vheight*($width/$height)/8 + .5)*8; $vwidth = int($vheight*($width/$height)/8 + .5)*8;

View file

@ -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; $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 = $dbh->prepare("select subject from videos");
$sth->execute(); $sth->execute();
#cycle through all video subjects #cycle through all video subjects
while(($subject) = $sth->fetchrow_array()) while(($subject) = $sth->fetchrow_array())
{ {
#TODO: make split char configureable
@subject = split(' ', $subject); @subject = split(' ', $subject);
#cycle through all tags of video #cycle through all tags of video
foreach my $val (@subject) foreach my $val (@subject)
{ {
#strip whitespaces #add/increment correct hash value
$val =~ s/^\s*(.*?)\s*$/$1/; %hash->{$val}++;
if(length($val) >= $config->{"page_tag_lenght_min"})
{
%hash->{$val}++;
}
} }
} }
$sth->finish(); $sth->finish();
@ -33,9 +32,11 @@ $sth->finish();
#sort by count #sort by count
@sorted = sort {$hash{$b} cmp $hash{$a}} keys %hash; @sorted = sort {$hash{$b} cmp $hash{$a}} keys %hash;
#clean tagcloud
$dbh->do("delete from tagcloud"); $dbh->do("delete from tagcloud");
$sth = $dbh->prepare("insert into tagcloud (text, count) values (?, ?)"); $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++) for($i=0;$i<$config->{"page_tag_count"} and $i<=$#sorted;$i++)
{ {
$sth->execute( $sorted[$i], %hash->{$sorted[$i]} ); $sth->execute( $sorted[$i], %hash->{$sorted[$i]} );

View file

@ -28,6 +28,7 @@ if($userinfo->{'username'})
@unique{ @subject } = (); @unique{ @subject } = ();
foreach $tag (keys %unique) foreach $tag (keys %unique)
{ {
$tag =~ s/^\s*(.*?)\s*$/$1/;
if(length($tag) >= $config->{"page_tag_lenght_min"}) if(length($tag) >= $config->{"page_tag_lenght_min"})
{ {
$subject.=$tag." "; $subject.=$tag." ";

View file

@ -92,6 +92,7 @@ if($userinfo->{'id'} && $query->param("DC.Title") &&
} }
else else
{ {
#generate unique hash
$sha = new Digest::SHA(256); $sha = new Digest::SHA(256);
$sha->addfile("/tmp/$id"); $sha->addfile("/tmp/$id");
$sha = $sha->hexdigest; $sha = $sha->hexdigest;
@ -112,12 +113,15 @@ if($userinfo->{'id'} && $query->param("DC.Title") &&
} }
else else
{ {
#get video container and duration
($container, $duration) = $info =~ /Input \#0, (\w+),.+?\n.+?Duration: (\d{2}:\d{2}:\d{2}\.\d)/; ($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 #these two regexes have to be applied seperately because nobody knows which stream (audio or video) comes first
($audio) = $info =~ /Audio: (\w+)/; ($audio) = $info =~ /Audio: (\w+)/;
($video, $width, $height, $fps) = $info =~ /Video: ([\w\d]+),.+?(\d+)x(\d+),.+?(\d+\.\d+) fps/; ($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) if(!$video or !$duration)
{ {
#delete from uploaded table #delete from uploaded table
@ -125,6 +129,7 @@ if($userinfo->{'id'} && $query->param("DC.Title") &&
unlink "/tmp/$id"; unlink "/tmp/$id";
print $query->redirect("index.pl?error=error_upload_invalid_stream"); print $query->redirect("index.pl?error=error_upload_invalid_stream");
} }
#if the video width is smaller than allowed
elsif($width < $config->{"video_width_min"}) elsif($width < $config->{"video_width_min"})
{ {
#delete from uploaded table #delete from uploaded table
@ -132,6 +137,7 @@ if($userinfo->{'id'} && $query->param("DC.Title") &&
unlink "/tmp/$id"; unlink "/tmp/$id";
print $query->redirect("index.pl?error=error_upload_video_width_too_small&value=".$config->{"video_width_min"}); 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"}) elsif($height < $config->{"video_height_min"})
{ {
#delete from uploaded table #delete from uploaded table
@ -141,6 +147,7 @@ if($userinfo->{'id'} && $query->param("DC.Title") &&
} }
else else
{ {
#get video filesize
$filesize = -s "/tmp/$id"; $filesize = -s "/tmp/$id";
#convert hh:mm:ss.s duration to full seconds - thanks perl for making this so damn easy! #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 =~ /^(\d{2}):(\d{2}):(\d{2})\.(\d)$/;
$duration = int($1*3600 + $2*60 + $3 + $4/10 + .5); $duration = int($1*3600 + $2*60 + $3 + $4/10 + .5);
#create thumbnail #get thumbnail position
$thumbnailsec = int(rand($duration)); $thumbnailsec = int(rand($duration));
$previewsec = $thumbnailsec; $previewsec = $thumbnailsec;
@ -157,6 +164,7 @@ if($userinfo->{'id'} && $query->param("DC.Title") &&
$tnheight = $config->{"video_thumbnail_height"}; $tnheight = $config->{"video_thumbnail_height"};
$tnwidth = int($tnheight*($width/$height)/2 + .5)*2; $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"; $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"; $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 #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 ($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("/tmp/$id", "$root/videos/$id"))
{ {
#if move was successful
#add video to videos table #add video to videos table
$dbh->do(qq{insert into videos select id, title, description, userid, timestamp, creator, $dbh->do(qq{insert into videos select id, title, description, userid, timestamp, creator,
subject, source, language, coverage, rights, license, ?, ?, ?, ?, ?, ?, 0, 0 subject, source, language, coverage, rights, license, ?, ?, ?, ?, ?, ?, 0, 0

View file

@ -14,6 +14,7 @@ my $page = get_page_array(@userinfo);
#check if id or title is passed #check if id or title is passed
if($query->url_param('id')) if($query->url_param('id'))
{ {
#initiate database query
$dbquery = "select v.id, v.title, v.description, u.username, from_unixtime( v.timestamp ), $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.creator, v.subject, v.source, v.language, v.coverage, v.rights,
v.license, filesize, duration, width, height, fps, viewcount, downloadcount v.license, filesize, duration, width, height, fps, viewcount, downloadcount
@ -22,9 +23,11 @@ if($query->url_param('id'))
@args = ($query->url_param('id')); @args = ($query->url_param('id'));
$sth = $dbh->prepare($dbquery); $sth = $dbh->prepare($dbquery);
#test wether the video exists
$rowcount = $sth->execute(@args) or die $dbh->errstr; $rowcount = $sth->execute(@args) or die $dbh->errstr;
#if there are still no results #if there are no results
if($rowcount == 0) if($rowcount == 0)
{ {
#check if maybe the video has not yet been converted #check if maybe the video has not yet been converted
@ -35,12 +38,16 @@ if($query->url_param('id'))
#if id is found #if id is found
if($rowcount == 1) if($rowcount == 1)
{ {
#calculate the overall length of video to be encoded
$sth = $dbh->prepare("select sum(duration) from uploaded where id < ?"); $sth = $dbh->prepare("select sum(duration) from uploaded where id < ?");
$sth->execute($query->url_param('id')) or die $dbh->errstr; $sth->execute($query->url_param('id')) or die $dbh->errstr;
($length) = $sth->fetchrow_array(); ($length) = $sth->fetchrow_array();
#convert hours, minutes and seconds fromoverall seconds
$h = int($length/3600); $h = int($length/3600);
$m = int($length/60-$h*60); $m = int($length/60-$h*60);
$s = int($length-$m*60-$h*3600); $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"); print $query->redirect("/index.pl?information=information_video_not_yet_available&value=".$h."h ".$m."m ".$s."s");
} }
else else
@ -52,6 +59,7 @@ if($query->url_param('id'))
} }
elsif($rowcount == 1) elsif($rowcount == 1)
{ {
#set embed attribute if requested
if($query->param('embed') eq "video") if($query->param('embed') eq "video")
{ {
$page->setAttribute( "embed", "video" ); $page->setAttribute( "embed", "video" );
@ -61,31 +69,31 @@ if($query->url_param('id'))
$page->setAttribute( "embed", "preview" ); $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 user is logged in
if($userinfo->{'username'}) if($userinfo->{'username'})
{ {
#check if a comment is about to be created #check if a comment is about to be created
if($query->param('comment')) if($query->param('comment'))
{ {
#prepare new dtd
my $dtd = XML::LibXML::Dtd->new(0, "$root/site/comment.dtd"); my $dtd = XML::LibXML::Dtd->new(0, "$root/site/comment.dtd");
$dom = XML::LibXML->new; $dom = XML::LibXML->new;
$dom->clean_namespaces(1); $dom->clean_namespaces(1);
#try to parse user's comment
eval { $doc = $dom->parse_string("<comment>".$query->param('comment')."</comment>") }; eval { $doc = $dom->parse_string("<comment>".$query->param('comment')."</comment>") };
#die if error
if ($@) if ($@)
{ {
die $@; die $@;
} }
else else
{ {
#try to validate against dtd
eval { $doc->validate($dtd) }; eval { $doc->validate($dtd) };
#die if error
if ($@) if ($@)
{ {
die $@; die $@;
@ -100,7 +108,9 @@ if($query->url_param('id'))
$userinfo->{'id'}, $id, $query->param('comment')) or die $dbh->errstr; $userinfo->{'id'}, $id, $query->param('comment')) or die $dbh->errstr;
#send pingbacks to every url in the comment #send pingbacks to every url in the comment
my (@matches) = $query->param('comment') =~ /<a[^>]+href="(http:\/\/\S+)"[^>]*>.+?<\/a>/gi; my (@matches) = $query->param('comment') =~ /<a\s[^>]*href="(http:\/\/\S+)"[^>]*>.+?<\/a>/gi;
#for every match send a pingback
foreach $match (@matches) foreach $match (@matches)
{ {
#ask for http header only - if pingbacks are implemented right, then we wont need the full site #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); my $response = $ua->request($request);
#if successful response
if ($response->is_success) if ($response->is_success)
{ {
my $pingbackurl = $response->header("x-pingback"); my $pingbackurl = $response->header("x-pingback");
@ -119,6 +130,7 @@ if($query->url_param('id'))
$request = HTTP::Request->new(GET => $match); $request = HTTP::Request->new(GET => $match);
$response = $ua->request($request); $response = $ua->request($request);
#get the link if response was successful
if ($response->is_success) if ($response->is_success)
{ {
($pingbackurl) = $response->content =~ /<link rel="pingback" href="([^"]+)" ?\/?>/; ($pingbackurl) = $response->content =~ /<link rel="pingback" href="([^"]+)" ?\/?>/;
@ -131,6 +143,7 @@ if($query->url_param('id'))
#TODO: expand xml entities &lt; &gt; &amp; &quot; in $pingbackurl #TODO: expand xml entities &lt; &gt; &amp; &quot; in $pingbackurl
#contruct the xml-rpc request #contruct the xml-rpc request
#TODO: do this with xml::libxml
my $xmlpost = (); my $xmlpost = ();
$xmlpost->{"methodName"} = ["pingback.ping"]; $xmlpost->{"methodName"} = ["pingback.ping"];
push @{$xmlpost->{'params'}->{'param'} }, push @{$xmlpost->{'params'}->{'param'} },
@ -168,6 +181,15 @@ 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" ); my $video = XML::LibXML::Element->new( "video" );
$video->setAttribute('thumbnail', $config->{"url_root"}."/video-stills/thumbnails/$id"); $video->setAttribute('thumbnail', $config->{"url_root"}."/video-stills/thumbnails/$id");
$video->setAttribute('preview', $config->{"url_root"}."/video-stills/previews/$id"); $video->setAttribute('preview', $config->{"url_root"}."/video-stills/previews/$id");
@ -242,6 +264,7 @@ if($query->url_param('id'))
$node->appendText($title); $node->appendText($title);
$work->appendChild($node); $work->appendChild($node);
#TODO: add license conditions
my $license = XML::LibXML::Element->new( "License" ); my $license = XML::LibXML::Element->new( "License" );
$license->setNamespace("http://web.resource.org/cc/", "cc"); $license->setNamespace("http://web.resource.org/cc/", "cc");
$license->setNamespace("http://www.w3.org/1999/02/22-rdf-syntax-ns#", "rdf", 0); $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); $page->appendChild($video);
#get comments #get comments - this will also include newly created comments
my $comments = XML::LibXML::Element->new( "comments" ); my $comments = XML::LibXML::Element->new( "comments" );
$sth = $dbh->prepare(qq{select comments.id, comments.text, users.username, from_unixtime( comments.timestamp ) $sth = $dbh->prepare(qq{select comments.id, comments.text, users.username, from_unixtime( comments.timestamp )
from comments, users where from comments, users where
comments.videoid=? and users.id=comments.userid}) or die $dbh->errstr; comments.videoid=? and users.id=comments.userid}) or die $dbh->errstr;
$sth->execute($id) 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()) while (my ($commentid, $text, $username, $timestamp) = $sth->fetchrow_array())
{ {
#create new xml node
my $dom = XML::LibXML->new; my $dom = XML::LibXML->new;
#parse database string to xml
my $doc = $dom->parse_string("<comment>".$text."</comment>"); my $doc = $dom->parse_string("<comment>".$text."</comment>");
my $comment = $doc->documentElement(); my $comment = $doc->documentElement();
#add xhtml namespace prefix to every node
foreach $node ($comment->getElementsByTagName("*")) foreach $node ($comment->getElementsByTagName("*"))
{ {
$node->setNamespace("http://www.w3.org/1999/xhtml", "xhtml"); $node->setNamespace("http://www.w3.org/1999/xhtml", "xhtml");