package Net::MythTV::Fuse::Recordings;

=head1 NAME

Net::MythTV::Fuse::Recordings - Manage list of MythTV recordings for MythTV Fuse filesystem

=head1 SYNOPSIS

 $recordings = Net::MythTV::Fuse::Recordings->new({backend   => 'mythbackend.domain.org',
                                                   pattern   => '%C/%T/%S',
                                                   cachetime => 120,
                                                   maxgets   => 6,
                                                   threaded  => 1,
                                                   debug     => 1}
                                                 );
 $recordings->start_update_thread();
 @paths = $recordings->entries('.');
 $recordings->valid_path('Firefly/Serenity.mpg') or die;
 $recordings->is_dir('Firefly')                  or die;
 ($status,$content) = $recordings->download_recorded_file('Firefly/Serenity.mpg',1024,0);

=head1 DESCRIPTION

This is a utility class used by Net::MythTV::Fuse which handles all
interaction with the backend. Using the MythTV 0.25 API, the module
maintains a cache of current recordings, translates them into a series
of virtual directory listings according to a template, and can
download segments of individual recordings from a local or remote
backend.

=head1 METHODS

=cut

use strict;
use POSIX 'strftime';
use LWP::UserAgent;
use JSON qw(encode_json decode_json);
use Date::Parse 'str2time';
use XML::Simple;
use threads;
use threads::shared;
use Thread::Semaphore;
use Config;
use File::Basename ();
use Carp 'croak';

use constant CACHETIME => 60*5;  # 5 minutes
use constant MAXGETS   => 8;     # allow 8 simultaneous http gets 

# This single shared variable caches the recorded list from the backend as a JSONized string.
# Within each thread, the list is then unserialized and temporarily cached in each thread's memory.
my %Cache    :shared;

