added yolanda-upload.pl for batch uploads and moved yolanda external apps to a seperate folder
git-svn-id: http://yolanda.mister-muffin.de/svn@206 7eef14d0-6ed0-489d-bf55-20463b2d70db
This commit is contained in:
josch
parent
12f0f05d95
commit
51015545b2
4 changed files with 356 additions and 1 deletions
188
trunk/tools/daemon.pl
Executable file
188
trunk/tools/daemon.pl
Executable file
|
|
@ -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;
|
||||
}
|
||||
}
|
||||
32
trunk/tools/tagcloud.pl
Executable file
32
trunk/tools/tagcloud.pl
Executable file
|
|
@ -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]} );
|
||||
}
|
||||
134
trunk/tools/yolanda-upload.pl
Executable file
134
trunk/tools/yolanda-upload.pl
Executable file
|
|
@ -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 <video file> ",
|
||||
"-t <title> ",
|
||||
"-d <description> ",
|
||||
"-x <space separated tags>",
|
||||
"-c <creator>",
|
||||
"-s <source>",
|
||||
"-l <language>",
|
||||
"-v <coverage>\n\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
my %opts;
|
||||
getopts('u:p:f:t:d:x:c:s:l:v:', \%opts);
|
||||
|
||||
unless (defined $opts{u}) {
|
||||
unless (length USER) {
|
||||
preamble();
|
||||
print "Username was neither defined nor passed as an argument\n";
|
||||
print "Use -u switch to specify the username\n";
|
||||
print "Example: -u joe_random\n";
|
||||
exit 1;
|
||||
}
|
||||
else {
|
||||
$opts{l} = USER;
|
||||
}
|
||||
}
|
||||
|
||||
unless (defined $opts{p}) {
|
||||
unless (length PASS) {
|
||||
preamble();
|
||||
print "Password was neither defined nor passed as an argument\n";
|
||||
print "Use -p switch to specify the password\n";
|
||||
print "Example: -p secretPass\n";
|
||||
exit 1;
|
||||
}
|
||||
else {
|
||||
$opts{p} = PASS;
|
||||
}
|
||||
}
|
||||
|
||||
unless (defined $opts{f} && length $opts{f}) {
|
||||
preamble();
|
||||
print "No video file was specified\n";
|
||||
print "Use -f switch to specify the video file\n";
|
||||
print 'Example: -f "C:\Program Files\movie.avi"', "\n";
|
||||
print 'Example: -f "/home/pkrumins/super.cool.video.wmv"', "\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
unless (-r $opts{f}) {
|
||||
preamble();
|
||||
print "Video file is not readable or does not exist\n";
|
||||
print "Check the permissions and the path to the file\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
unless (defined $opts{t} && length $opts{t}) {
|
||||
preamble();
|
||||
print "No video title was specified\n";
|
||||
print "Use -t switch to set the title of the video\n";
|
||||
print 'Example: -t "Super Cool Video Title"', "\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
|
||||
$ua = LWP::UserAgent->new(cookie_jar => {});
|
||||
|
||||
push @{$ua->requests_redirectable}, 'POST';
|
||||
|
||||
print "Getting sid cookie...\n";
|
||||
$response = $ua->request(GET $url);
|
||||
unless($response->is_success)
|
||||
{
|
||||
die "Failed opening $url: ",
|
||||
$response->status_line;
|
||||
}
|
||||
|
||||
print "Logging in to $url/login.pl...\n";
|
||||
$response = $ua->request(POST "$url/login.pl", "Content_Type" => "form-data", "Content" => [action => login, user => test, pass => test]);
|
||||
unless($response->is_success)
|
||||
{
|
||||
die "Failed logging in: ",
|
||||
$response->status_line;
|
||||
}
|
||||
unless($response->content =~ /action=logout/)
|
||||
{
|
||||
die "Failed logging in: username/password do not match";
|
||||
}
|
||||
|
||||
print "Uploading $opts{f} to $url/uploader.pl...\n";
|
||||
$response = $ua->request(POST "$url/uploader.pl",
|
||||
"Content_Type" => "multipart/form-data",
|
||||
"Content" => [
|
||||
file => [$opts{f}],
|
||||
"DC.Title" => $opts{t},
|
||||
"DC.Description" => $opts{d},
|
||||
"DC.Subject" => $opts{x},
|
||||
"DC.Creator" => $opts{c} ? $opts{c} : "",
|
||||
"DC.Source" => $opts{s} ? $opts{s} : "",
|
||||
"DC.Language" => $opts{l} ? $opts{l} : "",
|
||||
"DC.Coverage" => $opts{v} ? $opts{v} : "",
|
||||
]
|
||||
);
|
||||
unless($response->is_success)
|
||||
{
|
||||
die "Failed uploading: ",
|
||||
$response->status_line;
|
||||
}
|
||||
print "Done!\n";
|
||||
|
|
@ -20,7 +20,8 @@ sub hook
|
|||
|
||||
@page = get_page_array(@userinfo);
|
||||
|
||||
if($userinfo->{'id'}&&$query->param("DC.Title") && $query->param("DC.Description") && $query->param("DC.Subject"))
|
||||
if($userinfo->{'id'} && $query->param("DC.Title") &&
|
||||
$query->param("DC.Description") && $query->param("DC.Subject"))
|
||||
{
|
||||
#make new entry for video into the databse
|
||||
#FIXME: contributor, rights
|
||||
|
|
|
|||
Loading…
Reference in a new issue