#!/usr/bin/perl
#
# mediaserv - On-demand Nokia Internet Tablet transcoding server
# ~~~~~~~~~   (c) Andrew Flegg 2007. Released under the Artistic Licence.
# v0.05       http://www.bleb.org/software/maemo/
# 
# Structure based on basic pre-forking HTTP daemon - version 2
# By Peter Cooper - http://www.petercooper.co.uk/

use warnings;
use strict;

use HTTP::Date;
use HTTP::Daemon;
use HTTP::Status;
use POSIX;
use File::Temp qw(tempfile tempdir);
use File::Find;
use File::Copy;
use XML::RSS;


my $port            = 8090;
my $totalChildren   = 5;                # Number of listening children
my $baseDir         = '/data';          # Root of video content
my $encoder         = '';               # Path to 770-encode
my $preset          = 'smallest';       # 770-encode preset to use
my $keepResults     = 0;                # Don't delete transcoded files
my $mediaExtensions = 'avi mpg ts mov wmv mp4 mkv mpeg rmvb';
my $maxRssItems     = 14;
my $encoderOptions  = '';

my $mythName  = '';                   # Path to mythname.pl script
my $mythDir   = '';                   # Path to MythTV recordings
my $freevoVfs = '';                   # Path to Freevo VFS

my $ip = '';                          # Change the worked out server address
my $url = '';                         # The listening URL
my $childLifetime = 20;               # Let each child serve this many requests
my $logFile = "/tmp/mediaserv.log";   # Log requests and errors to this file
my $sleepTime = 2;                    # Sleep time adjusted for speed of box

# -- Read configuration and override defaults...
#
use vars qw(%HANDLERS $BASE_DIR $DATA_DIR $MAX_RSS @MEDIA_EXT @ENC_OPTS $URL);
$DATA_DIR  = $ENV{HOME}.'/.mediaserv';
if (open(IN, "<$DATA_DIR/config")) {
    while(<IN>) {
        next unless /^\s*(\w+)\s*=\s*(.*)$/;
        print "Overriding $1 to [$2]...\n";
        eval("\$$1 = $2;");
    }
    close(IN);
}

# -- Constants...
#
$BASE_DIR  = $baseDir;
$MAX_RSS   = $maxRssItems;
@MEDIA_EXT = split /\s+/, $mediaExtensions;
@ENC_OPTS  = split /\s+/, $encoderOptions;
%HANDLERS  = (
    rss    => \&doRss,
    browse => \&doBrowse,
    static => \&doStatic,
    image  => \&doImage,
    spf    => \&doVideoCenter,    
);

my $haveTotem = `which totem-video-thumbnailer` !~ /^[\s\r\n]*$/m;
my %children;                         # Store pids of children
my $children = 0;                     # Number of currently active children
my $serving  = '';
$mythDir   ||= $baseDir;

# -- Find an encoder if necessary...
#
$encoder ||= 'tablet-encode' if system("which", "tablet-encode") == 0;
$encoder ||= '770-encode'    if system("which", "770-encode")    == 0;

# -- Try and work out the main interface's IP address...
#
unless ($ip) {
    local $ENV{PATH} = '/usr/local/sbin:/usr/sbin:/sbin:'.$ENV{PATH};
    $ip = `ifconfig \$(netstat -arn | awk '\$1 ~ /0\.0\.0\.0/ {print \$8; exit}')`;
    $ip =~ s/^.*?:(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}) .*$/$1/s if $ip;
}

# -- See if we can use Gnome to get thumbnails for videos...
#
my $thumbnailFactory;
if (eval{require Gnome2}) {
   $thumbnailFactory = Gnome2::ThumbnailFactory->new ('GNOME_THUMBNAIL_SIZE_NORMAL');
}

# -- Clean out prior stuff, work out who we are and run...
#
system('rm', '-rf', "$DATA_DIR/pids");
&mkdirDeep('', "$DATA_DIR/pids");
&mkdirDeep('', "$DATA_DIR/data");
($0) = $0 =~ /(?:^|\b)(media\S+)/;
my $d = HTTP::Daemon->new( LocalAddr => $ip, LocalPort => $port, Reuse => 1 ) or
    die "Unable to open socket $ip:$port - $!\n";
$URL = $d->url;
$URL =~ s!/$!!;
$URL =~ s!//([\w\.]+)!//$ip! if $ip;
$URL = $url if $url;
warn "mediaserv running at $URL\n";