use constant Templates => {
    T  => '{Title}',
    S  => '{SubTitle}',
    R  => '{Description}',
    C  => '{Category}',
    ST => '{SubTitle}?{SubTitle}:{Title}',   # prefer %S?%S:%T
    TC => '{SubTitle}?{Title}:{Category}',   # prefer %S?%T:%C
    se =>  'sprintf("%02d",$recording->{Season})',
    e   => 'sprintf("%02d",$recording->{Episode})',
    see => '$recording->{Season} && $recording->{Episode} ? sprintf("s%02de%02d",$recording->{Season},$recording->{Episode}):""',
    PI => '{ProgramId}',
    SI => '{SeriesId}',
    st => '{Stars}',
    U  => '{Recording}{RecGroup}',
    hn => '{HostName}',
    c  => '{Channel}{ChanId}',
    cc => '{Channel}{CallSign}',
    cN => '{Channel}{ChannelName}',
    cn => '{Channel}{ChanNum}',

    y  => '%y{StartTime}',
    Y  => '%Y{StartTime}',
    n  => '%m{StartTime}',  # we don't do the non-leading 0 bit
    m  => '%m{StartTime}',
    j  => '%e{StartTime}',
    d  => '%d{StartTime}',
    g  => '%I{StartTime}',
    G  => '%H{StartTime}',
    h  => '%I{StartTime}',
    H  => '%H{StartTime}',
    i  => '%M{StartTime}',
    s  => '%S{StartTime}',
    a  => '%P{StartTime}',
    A  => '%p{StartTime}',
    b  => '%b{StartTime}',
    B  => '%B{StartTime}',

    ey  => '%y{EndTime}',
    eY  => '%Y{EndTime}',
    en  => '%m{EndTime}',
    em  => '%m{EndTime}',
    ej  => '%e{EndTime}',
    ed  => '%d{EndTime}',
    eg  => '%I{EndTime}',
    eG  => '%H{EndTime}',
    eh  => '%I{EndTime}',
    eH  => '%H{EndTime}',
    ei  => '%M{EndTime}',
    es  => '%S{EndTime}',
    ea  => '%P{EndTime}',
    eA  => '%p{EndTime}',
    eb  => '%b{EndTime}',
    eB  => '%B{EndTime}',

    # the API doesn't distinguish between program start time and recording start time
    py  => '%y{StartTime}',
    pY  => '%Y{StartTime}',
    pn  => '%m{StartTime}',
    pm  => '%m{StartTime}',
    pj  => '%e{StartTime}',
    pd  => '%d{StartTime}',
    pg  => '%I{StartTime}',
    pG  => '%H{StartTime}',
    ph  => '%I{StartTime}',
    pH  => '%H{StartTime}',
    pi  => '%M{StartTime}',
    ps  => '%S{StartTime}',
    pa  => '%P{StartTime}',
    pA  => '%p{StartTime}',
    pb  => '%b{StartTime}',
    pB  => '%B{StartTime}',

    pey  => '%y{EndTime}',
    peY  => '%Y{EndTime}',
    pen  => '%m{EndTime}',
    pem  => '%m{EndTime}',
    pej  => '%e{EndTime}',
    ped  => '%d{EndTime}',
    peg  => '%I{EndTime}',
    peG  => '%H{EndTime}',
    peh  => '%I{EndTime}',
    peH  => '%H{EndTime}',
    pei  => '%M{EndTime}',
    pes  => '%S{EndTime}',
    pea  => '%P{EndTime}',
    peA  => '%p{EndTime}',
    peb  => '%b{EndTime}',
    peB  => '%B{EndTime}',

    oy   => '%y{Airdate}',
    oY   => '%Y{Airdate}',
    on   => '%m{Airdate}', # we don't do the non-leading 0 bit
    om   => '%m{Airdate}',
    oj   => '%e{Airdate}',
    od   => '%d{Airdate}',
    ob   => '%b{Airdate}',
    oB   => '%B{Airdate}',

    '%'  => '%',

    # special format for Plex server
    PLX => <<'END',
    do {
       my $r = '';
       my $ct = $recording->{CatType};
       if ($ct eq 'series' || $ct eq 'tvshow' || $recording->{Season}) {
          $r .= 'TV Shows/';
          $r .= "$recording->{Title}/";
          if ($recording->{Season}) {
             $r .= "Season $recording->{Season}/";
             $r .= sprintf("%s - s%02de%02d - %s",$recording->{Title},$recording->{Season},$recording->{Episode},$recording->{Airdate});
             $r .= " - $recording->{SubTitle}" if defined $recording->{SubTitle};
          } else {
             my ($heuristic_season) = $recording->{SubTitle} =~ /(?:Season|Series)\s+(\d+)/;
             ($heuristic_season)    = $recording->{Airdate} =~ /^(\d+)/ unless $heuristic_season; # year instead of season
             $heuristic_season    ||= '00';
             $r .= "Season $heuristic_season/$recording->{Title} - $recording->{Airdate}";
             $r .= " - $recording->{SubTitle}" if $recording->{SubTitle};
          }
       } else {
          $r .= 'Movies/';
          my ($yr) = $recording->{Airdate} =~ /^(\d+)/;
          $r .= "$recording->{Title}";
          $r .= " ($yr)" if $yr;
          $r .= "/";
          $r .= "$recording->{Title}";
          $r .= ", $recording->{SubTitle}" if $recording->{SubTitle};
          $r .= " ($yr)" if $yr;
       }
       return $r;
    } 
END

    };

use constant REC_CODES => {
    -13  => "Other recording",
    -12  => "Other tuning",
    -11  => "Backend not running",
    -10  => "The showing is being tuned",
    -9   => "The recorder failed to record",
    -8   => "The tuner card was busy",
    -7   => "Low disk space",
    -6   => "Manual cancel",
    -5   => "Missed recording",
    -4   => "Aborted",
    -3   => "Recorded",
    -2   => "Now recording",
    -1   => "Will record",
    0    => "Unknown status code",
    1    => "Don't record",
    2    => "Previously recorded",
    3    => 'Currently recorded',
    4    => "Earlier showing",
    5    => "Max recordings",
    6    => "Not listed",
    7    => 'Conflict',
    8    => 'Later showing',
    9    => 'Repeat',
    10   => 'Rule inactive',
    11   => 'Never record',
    12   => 'Recorder off-line',
    13   => 'Other showing',
};

my $Package = __PACKAGE__;
foreach (qw(debug backend port dummy_data cache cachetime maxgets threaded
            pattern delimiter mtime localmount semaphore)) {
    eval <<END;
sub ${Package}::${_} {
    my \$self = shift;
    \$self->{$_} = shift if \@_;
    return \$self->{$_};
}
END
}

=head2 $r = Net::MythTV::Fuse::Recordings->new(\%options)

