diff --git a/trunk/tools/daemon.pl b/trunk/tools/daemon.pl new file mode 100755 index 0000000..df4a50b --- /dev/null +++ b/trunk/tools/daemon.pl @@ -0,0 +1,188 @@ +#!/usr/bin/perl -w + +use Proc::Daemon; +use DBI; +use Digest::SHA; +use File::Copy; + +$database = 'yolanda'; +$dbhost = 'localhost'; +$dbuser = 'root'; +$dbpass = ''; +$root = '/var/www/yolanda'; + +#TODO: deamonize by uncommenting this line +#Proc::Daemon::Init; + +$LOG = "$root/daemon.log"; + + +sub appendlog +{ + if (open(FILE, ">>$LOG")) + { + print FILE scalar(localtime)." ".$$." ".join(" ",@_)."\n"; + close FILE; + } +} + +sub interrupt +{ + appendlog(@_); + die; +} + +$dbh = DBI->connect("DBI:mysql:$database:$dbhost", $dbuser, $dbpass) or interrupt "could not connect to db"; + +#video status: +# 0 - new entry - nothing done yet +# 1 - valid public video +# 2 - error: invalid audio and/or video stream +# 3 - error: file not found +# 4 - error: file is not a video +# 5 - error: video is a duplicate + +while(1) +{ + #get fresh video id from db + my $sth = $dbh->prepare(qq{select id from uploaded where status = 0 limit 1}) or interrupt $dbh->errstr; + + $sth->execute() or interrupt $dbh->errstr; + my ($id) = $sth->fetchrow_array(); + $sth->finish() or interrupt $dbh->errstr; + + if($id) + { + $info = `ffplay -stats -an -vn -nodisp $root/tmp/$id 2>&1`; + + if($info =~ /ignoring/) + { + appendlog $id, "invalid stream"; + + #write status 2 to uploaded table + $dbh->do(qq{update uploaded set status = ? where id = ?}, undef, 2, $id) or interrupt $dbh->errstr; + unlink "$root/tmp/$id"; + } + elsif ($info =~ /I\/O error occured/) + { + appendlog $id, "file not found"; + + #write status 3 to uploaded table + $dbh->do(qq{update uploaded set status = ? where id = ?}, undef, 3, $id) or interrupt $dbh->errstr; + unlink "$root/tmp/$id"; + } + elsif ($info =~ /Unknown format/ or $info =~ /could not find codec parameters/) + { + appendlog $id, "file is no video"; + + #write status 4 to uploaded table + $dbh->do(qq{update uploaded set status = ? where id = ?}, undef, 4, $id) or interrupt $dbh->errstr; + unlink "$root/tmp/$id"; + } + else + { + $sha = new Digest::SHA(256); + $sha->addfile("$root/tmp/$id"); + $sha = $sha->hexdigest; + + #check if this hash is already in database + my $sth = $dbh->prepare(qq{select id from videos where hash = ? limit 1}) or interrupt $dbh->errstr; + $sth->execute($sha) or interrupt $dbh->errstr; + my ($resultid) = $sth->fetchrow_array(); + $sth->finish() or interrupt $dbh->errstr; + + #if so, then video is a duplicate + if($resultid) + { + appendlog "$id, video already uploaded: $resultid"; + + #write status 5 to uploaded table + $dbh->do(qq{update uploaded set status = ? where id = ?}, undef, 5, $id) or interrupt $dbh->errstr; + unlink "$root/tmp/$id"; + } + else + { + ($container, $duration) = $info =~ /Input \#0, (\w+),.+?\n.+?Duration: (\d{2}:\d{2}:\d{2}\.\d)/; + + #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+)x(\d+),.+?(\d+\.\d+) fps/; + + if(!$audio or !$video or !$duration) + { + appendlog $id, "a stream is missing or video is corrupt"; + + #write status 2 to uploaded table + $dbh->do(qq{update uploaded set status = ? where id = ?}, undef, 2, $id) or interrupt $dbh->errstr; + unlink "$root/tmp/$id"; + } + else + { + #TODO: maybe delete entry from uploaded table after successful upload? + $filesize = -s "$root/tmp/$id"; + + #convert hh:mm:ss.s duration to full seconds - thanks perl for making this so damn easy! + #don't want to know how this would look in python or php... hell I don't even have to create extra variables! + $duration =~ /^(\d{2}):(\d{2}):(\d{2})\.(\d)$/; + $duration = int($1*3600 + $2*60 + $3 + $4/10 + .5); + + #create thumbnail + $thumbnailsec = int($duration/3 + .5); + + #the width/height calculation could of course be much shorter but less readable then + #all thumbs have equal height + $tnmaxheight = 120; + $tnheight = $tnmaxheight; + $tnwidth = int($tnheight*($width/$height)/2 + .5)*2; + + system "ffmpeg -i $root/tmp/$id -vcodec mjpeg -vframes 1 -an -f rawvideo -ss $thumbnailsec -s ".$tnwidth."x$tnheight $root/video-stills/$id"; + + $vmaxheight = 240; + + #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' and $height <= $vmaxheight) + { + appendlog $id, "file already is ogg-theora/vorbis"; + + #add video to videos table + $dbh->do(qq{insert into videos select id, title, description, userid, timestamp, creator, + subject, contributor, source, language, coverage, rights, license, notice, + derivativeworks, sharealike, commercialuse, ?, ?, ?, ?, ?, ?, 0, 0 + from uploaded where id = ?}, undef, $filesize, $duration, $width, + $height, $fps, $sha, $id) or interrupt $dbh->errstr; + + #move video + move "$root/tmp/$id", "$root/videos/$id"; + } + else #encode video + { + #calculate video width + $vheight = $vmaxheight <= $height ? $vmaxheight : $height; + $vwidth = int($vheight*($width/$height)/2 + .5)*2; + + #TODO: addmetadata information + system "ffmpeg2theora --optimize --videobitrate 1000 --audiobitrate 64 --sharpness 0 --width $vwidth --height $vheight --output $root/videos/$id $root/tmp/$id 2>&1"; + appendlog $id, $audio, $video, $vwidth, $vheight, $fps, $duration, $sha; + + #add video to videos table + $dbh->do(qq{insert into videos select id, title, description, userid, timestamp, creator, + subject, contributor, source, language, coverage, rights, license, notice, + derivativeworks, sharealike, commercialuse, ?, ?, ?, ?, ?, ?, 0, 0 + from uploaded where id = ?}, undef, $filesize, $duration, $vwidth, + $vheight, $fps, $sha, $id) or interrupt $dbh->errstr; + + #delete temp file + unlink "$root/tmp/$id"; + } + + #delete from uploaded table + $dbh->do(qq{delete from uploaded where id = ?}, undef, $id) or interrupt $dbh->errstr; + } + } + } + } + else + { + sleep 10; + } +} diff --git a/trunk/tools/tagcloud.pl b/trunk/tools/tagcloud.pl new file mode 100755 index 0000000..6ffb8af --- /dev/null +++ b/trunk/tools/tagcloud.pl @@ -0,0 +1,32 @@ +#!/usr/bin/perl -w + +use DBI; + +$database = 'yolanda'; +$dbhost = 'localhost'; +$dbuser = 'root'; +$dbpass = ''; + +$dbh = DBI->connect("DBI:mysql:$database:$dbhost", $dbuser, $dbpass); + +$sth = $dbh->prepare("select subject from videos"); +$sth->execute(); +while(($subject) = $sth->fetchrow_array()) +{ + @subject = split(',', $subject); + foreach my $val (@subject) + { + $val =~ s/^\s*(.*?)\s*$/$1/; + %hash->{$val}++; + } +} +$sth->finish(); + +@sorted = sort {$hash{$b} cmp $hash{$a}} keys %hash; + +$dbh->do("delete from tagcloud"); +$sth = $dbh->prepare("insert into tagcloud (text, count) values (?, ?)"); +for($i=0;$i<20 and $i<=$#sorted;$i++) +{ + $sth->execute( $sorted[$i], %hash->{$sorted[$i]} ); +} diff --git a/trunk/tools/yolanda-upload.pl b/trunk/tools/yolanda-upload.pl new file mode 100755 index 0000000..f5bcdbb --- /dev/null +++ b/trunk/tools/yolanda-upload.pl @@ -0,0 +1,134 @@ +#!/usr/bin/perl + +use LWP::UserAgent; +use HTTP::Request::Common; +use Getopt::Std; + +sub preamble { + print "yolanda-upload by Johannes Schauer (josch)\n"; + print "http://yolanda.mister-muffin.de/trac\n"; + print "\n" +} + +# set these values for default -l (login) and -p (pass) values +# +use constant USER => ""; +use constant PASS => ""; + +# various urls +my $url = 'http://localhost'; + +unless (@ARGV) { + preamble(); + print "Usage: $0 ", + "-u [username] ", + "-p [password] ", + "-f