&daemonize;                                      # Daemonize the parent
&spawnChildren;
&keepTicking;
exit;


# =======================================================================
# doBrowse - serve an HTML representation of a given directory
#
sub doBrowse {
    my ($method, $response, $path) = @_;
    
    $path =~ s/\.(\w+)\.avi$/.$1/;
    return &serveMedia($method, $response, $path) if &isMedia("$BASE_DIR/$path");

    # -- Just browsing from here on...
    #    
    my $safePath = &xmlEscape($path);
    my $uriPath  = &escape($path);
    my $content = <<EOM;
<html>
<head>
<title>mediaserv: $safePath</title>
<link rel="stylesheet" href="/static/styles.css" type="text/css" />
<link rel="alternate" title="$safePath mediaserv updates" href="/rss/$uriPath" type="application/rss+xml" />
<script src="/static/reflection.js" type="text/javascript"></script>
</head>
<body>
EOM

    my $backtrail = '<a href="/browse/">mediaserv</a>';
    my $loc       = '';
    while ("/$path" =~ m!^$loc/([^/]*?)/!) {
        $loc       .= "/$1";
        $backtrail .= " &gt; <a href=\"/browse$loc\">$1</a>";
    }
    $backtrail .= " &gt; $1" if $path =~ m!([^/]+?)$!;
    $content .= "<h1>$backtrail</h1>";

    if (-d "$BASE_DIR/$path") {
        $content .= "<ul>\n";
        foreach my $f (&readmedia($path)) {
            my $name  = &escape($f->{file});
            my $link  = &escape($f->{target});
            my $title = &xmlEscape($f->{title});
            my $sub   = &xmlEscape($f->{subtitle});
            my $desc  = &xmlEscape($f->{description});
            my $type  = $f->{type};
            my $image = $type eq 'media' ? "/image/$name" : "/static/folder.png";
            $content .= <<EOM;
<li class="$type"><a href="/browse/$link"><img src="$image"
class="reflect rheight33" width="100" height="66" />$title</a>
<span class="subtitle">$sub</span>
<span class="description">$desc</span>
</li>
EOM
        }
        $content .= <<EOM;
</ul>

<div class="controls">
<a class="rss" href="/rss/$uriPath">RSS</a>
<a class="videocenter" href="/spf/$uriPath.vcfg">Add to <i>Video Center</i></a>
</div>
EOM
    } else {
        $content .= "<h2>Not found</h2>\n";
    }
        
    $response->header( 'Content-Type' => 'text/html; charset=utf-8' );
    $response->content($content);
}    