Create a new Recordings object. Options are passed as a hashref and
may contain any of the following keys:

 backend       IP address of the backend (localhost)
 port          Control port for the backend (6544)
 pattern       Template for transforming recordings into paths (%T/%S)
 delimiter     Trim this string from the pathname if it is dangling or occurs multiple times (none)
 cachetime     Maximum time to cache recorded list before refreshing from backend (300 sec)
 maxgets       Maximum number of simultaneous file fetches to perform on backend (8)
 threaded      Run the cache fill process as an ithread (true)
 debug         Turn on debugging messages (false)
 dummy_data_path  For debugging, pass path to backend recording XML listing

See the help text for mythfs.pl for more information on these arguments.

=cut

sub new {
    my $class   = shift;
    my $options = shift;
    $options->{backend} or croak "Usage: $class->new({backend=>\$backend_hostname,\@other_options})";
    
    my $self =  bless {
	backend   => 'localhost',
	port      => 6544,
	pattern   => '%T/%S',
	cachetime => CACHETIME,
	maxgets   => MAXGETS,
	threaded  => $Config{useithreads},
	delimiter => undef,
	debug     => 0,
	%$options,           # these will override
	mtime     => 0,
	cache     => undef,
    },ref $class || $class;

    $self->semaphore(Thread::Semaphore->new($self->maxgets)),
    return $self;
}

=head2 Accessors

These methods get or set the correspondingly-named values:

 debug()
 backend()
 port()
 maxgets()
 threaded()
 pattern()
 delimiter()
 mtime()
 localmount()

These methods are used internally:

 dummy_data()
 cache()
 cachetime()
 semaphore()

=cut

=head2 $r->start_update_thread

Start the thread that periodically fetches and caches the recording
data from the server. Will run as a detached thread until the process
terminates.

=cut

sub start_update_thread {
    my $self = shift;

    $self->_refresh_recorded 
	or croak "Could not contact backend at ",$self->backend,':',$self->port;
    return unless $self->threaded;

    # this updates the recordings
    my $thr = threads->create(
	sub {
	    while (1) {
		sleep ($self->cachetime);
		$self->_refresh_recorded;
	    }
	}
	);

    $thr->detach();

    # this updates upcoming recordings at a less frequent interval
    $thr = threads->create(
	sub {
	    while (1) {
		$self->_refresh_upcoming;
		sleep(60*60); # 1 hour, hard coded
	    }
	});
    $thr->detach();
}

=head2 $recordings = $r->get_recorded

Return a data structure corresponding to the current recording
list. The data structure is a hashref with two top-level keys:
"directories", which list directory names and their contents, and
"paths" which give size and other attributes for each directory,
subdirectory and file. Here is an example:

 {
  'directories' => {
       '.' => {
               '007 Licence To Kill.mpg' => 1,
               'A Funny Thing Happened on the Way to the Forum.mpg' => 1,
               'Alfred Hitchcock Presents' => 5,
               'American Dad' => 9,
                ...
               },
       'Alfred Hitchcock Presents' => {
               'Back for Christmas.mpg' => 1,
               'Dead Weight.mpg' => 1,
               'Rose Garden.mpg' => 1,
              },
       'American Dad' => {
               'Dr. Klaustus.mpg' => 1,
               'Flirting With Disaster.mpg' => 1,
               'Gorillas in the Mist.mpg' => 1,
              },
         ...
     },
  'paths' => {
       '.' => {
               'ctime' => 1368074100,
               'length' => 240,
               'mtime' => 1368076875,
               'type' => 'directory'
              },
       '007 Licence To Kill.mpg' => {
               'basename' => '1111_20121126200000.mpg',
               'ctime' => 1353978000,
               'host' => 'myth',
               'length' => '21262807708',
               'mtime' => 1357927839,
               'storage' => 'Default',
               'type' => 'file'
              },
       'A Funny Thing Happened on the Way to the Forum.mpg' => {
               'basename' => '1191_20121230000000.mpg',
               'ctime' => 1356843600,
               'host' => 'myth',
               'length' => '12298756208',
               'mtime' => 1357927839,
               'storage' => 'Default',
               'type' => 'file'
              },
         'Alfred Hitchcock Presents' => {
               'ctime' => 1362985200,
               'length' => 5,
               'mtime' => 1362987680,
               'type' => 'directory'
              },
          'Alfred Hitchcock Presents/Back for Christmas.mpg' => {
               'basename' => '1022_20121225153000.mpg',
               'ctime' => 1356467400,
               'host' => 'myth',
               'length' => '647625408',
               'mtime' => 1357927839,
               'storage' => 'Default',
               'type' => 'file'
              },
          'Alfred Hitchcock Presents/Dead Weight.mpg' => {
                 'basename' => '1022_20121207000000.mpg',
                 'ctime' => 1354856400,
                 'host' => 'myth',
                 'length' => '647090360',
                 'mtime' => 1357927839,
                 'storage' => 'Default',
                 'type' => 'file'
               },
             ...
     }

=cut

sub get_recorded {
    my $self = shift;
    my $nocache = shift;
    
    my $cache = $self->cache;

    return $cache if $cache && $nocache;

    $self->_refresh_recorded if !$self->threaded && (time() - $Cache{mtime} >= $self->cachetime);

    lock %Cache;
    return $cache            if $cache && $self->mtime >= $Cache{mtime};

    warn scalar localtime()," refreshing thread-level cache, mtime = $Cache{mtime}\n" if $self->debug;
    $self->mtime($Cache{mtime});
    return $self->cache(decode_json($Cache{recorded}||''));
}

=head2 $path = $r->recording_to_path($metadata)

Given the metadata returned from the backend for a single recording,
transform this into a pathname using the provided template.

=cut

sub recording2path {
    my $self = shift;
    my $recording = shift;
    my $path     = $self->apply_pattern($recording);
    my @components = split '/',$path;

    # trimming operation
    if (my $delimiter = $self->delimiter) {
	foreach (@components) {
	    s/${delimiter}{2,}/$delimiter/g;
	    s/${delimiter}(\s+)/$1/g;
	    s/$delimiter$//;
	}
    }

    return grep {length} @components;
}



=head2 $message = $r->status

Returns the last status message.

=cut

sub status {
    my $self  = shift;
    my $r     = $self->get_recorded;
    my $mtime = localtime($self->mtime);
    return "$mtime: $r->{status}\n";
}

=head2 $time = $r->mtime

Return the time that the status was last updated.

=cut

=head2 @entries = $r->entries($path)

Given a path to a directory in the virtual filesystem, return all
subentries within that directory. Use '.' to indicate the top level
directory.

=cut

sub entries {
    my $self = shift;
    my $path = shift;
    my $r = $self->get_recorded;
    return keys %{$r->{directories}{$path}};
}

=head2 $name = $r->basename($path)

Given a path to a file in the virtual filesystem, returns the basename
of the physical file on the backend's storage disk.

=cut

sub basename {
    my $self = shift;
    my $path = shift;
    my $e = $self->entry($path) or return;
    return $e->{basename};
}

=head2 $entry = $r->entry($path)

Given a path to a file on the virtual filesystem, returns a hashref
that provides length, modification time and basename information about
the recording. This is simply the value of the {path}{$path} key in
the data structure described for get_recorded():

        {'Alfred Hitchcock Presents/Back for Christmas.mpg' => {
               'basename' => '1022_20121225153000.mpg',
               'ctime' => 1356467400,
               'host' => 'myth',
               'length' => '647625408',
               'mtime' => 1357927839,
               'storage' => 'Default',
               'type' => 'file'
              }
        }

=cut

sub entry {
    my $self = shift;
    my $path = shift;
    my $r = $self->get_recorded;
    return $r->{paths}{$path};
}

=head2 $boolean = $r->valid_path($path)

Returns true if the provided path is valid.

=cut

sub valid_path {
    my $self = shift;
    my $path = shift;
    my $r = $self->get_recorded;
    return $r->{paths}{$path};
}


=head2 $boolean = $r->is_dir($path)

Returns true if the provided path is a directory in the virtual filesystem.

=cut

sub is_dir {
    my $self = shift;
    my $path = shift;
    my $r    = $self->get_recorded;
    return $r->{paths}{$path}{type} eq 'directory';
}

=head2 ($status,$content) = $r->download_recorded_file($path,$size,$offset)

Attempts to download the recording corresponding to the indicated
path. $size and $offset allow you to fetch the indicated portion of
the recording.

A two-element list is returned. The first element is a status message,
one of "ok", "not found", "invalid offset", or "connection failed". If
successful, the second element will be the requested content,
otherwise undef.

=cut

sub download_recorded_file {
    my $self = shift;
    my ($path,$size,$offset) = @_;

    my $r    = $self->get_recorded('use_cached');
    my $e    = $r->{paths}{$path} or return 'not found';
    $offset <= $e->{length}       or return 'invalid offset';

    my $basename = $e->{basename};
    # I'm unsure of whether we should use the host in the XML or the designated backend
    my $host     = $e->{host} || $self->backend;  
    my $port     = $self->port;
    my $sg       = $e->{storage};
    my $byterange= $offset.'-'.($offset+$size-1);

    $self->{ua} ||= LWP::UserAgent->new(keep_alive=>undef);
    $self->semaphore->down();
    my $response = $self->{ua}->get("http://$host:$port/Content/GetFile?StorageGroup=$sg&FileName=$basename",
				    'Range'       => $byterange);
    $self->semaphore->up();
    $response->is_success or return 'connection failed';
    return ('ok',$response->decoded_content);
}

=head2 $status = $r->delete_recording($path)

Call on a path to delete the indicated recording. Returns "ok" if
successful. Otherwise may return "not found" for an invalid path, or
"delete failed: " plus some explanatory text describing an error on
the backend.

=cut

sub delete_recording {
    my $self = shift;
    my $path = shift;

    # deal with Cache directly, otherwise we get race conditions
    lock %Cache;
    my $r    = decode_json($Cache{recorded});
    my $e    = $r->{paths}{$path} or return 'not found';

    my $host     = $e->{host} || $self->backend;  
    my $port     = $self->port;
    my $chanid   = $e->{chanid};
    my $starttime= $e->{starttime};
    $starttime   =~ s/Z$//;

    my $url      = "http://$host:$port/Dvr/RemoveRecorded?ChanId=$chanid&StartTime=$starttime";
    my $ua       = $self->{ua} ||= LWP::UserAgent->new(keep_alive=>undef);
    warn "DELETE: POST $url";

    my $response = $ua->post("http://$host:$port/Dvr/RemoveRecorded?ChanId=$chanid&StartTime=$starttime");
    $response->is_success or return "delete failed: ".$response->status_line;
    my $success = $response->decoded_content =~ m!<bool>true</bool>!;

    warn "DELETE: ",$response->decoded_content;

    if ($success) {
	my $file = File::Basename::basename($path);
	my $dir  = File::Basename::dirname($path);
	delete $r->{paths}{$path};
	delete $r->{directories}{$dir}{$file};
	$Cache{recorded} = encode_json($r);
	$Cache{mtime}    = $self->mtime+1;  # force a cache invalidation
	return 'ok';
    } else {
	return 'delete failed: '.$response->decoded_content;
    }

}

=head2 $status = $r->delete_directory($path)

Call on a path to delete the indicated directory. The directory must
be empty. The returned status string will be "ok", or one of "not
found", "not a directory" or "directory not empty".

=cut

sub delete_directory {
    my $self = shift;
    my $path = shift;

    warn "delete_directory($path)";

    # deal with Cache directly, otherwise we get race conditions
    lock %Cache;
    my $r    = decode_json($Cache{recorded});
    my $e    = $r->{paths}{$path}    || return 'not found';
    $e->{type} eq 'directory'        || return 'not a directory';
    keys %{$r->{directories}{$path}} && return 'directory not empty';

    my $parent = File::Basename::dirname($path) || '.';
    my $base   = File::Basename::basename($path);
    delete $r->{directories}{$path};
    delete $r->{directories}{$parent}{$base};
    delete $r->{paths}{$path};
    $Cache{recorded} = encode_json($r);
    $Cache{mtime}    = $self->mtime+1;  # force a cache invalidation
    return 'ok';
}

=head2 $path = $r->apply_pattern($entry)

=cut

sub apply_pattern {
    my $self = shift;
    my $recording = shift;
    no warnings;

    my $pat_sub   = $self->_compile_pattern_sub();
    my $template  = $self->{pattern};

    my $Templates = Templates();
    my @codes     = sort {length($b)<=>length($a)} keys %$Templates;
    my $match     = join('|',@codes);

    $template =~ s/%($match)/$pat_sub->($recording,$1)/eg;
    return $template;
}

sub _refresh_upcoming {
    my $self = shift;
    my $host     = $self->backend;  
    my $port     = $self->port;
    my $ua = $self->{ua} ||= LWP::UserAgent->new(keep_alive=>undef);
    my $response = $ua->get("http://$host:$port/Dvr/GetUpcomingList?ShowAll=true");
    $response->is_success or return;

    lock %Cache;
    my $upcoming = XML::Simple->new(SuppressEmpty=>1)->XMLin($response->decoded_content);
    $Cache{Upcoming} = encode_json($upcoming);
}

=head2 $upcoming = $r->get_upcoming_list

Get a list of upcoming recordings. This is an array reference of hashes parsed from the XML 
shown at http://www.mythtv.org/wiki/DVR_Service#GetUpcomingList.

=cut

sub get_upcoming_list {
    my $self = shift;
    lock %Cache;
    $Cache{Upcoming} or return "No upcoming list. Threads must be enabled to activate this feature.\n";
    my $response = '';
    eval {
	my $upcoming = decode_json($Cache{Upcoming});
	my $programs = $upcoming->{Programs}{Program};
	for my $p (@$programs) {

	    my ($start,$end) = map {strftime('%H:%M',localtime(str2time($_)))} @{$p}{'StartTime','EndTime'};
	    my $date         = strftime('%a %e-%b',localtime(str2time($p->{StartTime})));
	    my $code         = REC_CODES->{$p->{Recording}{Status}};
	    $code           .= " (Tuner $p->{Recording}{EncoderId})" if $p->{Recording}{Status} == -1;
	    my $title        = join (' - ',$p->{Title},$p->{SubTitle});
	    $title           =~ s/ - $//;
	    
	    $response .= sprintf("%-50.50s %4s %7s %10s %5s-%5s %12s\n",
				 $title,
				 $p->{Channel}{ChanNum},
				 $p->{Channel}{ChannelName},
				 $date,
				 $start,
				 $end,
				 $code);
	}
    };
    return $@ if $@;
    return $response;
}

sub _compile_pattern_sub {
    my $self = shift;
    return $self->{pattern_sub} if $self->{pattern_sub};

    my $template = $self->{pattern};
    my $Templates= Templates();

    my $sub = "sub {\n";
    $sub   .= "my (\$recording,\$code) = \@_;\n";
    $sub   .= "my \$val='';\n";
    $sub   .= "BLOCK: {\n";

    for my $code (sort {length($b)<=>length($a)} keys %$Templates) {
	next unless $template =~ /%$code/;
	my $field = $Templates->{$code};

	$sub .= "if (\$code eq '$code') {\n";

	if ($field eq '%') {
	    $sub .= "\$val = '%';\n";
	}
	
	elsif ($field =~ /(%\w+)(\{\w+\})/) { #datetime specifier
	    $sub .= "\$val = strftime('$1',localtime(str2time(\$recording->$2)||0));\n";
	}
	
	elsif ($field =~ /(.+)\?(.+)\:(.+)/) {  # something like '{SubTitle}?{SubTitle}:{Title}'
	    $sub .= "\$val = \$recording->$1?\$recording->$2:\$recording->$3;\n";
	}

	elsif ($field =~ /^{/) {
	    $sub .= "\$val = \$recording->$field || '';\n";
	}

	else {  # something else - has to be a perl expression
	    $sub .= "\$val = $field;\n";
	}
	
	$sub .= "last BLOCK;\n";
	$sub .= "}\n";
    }

    $sub .= <<END;
    }
    \$val ||= '';
    \$val =~ tr!/!_!;
    return \$val;
END

    $sub .= "}\n";

    my $s = eval $sub;
    die $@ if $@;
    return $self->{pattern_sub} = $s;
}

sub load_dummy_data {
    my $self = shift;
    my $dummy_data_path = shift;
    open my $fh,$dummy_data_path or croak "$dummy_data_path: $!";
    local $/;
    my $dummy_data = <$fh>;
    $self->dummy_data($dummy_data) if $dummy_data;
}

sub _refresh_recorded {
    my $self = shift;

    print  STDERR scalar(localtime())," Refreshing recording list..." if $self->debug;

    lock %Cache;
    my $var    = {};
    my $parser = XML::Simple->new(SuppressEmpty=>1);
    my ($status,$data) = $self->_fetch_recorded_data();
    $var->{status} = $status;
    if ($status eq 'ok') {
	my $rec = $parser->XMLin($data);
	$self->_build_directory_map($rec,$var);
    } else {
	print STDERR "ERROR: $status..." if $self->debug;
	$var->{paths}{'.'} = {ctime  => time(),
			      mtime  => time(),
			      length => 2,
			      type   => 'directory'};
    }
    $Cache{recorded} = encode_json($var);
    $Cache{mtime}    = time();
    print STDERR "mtime set to $Cache{mtime}\n" if $self->debug;

    return 1;
}

sub _fetch_recorded_data {
    my $self = shift;

    return ('ok',$self->dummy_data) if $self->dummy_data;

    my $host = $self->backend;
    my $port = $self->port;

    $self->{ua} ||= LWP::UserAgent->new(keep_alive=>undef);
    my $response = $self->{ua}->get("http://$host:$port/Dvr/GetRecordedList");

    my $status;
    if ($response->is_success) {
	$status = 'ok';
    } else {
	$status = "Recording list request failed with ".$response->status_line;
    }

    return ($status,$response->decoded_content);
}

sub _build_directory_map {
    my $self = shift;
    my ($rec,$map) = @_;

    my $count = 0;
    my (%recordings,%paths);
    for my $r (@{$rec->{Programs}{Program}}) {
	$count++;

	my $sg = $r->{Recording}{StorageGroup};
	next if $sg eq 'LiveTV';

 	my (@path)              = $self->recording2path($r);
	my $key                 = join('-',$r->{HostName},$r->{FileName});  # we use this as our unique ID
	my $path                = join('/',@path);
	$recordings{$key}{path}{$path}++;
	$recordings{$key}{meta} = $r;
	$paths{$path}{$key}++;
    }
    
    # paths that need fixing to be unique
    for my $path (keys %paths) {
	my @keys = keys %{$paths{$path}};
	next unless @keys > 1;

	my $count = 0;
	for my $key (@keys) {
            my $start = $recordings{$key}{meta}{StartTime};
	    $start =~ s/:\d+Z$//;
            
	    my $fixed_path = sprintf("%s_%s-%s",$path,$recordings{$key}{meta}{Channel}{ChanNum},$start);
	    delete $recordings{$key}{path};
	    $recordings{$key}{path}{$fixed_path}++;
	}
    }

    # at this point, we actually build the map that is passed to FUSE
    for my $key (keys %recordings) {

	my ($path) = keys %{$recordings{$key}{path}}; # should only be one unique path at this point

	# take care of the extension
	my $meta     = $recordings{$key}{meta};
	my ($suffix) = $meta->{FileName}    =~ /\.(\w+)$/;
	$path       .= ".$suffix" unless $path =~ /\.$suffix$/;

	my @path = split('/',$path);
	my $filename = pop @path;
	unshift @path,'.';

	my $ctime = str2time($meta->{StartTime});
	my $mtime = str2time($meta->{LastModified});
	
	$map->{paths}{$path}{type}     = 'file';
	$map->{paths}{$path}{host}     = $meta->{HostName};
	$map->{paths}{$path}{length}   = $meta->{FileSize};
	$map->{paths}{$path}{basename} = $meta->{FileName};
	$map->{paths}{$path}{storage}  = $meta->{Recording}{StorageGroup};
	$map->{paths}{$path}{ctime}    = $ctime;
	$map->{paths}{$path}{mtime}    = $mtime;

	# for recording removal
	$map->{paths}{$path}{chanid}    = $meta->{Channel}{ChanId};
	$map->{paths}{$path}{starttime} = $meta->{StartTime};  # slightly redundant information
	
	# take care of the directories
	my $dir = '';
	while (my $p = shift @path) {
	    $dir .= length $dir ? "/$p" : $p;
	    $dir =~ s!^\./!!;

	    $map->{paths}{$dir}{type}     = 'directory';
	    $map->{paths}{$dir}{length}++;
	    $map->{paths}{$dir}{ctime}    = $ctime if ($map->{paths}{$p}{ctime}||0) < $ctime;
	    $map->{paths}{$dir}{mtime}    = $mtime if ($map->{paths}{$p}{mtime}||0) < $mtime;

	    # subdirectory entry
	    if (defined $path[0]) {
		$map->{directories}{$dir}{$path[0]}++;
	    }
	}
	$map->{directories}{$dir}{$filename}++;
    }

    print STDERR scalar keys %recordings," recordings retrieved..." if $self->debug;
    return $map;
}

1;

=head1 AUTHOR

Copyright 2013, Lincoln D. Stein <lincoln.stein@gmail.com>

=head1 LICENSE

This package is distributed under the terms of the Perl Artistic
License 2.0. See http://www.perlfoundation.org/artistic_license_2_0.

=cut

__END__