# =======================================================================
# doRss - serve an RSS representation of a given directory
#
sub doRss {
    my ($method, $response, $dir) = @_;
    
    my @files = ();
    find(sub { push @files, $File::Find::name if &isMedia($File::Find::name) }, "$BASE_DIR/$dir");
    @files = (map { s/$BASE_DIR\///; $_ } sort { (stat($b))[9] <=> (stat($a))[9] } @files)[0..$MAX_RSS];

    my $rss = new XML::RSS( version => '2.0', encoding => 'utf-8' );
    $rss->channel(
        title => "$dir media",
        link  => "$URL/do/$dir",
        description => "On-demand content from $dir",
        pubDate     => time2str()
    );
    $rss->add_module( prefix => 'media', uri => 'http://search.yahoo.com/mrss/' );

    foreach my $file (reverse(@files)) {
        my $info = &getMediaInfo($file);
        $file = &escape($file);
        $rss->add_item(
            title     => $info->{title},
            description => "<img src=\"$URL/image/$file.jpg\" align=\"left\" />".$info->{description},
            link      => "$URL/browse/$file",
            pubDate   => time2str((stat("$BASE_DIR/$file"))[9]),
            mode      => 'insert',
            enclosure => { url => "$URL/browse/$file", type => 'video/x-msvideo' },
            media => {
              thumbnail => "$URL/image/$file.jpg",
            }
        );
    }

    $response->header( 'Content-Type' => 'application/xhtml+xml' );
    $response->content( $rss->as_string );
}


# =======================================================================
# doStatic - serve supporting objects
#
sub doStatic {
    my ($method, $response, $file) = @_;
    
    $serving = "$DATA_DIR/$file";
    my $contentType = 'application/octet-stream';
    if ($file =~ /\.jpg$/) {
      $contentType = 'image/jpeg';
    } elsif ($file =~ /\.png$/) {
      $contentType = 'image/png';
    } elsif ($file =~ /\.css$/) {
      $contentType = 'text/css';
    } elsif ($file =~ /\.avi$/) {
      $contentType = 'video/x-msvideo';
      &mkdirDeep($DATA_DIR, "pids/$file/");
      system('ln', '-snf', "$file/$$", "$DATA_DIR/pids/$$");
      system('ln', '-snf', $serving, "$DATA_DIR/pids/$file/$$");
    }

    open(IN, "<$serving") or &logMessage("Unable to open $serving for reading");
    $response->header( 'Content-Type' => $contentType );
    $response->content( \&read_file ) if $method eq 'GET';
}


# =======================================================================
# doVideoCenter - create a VideoCenter config file for the resource
#
sub doVideoCenter {
    my ($method, $response, $file) = @_;

    $file =~ s/\.vcfg$//;
    my $safeFile = &xmlEscape($file);
    my $uriFile  = &escape($file);
    my $content  = <<EOM;
<?xml version="1.0" encoding="UTF-8" ?>
<ServiceProvider>
  <Service Type="VC" Protocol="RSS2.0" ProviderID="$URL/rss/$safeFile">
    <ServiceDetails>
      <Title>$safeFile media</Title>
      <Description>On-demand media from mediaserv</Description>
    </ServiceDetails>
    <ServiceURI>$URL/rss/$uriFile</ServiceURI>
  </Service>
</ServiceProvider>
EOM

    $response->header('Content-Type'=>'application/vnd.nokia.iptv.config+xml');
    $response->content( $content );
}


# =======================================================================
# doImage - serve a thumbnail for a given object
#
sub doImage {
    my ($method, $response, $file) = @_;

    $file =~ s/\.(png|jpg)$//;
    
    if (!-f "$DATA_DIR/data/$file.png" and !-f "$DATA_DIR/data/$file.jpg" ) {
      createThumbnail($file);
    }
    
    if (-f "$DATA_DIR/data/$file.png") {
      doStatic($method, $response, "data/$file.png");
    } elsif (-f "$DATA_DIR/data/$file.jpg") {
      doStatic($method, $response, "data/$file.jpg");
    } else {
      doStatic($method, $response, "video.png");
    }
}

# =======================================================================
# createThumbnail - creates a thumbnail for a given object
#
sub createThumbnail {
    my ($file) = @_;

    &logMessage("Creating thumbnail for $file");
    my $target = "$DATA_DIR/data/$file";
    my $thumbPath;
    $thumbPath = $thumbnailFactory->lookup("file://$BASE_DIR/$file",
                                           (stat("$BASE_DIR/$file"))[9]) if $thumbnailFactory;
    &mkdirDeep($DATA_DIR, "data/$file");

    # -- Copy existing thumbnail, if found - otherwise create...
    #
    if ($thumbPath && -f $thumbPath) {
      #TODO should really be served directly from system folder
      &logMessage("Copying Gnome thumbnail from $thumbPath");
      copy($thumbPath, "$target.png");
      
    } else {
      system("totem-video-thumbnailer", "-s", "100", "$BASE_DIR/$file", "$target.png") if $haveTotem;
      if (-f "$target.png") {
        &logMessage("totem-video-thumbnailer succeeded");
      } else {
        my $tmpdir = tempdir;
        system("mplayer", "-ao", "null", "-vo", "jpeg:outdir=$tmpdir",
               "-frames", 2,
               "-ss", int(rand(30) + 30),
               "-vf", "scale=100:66",
               "$BASE_DIR/$file");
               
        move("$tmpdir/00000001.jpg", "$target.jpg");
        unlink <$tmpdir/*.jpg>;
        rmdir($tmpdir);
      }
    }
}


# =======================================================================
# serveMedia - transcode (if necessary) and serve a file
#
sub serveMedia {
    my ($method, $response, $file) = @_;
    
    my $avi = "$DATA_DIR/data/$file.avi";
    if (!-f $avi) {
        &mkdirDeep($DATA_DIR, "data/$file");
        my $child = fork;
        if ($child == 0) {
          &logMessage("Launching 770-encode");
          exec($encoder, "-p", $preset, @ENC_OPTS,
               "$BASE_DIR/$file", $avi) if $method eq 'GET' and !-f $avi;
          exit;
        } else {
          &logMessage("Spawned transcoder $child to get $avi");
          $SIG{CHLD} = \&REAPER;
          &mkdirDeep($DATA_DIR, "pids/data/$file.avi/");
          system('ln', '-snf', "data/$file.avi/transcoder", "$DATA_DIR/pids/$child");
          system('ln', '-snf', $child, "$DATA_DIR/pids/data/$file.avi/transcoder");
          sleep $sleepTime;
        }
    }

    &doStatic($method, $response, "data/$file.avi"); 
}


# =======================================================================
# readmedia - return a list of objects describing the media in a directory
#
sub readmedia {
    my ($dir) = @_;
    my @results = ();

    opendir(DIR, "$BASE_DIR/$dir") or return ();
    $dir =~ s![^/]$!$&/!;
    foreach my $f (sort readdir(DIR)) {
        my $entry = getMediaInfo("$dir$f");
        next if !$entry or $f =~ /^\./;
        push @results, $entry;
    }
    closedir(DIR);
    return @results;
}


# =======================================================================
# getMediaInfo - get a whole load of info on the given file
#
sub getMediaInfo {
    my ($f) = @_;

    my $path = "$BASE_DIR/$f";
    my $type = -d $path        ? 'dir'   :
                &isMedia($path) ? 'media' : undef;
    return undef unless $type;
    
    my ($base, $ext) = $f =~ m!^(.*?/?[^/]+?)(\.\w+)?$!;
    my $dir = $1 if $base =~ s!^(.+?)/([^/]+)$!$2!;
    my %entry = ( file  => $f,
                target => ($type eq 'media' ? "$f.avi" : $f),
                type  => $type,
                title => $base,
                subtitle => '',
                description => '',
    );
    $entry{title} =~ s/(\w)[\._-](\w)/$1 $2/g unless $entry{title} =~ /\s/;
    
    # -- Try and enrich with metadata from MythTV, Freevo etc...
    #
    if ($type eq 'media' and $mythName and $path =~ /^\Q$mythDir\E/) {
        my $metadata = `perl "$mythName" --subtitle --description \Q$path\E 2>/dev/null`;
        &logMessage("Got metadata [$metadata] from $mythName");
        
        my $title    = $1 if $metadata =~ s/^\s*(.*?)\s*$//m;
        my $subtitle = $2 if $title =~ s/^(.*?\S):(\S.*?)$/$1/;
        $metadata =~ s/^[\s\r\n]+//;
        $metadata =~ s/[\s\r\n]+$//;
        $entry{title}       = $title if $title;
        $entry{subtitle}    = $subtitle if $subtitle;
        $entry{description} = $metadata if $metadata;
        
    } elsif ($type eq 'media' and (-f "$BASE_DIR/$dir/$base.fxd" or -f "$freevoVfs/$BASE_DIR/$dir/$base.fxd")) {
        my $file = "$BASE_DIR/$dir/$base.fxd";
        $file    = "$freevoVfs/$file" unless -f $file;
        
        &logMessage("Found FXD file at $file");
        if (open(IN, "<$file")) {
            my $fxd = '';
            while(<IN>) { $fxd .= $_; }
            close(IN);
            
            my ($title)    = $fxd =~ /<movie title="([^\"]+)">/;
            my ($subtitle) = $fxd =~ m!<tagline>([^<]+)</tagline>!s;
            my ($desc)     = $fxd =~ m!<plot>([^<]+)</plot>!s;
            $entry{title}        = &xmlUnescape($title) if $title;
            $entry{subtitle}     = &xmlUnescape($subtitle) if $subtitle;
            $entry{description}  = &xmlUnescape($desc) if $desc;
        }
    }

    return \%entry;
}


# =======================================================================
# isMedia - return true if the given file has a media extension
#
sub isMedia {
    my ($file) = @_;

    my $regexp = "(".join("|", @MEDIA_EXT).")";
    return -f $file && ($file =~ /\.$regexp$/i);
}


# =======================================================================
# tidyUpChild - decrease usage count & remove file after 30s if !$keepResults
#
sub tidyUpChild {
    my ($pid, $rc) = @_;
    
    &logMessage("Handling termination of $pid with rc = $rc");
    my ($file) = (readlink("$DATA_DIR/pids/$pid") || '') =~ /(.*)\// or return;
    &logMessage("$pid was handling $file");
    unlink "$DATA_DIR/pids/$pid";
    unlink "$DATA_DIR/pids/$file/$pid";
    
    # -- Wait 30 seconds to check usage...
    #
    return if $keepResults;
    sleep 30;
    opendir(DIR, "$DATA_DIR/pids/$file");
    my $count = grep { /^\w+$/ } readdir(DIR);
    &logMessage("$file has $count other users");
    closedir(DIR);
    
    my $transcoder = readlink("$DATA_DIR/pids/$file/transcoder") || 0;
    $count-- if $transcoder;
    return &logMessage("File in use. Not removing.") if $count;
    
    &logMessage("Usage count reached zero. Removing file. Transcoder =  $transcoder");
    if ($transcoder) {
        kill 9 => $transcoder;
        sleep 1;
        unlink "$DATA_DIR/pids/$transcoder";
        unlink "$DATA_DIR/pids/$file/transcoder";
    }
    unlink "$DATA_DIR/$file";
    rmdir "$DATA_DIR/pids/$file" or &logMessage("Couldn't delete pid directory: $!");
}


# =======================================================================
# tidyUpTranscoder - remove link & remove file if aborted
#
sub tidyUpTranscoder {
    my ($pid, $rc) = @_;
 
    my ($file) = readlink("$DATA_DIR/pids/$pid") =~ /(.*)\//;
    unlink "$DATA_DIR/pids/$pid";
    unlink "$DATA_DIR/pids/$file/transcoder";
    
    if ($rc != 0) {
      &logMessage("Deleting converted $file due to non-clean exit");
      unlink "$DATA_DIR/data/$file";
    }
}


# =======================================================================
# spawnChildren - initial process to spawn the right number of children
#
sub spawnChildren {
    for (1..$totalChildren) {
        &newChild();
    }
}


# =======================================================================
# keepTicking - a never ending loop for the parent process which just monitors
# dying children and generates new ones
#
sub keepTicking {
    while ( 1 ) {
        sleep;
        for (my $i = $children; $i < $totalChildren; $i++ ) {
            &newChild();
        }
    };
}


# =======================================================================
# newChild - a forked child process that actually does some work
#
sub newChild {
    my $pid;
    my $sigset = POSIX::SigSet->new(SIGINT);     # Delay any interruptions!
    sigprocmask(SIG_BLOCK, $sigset) or die "Can't block SIGINT for fork: $!";
    die "Cannot fork child: $!\n" unless defined ($pid = fork);
    if ($pid) {
        $children{$pid} = 1;                     # Report a child is using this pid
        $children++;                             # Increase the child count
        warn "forked new child, we now have $children children\n";
        return;                                  # Head back to wait around
    }
        
    my $i = 0;
    while ($i < $childLifetime) {              # Loop for $childLifetime requests
        my $c = $d->accept or last;              # Accept a request, or if timed out.. die early
        $c->autoflush(1);
        my $request = $c->get_request(1) or last;
        my ($url)   = $request->url =~ /^\/?(.*)/;
        my $host    = $c->peerhost;
        &logMessage($host . " " . $d->url . $url . " - ct[". ++$i ."]");
        next if $url eq 'favicon.ico';

        # -- Handle the request appropriately...
        #
        $serving = '';
        my $response = HTTP::Response->new(200);
        if ($url eq '') {
            $c->send_redirect( "$URL/browse/" );
        } else {
            my ($type, $path) = $url =~ /(\w+)\/(.*)?/;
            &{ $HANDLERS{$type} }($request->method, $response, unescape($path));
            $c->send_response($response);
            if ($serving =~ /\.avi$/) {
                &tidyUpChild($$, -1);
                &logMessage('Tidy finish', $$);
            }
        }
                
        logMessage ("disconnect:" . $host . " - ct[$i]");
        $c->close;
    }
    
    warn "child terminated after $i requests";
    exit;
}


# =======================================================================
# REAPER - a reaper of dead children/zombies with exit codes to spare
#
sub REAPER {                            
    my $stiff;
    while (($stiff = waitpid(-1, &WNOHANG)) > 0) {
        if ($children{$stiff}) {
            warn ("child $stiff terminated -- status $?");
            $children--;
            delete $children{$stiff};
            &logMessage('Died', $stiff);
            &tidyUpChild($stiff, $?);

        } elsif (readlink("$DATA_DIR/pids/$stiff") =~ /transcoder$/) {
            &logMessage('Transcoder died', $stiff);
            &tidyUpTranscoder($stiff, $?);
        }
    }
    $SIG{CHLD} = \&REAPER;
}        


# =======================================================================
# daemonize - daemonize the parent/control app
#
sub daemonize {
    my $pid = fork;                              # Fork off the main process
    defined ($pid) or die "Cannot start daemon: $!";
    print "Parent daemon running.\n" if $pid;    # If we have a PID, the parent daemonized okay
    exit if $pid;                                # Return control to the user

    # Now we're a daemonized parent process!

    POSIX::setsid();                             # Become a session leader

#    close (STDOUT);                              # Close file handles to detach from any terminals
#    close (STDIN);
#    close (STDERR);

    # Set up signals we want to catch. Let's log warnings, fatal errors, and catch hangups and dying children

    $SIG{__WARN__} = sub {
        &logMessage ("NOTE! " . join(" ", @_));
    };
    
    $SIG{__DIE__} = sub { 
        &logMessage ("FATAL! " . join(" ", @_));
        exit;
    };

    $SIG{HUP} = $SIG{INT} = $SIG{TERM} = sub {   # Any sort of death trigger results in instant death of all
        my $sig = shift;
        $SIG{$sig} = 'IGNORE';
        kill 'INT' => keys %children;
        die "killed by $sig\n";
        exit;
    };        
    
    $SIG{CHLD} = \&REAPER;
}


# =======================================================================
# logMessage - log all the given messages to our file
#
sub logMessage {
    my $message = join(' ', @_);
    chomp $message;

    my ($sec, $min, $hour, $mday, $mon, $year) = gmtime;
    $mon++; $year += 1900;

    my $time = sprintf("%d/%0.2d/%0.2d %0.2d:%0.2d:%0.2d", $year, $mon, $mday, $hour, $min, $sec);

    open (FH, ">>", $logFile);
    print FH $time . " $$ - " . $message . "\n";
    close (FH);
}

# =======================================================================
# unescape - decode a URI-encoded string
#
sub unescape {
    my($todecode) = @_;
    $todecode =~ tr/+/ /;    # pluses become spaces
    $todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
    $todecode =~ s![/\\]\.+[/\\]!!g;
    return $todecode;
} 


# =======================================================================
# escape - encode a string for URIs
#
sub escape {
    my ($toencode) = @_;
    $toencode =~ s/([^A-Za-z.\/])/'%'.unpack("H*", $1)/eg;
    return $toencode;
}


# =======================================================================
# xmlEscape - replace XML entities in a given string
# 
sub xmlEscape {
    my ($string) = @_;

    $string =~ s/&/&amp;/g;
    $string =~ s/</&lt;/g;
    $string =~ s/>/&gt;/g;
    $string =~ s/"/&quot;/g;
    $string =~ s/'/&apos;/g;

    return $string;
}


# =======================================================================
# xmlUnescape - decode XML entities
#
sub xmlUnescape {
    my ($string) = @_;
    
    $string =~ s/&apos;/'/g;
    $string =~ s/&quot;/"/g;
    $string =~ s/&gt;/>/g;
    $string =~ s/&lt;/</g;
    $string =~ s/&#(\d+);/chr($1)/eg;
    $string =~ s/&#x([A-Fa-f\d]+);/pack("c",hex($1))/eg;
    $string =~ s/&amp;/&/g;
    return $string;
}


# =======================================================================
# read_file - read a file in blocks, in response to an HTTP request
#
sub read_file {
    my $data   = '';
    my ($file) = $serving =~ /^\Q$DATA_DIR\E\/(.*)/;
    $file    ||= '';

    my $n = 0;
    while (1) {
        $n = sysread(IN, $data, 10240);
        last if $n > 0 or (! -l "$DATA_DIR/pids/$file/transcoder");
        &logMessage("Waiting for data from $file...");
        sleep 1;
    }
    &logMessage("Read $n bytes from $file");
    close(IN) unless $n > 0;
    return $data;
}


# =======================================================================
# mkdirDeep - make a directory and all its parents
#
sub mkdirDeep {
    my ($root, $file) = @_;
      
    my $dir = '';
    while ($file =~ m!^\Q$dir\E([^/]+?)/!) {
        $dir = "$dir$1/";
        mkdir "$root/$dir";
    }
}

