# TiVo.pm
# Version 1.1
# 3/17/2003
#
# Copyright (c) 2003 TiVo Inc. All Rights Reserved.
#
# This file contains Original Code and/or Modifications of Original Code
# as defined in and that are subject to the TiVo Public Source License
# Version 1.0 (the 'License'). You may not use this file except in
# compliance with the License. Please obtain a copy of the License at
# http://www.tivo.com/developer/tivo_license.asp and read it before
# using this file.
#
# THE ORIGINAL CODE AND ALL SOFTWARE DISTRIBUTED UNDER THE LICENSE ARE
# PROVIDED _AS IS_, WITH ALL FAULTS AND WITHOUT WARRANTY OF ANY KIND,
# EITHER EXPRESS OR IMPLIED.  TIVO HEREBY DISCLAIMS ALL SUCH WARRANTIES
# INCLUDING, BUT NOT LIMITED TO,  WARRANTIES AND/OR CONDITIONS OF FITNESS
# FOR A PARTICULAR PURPOSE, MERCHANTABILITY, AND NON-INFRINGEMENT OF THIRD
# PARTY RIGHTS, EXCLUSIVELY OR RESULTS OBTAINED FROM USE OF THE MATERIAL.
# TIVO MAKES NO WARRANTY OF ANY KIND WITH RESPECT TO FREEDOM FROM PATENT,
# TRADEMARK, OR COPYRIGHT INFRINGEMENT.  Please see the License for
# specific language governing rights and limitations under the License.
#
############################################################################
##############################################################################
package TiVo;
use 5.006_001;

##
## NOTES
##
## Currently requires these additional modules for full functionality:
##
##  Storable
##  IO::File
##  MP3::Info
##  Image::Magick
##  Digest::MD5
##

# Constants for use in QueryServer message
use constant VERSION      => '1';
use constant INTVERSION   => '1.1.0';
use constant INTNAME      => 'TiVoServer BC';
use constant ORGANIZATION => 'TiVo, Inc.';
use constant COMMENT      => ''; 


##
## Generic, overridable interface to dynamic class data
##
##   Autoload will catch any method beginning with an underscore ( _ )
##   and convert the method name to a key value, which is used to
##   access the object's internal DATA hash. Methods written to
##   override interactions with a given key should use lvalue
##   syntax to maintain compatibility with other module internals.
##
sub AUTOLOAD : lvalue {
  my $self = shift;
  my $param = $AUTOLOAD; 

  $param =~ s/^.*:://;

  return unless $param =~ /^_(.+)$/;

  $self->{'DATA'}->{ uc($1) };

}



##
## TiVo->uri_unescape( $ )
##
##  Decodes URI strings per RFC 2396
##
sub uri_unescape {
  my $self = shift;
  my $str = shift;

  $str =~ s/\+/ /g;

  $str =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;

  return $str;
}



##
## TiVo->uri_escape( $ )
##
##  Encodes URI strings per RFC 2396
##

sub uri_escape {
  my $self = shift;
  my $str = shift || return undef;

  $str =~ s/([^A-Za-z0-9\+\-\/_.!~*'() ])/sprintf("%%%02X", ord($1))/eg;

  $str =~ s/ /+/g;

  return $str;

}



##   
## TiVo->servicename( $ )
##   
##  Returns the service name (first element of object path) of the object
##  or passed argument
##
sub servicename {
  my $self = shift;

  my $path = shift || $self->_Object || return undef;

  $path =~ /^(\/[^\/]*)/;

  return $1;

}


##   
## TiVo->basename( $ )
##   
##  Returns the basename (filename) of the object's internal Path
##  or passed argument
##
sub basename {
  my $self = shift;

  my $path = shift || $self->_Path || return undef;

  my @path_parts = split(/\//, $path);

  return pop @path_parts;

}



##
## TiVo->query_container
## 
##   Returns a data structure (suitable for use with xml_out) which
##   describes this object in response to a QueryContainer command
##
sub query_container {
  my $self = shift;
  my $params = shift;

  my $script_name = $params->_EnvScriptName || "";

  my $details = {
    'Item' => [
      {
        'Details' => {
          'Title'        => $self->_Title || $self->basename,
          'ContentType'  => $self->_ContentType,
          'SourceFormat' => $self->_SourceFormat   
        }
      },
      {
        'Links' => {
          'Content' => {
            'Url' => $script_name . $self->_Url
          }
        }
      }
    ]
  };

  return $details;

}



##############################################################################
# TiVo::Server
#   The core server object for processing requests
##############################################################################
package TiVo::Server;
@ISA = ('TiVo');

##
## TiVo::Server->new( % )
##
##  Constructor for TiVo::Server. Accepts parameters via arguement
##  hash.
##    SERVER_NAME
##    CACHE_DIR
##    IMAGE_DIR
##
sub new {
  my $class = shift;

  my $self = {};
  bless $self, $class;

  my %params = ( @_ );

  $self->_Name = $params{'SERVER_NAME'} || 'TiVo Server';
  $self->_CacheDir = $params{'CACHE_DIR'};
  $self->_ImageDir = $params{'IMAGE_DIR'} || $self->_CacheDir;

  $self->_Services = {};

  return $self;   

}



##
## TiVo::Server->load_cache( $ )
##
##  Loads the requested object from the external cache.
##
sub load_cache {
  my $self = shift;

  my $path = shift || return undef;

  my $cache_dir = $self->_CacheDir || return undef;

  require Storable;
  require Digest::MD5;

  my $cache_name = Digest::MD5::md5_hex($path);

  return eval { Storable::retrieve("$cache_dir/$cache_name") };

}



##
## TiVo::Server->store_cache( $ )
##
##  Stores the given object in the external cache.
##
sub store_cache {
  my $self = shift;

  my $object = shift || return undef;

  my $cache_dir = $self->_CacheDir || return undef;

  require Storable;
  require Digest::MD5;

  my $cache_name = Digest::MD5::md5_hex($object->_Object);

  return eval { Storable::store( $object, "$cache_dir/$cache_name" ); };

}



##
## TiVo::Server->freeze( $ )
##
##  Stores the given Object in memory and passes it to the server's current
##  external cache functions
##
sub freeze {
  my $self = shift;

  my $object = shift || return undef;

  return $self->store_cache($object);

}



##
## TiVo::Server->thaw( $ )
##
##  Returns the requested Object from Cache, creating it when necessary
##
sub thaw {
  my $self = shift;

  my $path = shift || return undef;
  my $item;

  $item = $self->load_cache($path);

  if( ! defined($item) || $item->expired ) {

    $item = $self->create_object($path);
    $self->freeze($item);

  }

  return $item;

}



##
## TiVo::Server->create_object( $ )
##
##  Creates a new Item or Container object using the full filesystem
##  path provided.
##
sub create_object {
  my $self = shift;

  my $path = shift || return undef;
  my $item;


  # Check for '/' special condition
  if ($path eq '/') {

    $item = TiVo::Container::Server->new(
      SERVICE => "/",
      TITLE   => $self->_Name
    ) || return undef;

    my @contents = map { $self->_Services->{ $_ } } keys %{ $self->_Services };
    $item->_Contents = \@contents;

  # Perform filesystem scan
  } else {

    my $service = $self->servicename($path);

    return undef unless defined $self->_Services->{$service};
    $service = $self->_Services->{$service};

    $path = $service->obj_to_path($path);

    return undef if grep { /^\.\.$/ } split(/\//, $path);

    # Create a directory container
    if( -d $path ) {   

      $item = TiVo::Container->new(
        PATH => $path,
        SERVICE => $service
      ) || return undef;


    # Create a file item
    } elsif( -r $path ) {

      my @parts = split(/\./, $path);
      my $suffix = uc( pop @parts);

      my $class = "TiVo::Item::$suffix";
      $item = eval{ $class->new( $path, $service ); } || return undef;

    }

  }

  return $item || undef;

}



##
## TiVo::Server->add_service( $ )
##
##  Adds a TiVo::Container object to the service list for this server.
##
sub add_service {
  my $self = shift;
  my $service = shift || return undef;

  $self->_Services->{ $service->_Object } = $service;
  $self->freeze($service);

  return $self->_Services->{ $service->_Object };

} 



##
## TiVo::Server->request( $ $ $ )
##
##  Processes a client request and returns the output from the appropriate
##  command method. The return value is a list: first element
##  is a scalar containing the mime-type of the returned data, second
##  element is a reference to the data itself. Both scalar refs and
##  IO::File refs may be returned, so the calling application must check
##  for and support both types.
##
sub request {
  my $self = shift;

  my $params = shift || return undef;

  # Use a passed TiVo::Request object if given or
  # create a TiVo::Request object from arguments if needed
  if( (ref $params) !~ /^TiVo::Request/ ) {

    # See TiVo::Request for the proper syntax of these arguments
    my $script_name = $params;
    my $path_info = shift;
    my $query_string = shift;

    $params = TiVo::Request->new($script_name, $path_info, $query_string);

  }

  # File transfer requested? (binary output)
  if( defined( $params->_EnvPathInfo ) && $params->_EnvPathInfo ) {

    my $path_info = $self->uri_unescape($params->_EnvPathInfo);

    my $item = $self->thaw($path_info) || return undef;

    my($headers, $ref) = $item->send($params, $self);

    return ($headers, $ref);

  # Command given? (xml output)
  } else {

    my $command = uc( $params->_Command ) || 'QUERYCONTAINER';

    # Create and eval the method name dynamically
    my $method = "command_$command";
    my $response = eval { $self->$method($params); };

    # Call command_UNKNOWN if the eval failed
    if( !defined $response ) {
      $response = $self->command_UNKNOWN($@);
    }

    # Set the default mime-type to be returned
    my $mime_type = 'text/xml';

    # Check to see if clint requested a different format
    if( defined( $params->_Format ) ) {
      $mime_type = $params->_Format;

      # If text/html was requested, simply display the xml as plaintext
      if( $mime_type eq 'text/html' ) {
        $mime_type = 'text/plain';
      }

    }

    my $xml = $self->xml_out($response) || return undef;

    # Wrap XML with header and footer
    my $return = "<?xml version='1.0' encoding='ISO-8859-1' ?>\n";
    $return .= $xml;
    $return .= "<!-- Copyright (c) 2002 TiVo Inc.-->\n";

    my $headers = {
      'Content-Type'	=> $mime_type,
      'Content-Length'	=> length $return
    };

    return ($headers, \$return );

  }

    my $response = $self->command_QUERYCONTAINER($params);



  return undef;

}



##
## TiVo::Server->xml_out( $ [$] )
##
##  Converts a referenced hash/array data structure to XML. Use array
##  references to pass keys when order of the resulting XML tags
##  is important. Keys passed in a hash reference will have no
##  predictable ordering.
##
sub xml_out {
  my $self = shift;

  my $data = shift || return undef;
  my $indent = shift || 0;

  my $return;

  my @keys;

  my $data_type = ref $data;

  # Process each key if the passed reference was a hash
  if( $data_type eq 'HASH' ) {

    foreach my $key ( keys %$data ) {

      # Force undef values to empty strings before printing
      $data->{$key} = "" unless defined($data->{$key});

      my $key_type = ref($data->{$key});

      # Recurse again if the child key is another hash
      if($key_type eq 'HASH') {

        $return .= ' ' x $indent . "<$key>\n";
        $return .= $self->xml_out($data->{$key}, $indent + 2) || "";
        $return .= ' ' x $indent . "</$key>\n";

      # Recurse on each element if the child key is an array
      } elsif($key_type eq 'ARRAY') {

        $return .= ' ' x $indent . "<$key>\n";
        foreach my $item ( @{ $data->{$key} } ) {
          $return .= $self->xml_out($item, $indent + 2) || "";
        }
        $return .= ' ' x $indent . "</$key>\n";

      # Assume the child is a text node otherwise, and print
      } else {
        $return .= ' ' x $indent . "<$key>" . $data->{$key} . "</$key>\n";
      }

    }

  # Recurse on each element if the passed ref is an array
  } elsif( $data_type eq 'ARRAY' ) {

    foreach my $item ( @$data ) {
      $return .= $self->xml_out($item, $indent);
    }

  # What's this? Print it and hope for the best
  } else {
     $return .= "$data\n";
  }

  return $return;

}



##
## TiVo::Server->command_QUERYSERVER( $ )
##
##  Generates response to QueryServer command
##  Expects to be passed a TiVo::Request object
##  Returns data structure suitable for use with xml_out
##
sub command_QUERYSERVER {
  my $self = shift;
  my $params = shift;

  my $return = {
    'TiVoServer' => {
      'Version'         => $self->VERSION,
      'InternalVersion' => $self->INTVERSION,
      'InternalName'    => $self->INTNAME,
      'Organization'    => $self->_Organization || $self->ORGANIZATION,
      'Comment'         => $self->_Comment || $self->COMMENT
    }
  };

  return $return;

}



##
## TiVo::Server->command_QUERYCONTAINER( $ )
##
##  Generates response to QueryContainer command
##  Expects to be passed a TiVo::Request object
##  Returns data structure suitable for use with xml_out
##
sub command_QUERYCONTAINER {
  my $self = shift;
  my $params = shift;

  my $container = $params->_Container;

  # Return service containers unless otherwise requested
  $container = '/' unless defined $container;

  my $object = $self->thaw($container) || return undef;

  my @list;

  if( defined($params->_Recurse) && uc($params->_Recurse) eq 'YES' ) {

    # Explode the content list and get a recursive flat list of objects
    @list = @{ $object->explode($self) };

  } else {

    # Take the top-level list of objects and remove any subfolder list refs
    @list = @{ $object->contents($self) };
    @list = grep { ref($_) ne 'ARRAY' } @list;

    # We'll always perform the default Sort of Type,Title
    @list = sort {
      return -1 if (ref $a) =~ /^TiVo::Container/ && (ref $b) =~ /^TiVo::Item/;
      return 1 if (ref $b) =~ /^TiVo::Container/ && (ref $a) =~ /^TiVo::Item/;
      return uc($a->_Title) cmp uc($b->_Title);
    } @list;

  }

  # Apply any requested filters
  if( defined($params->_Filter) ) {

    my %types;
    my @filters;

    if( $params->_Filter =~ /,/ ) {
      @filters = split(/,/, $params->_Filter);
    } else {
      @filters = ( $params->_Filter );
    }

    # Construct a list of every possible matching type instead
    # of matching against each object's SourceFormat individually
    my $possible_types =  $object->_Service->_MediaTypes;
    $possible_types->{'FOLDER'} = 'x-container/folder';

    foreach my $filter ( @filters ) {

      my($major, $minor) = split(/\//, $filter);

      $major = $major || '*';
      $minor = $minor || '*';

      # Compare the filter to each supported MediaType for this service
      foreach my $supported ( keys %$possible_types ) {

        my($s_major, $s_minor) =
          split(/\//, $possible_types->{$supported});

        if( ( $major eq $s_major || $major eq '*' ) &&
            ( $minor eq $s_minor || $minor eq '*' )
          ) {

          $types{"$s_major/$s_minor"} = 1;

        }

      }

    }

    @list = grep { defined( $types{$_->_SourceFormat} ) } @list;

  }

  my $total_duration = 0;

  # Check for any audio files that passed the Filter and sum their Duration
  foreach ( @list ) { 
    if( defined($_->_Duration) ) {
      $total_duration += $_->_Duration;
    }
  }

  # Perform any requested sorts. Currently incomplete, only supports Random
  # and Type,Title
  if( defined( $params->_SortOrder ) ) {

    if( uc($params->_SortOrder) eq 'RANDOM' ) {

      # Remove RandomStart from the object list before sorting
      my $start;
      if( defined( $params->_RandomStart ) ) { 

        my $prefix = $params->_EnvScriptname;

        my $short_start = $params->_RandomStart;
        $short_start =~ s/^$prefix//;

        foreach my $i ( 0 .. $#list ) {

          next unless defined $list[$i]->_Url;
          next unless $list[$i]->_Url eq $short_start;

          $start = splice(@list, $i, 1);
          last;

        }

      }

      srand( $params->_RandomSeed ) if defined $params->_RandomSeed;

      my $i;
      for( $i = @list; --$i; ) {
        my $j = int rand ( $i + 1 );
        next if $i == $j;
        @list[$i,$j] = @list[$j,$i];
      }

      # Reattach RandomStart as the first object
      unshift(@list, $start) if defined $start;

    }

  }

  my $count = scalar @list || 0;

  # Anchor defaults to first item
  my $anchor_pos = 0;

  if( defined($params->_AnchorItem) ) {

    my $prefix = $params->_EnvScriptname;

    my $short_anchor = $params->_AnchorItem;
    $short_anchor =~ s/^$prefix//;

    foreach my $i ( 0 .. $#list ) {

      next unless defined $list[$i]->_Url;
      next unless $list[$i]->_Url eq $short_anchor;

      $anchor_pos = $i + 1;
      last;

    }

    # Adjust the anchor position if a positive or negative offset is given
    if( defined( $params->_AnchorOffset ) ) {

      my $anchor_offset = $params->_AnchorOffset || 0;
      $anchor_pos += $anchor_offset;

    }

  }


  # Trim return list, if requested
  if( defined($params->_ItemCount) ) {

    my $count = $params->_ItemCount;

    # Wrap the pointer if a negative count is requested
    if( $count < 0 ) {

      $count *= -1;
 
      # Jump to end of list if no Anchor is provided 
      if( defined($params->_AnchorItem) ) {
        $anchor_pos -= $count + 1;
      } else {
        $anchor_pos = $#list - $count + 1;
      }

    }

    # Check for under/overflow
    if( $anchor_pos >= 0 && $anchor_pos <= $#list ) {

      @list = splice(@list, $anchor_pos, $count);

    } else {

      $anchor_pos = 0;
      undef @list;

    }

  }

  # Build description of each item to be returned
  my @children;
  foreach my $child ( @list ) {
 
    push(@children, $child->query_container($params));

  }

  my $return = {
    'TiVoContainer' => [
      { 'Details' => {
        'Title'         => $object->_Title,
        'ContentType'   => $object->_ContentType || 'x-container/folder',
        'SourceFormat'  => $object->_SourceFormat || 'x-container/folder',
        'TotalItems'    => $count,
        'TotalDuration' => $total_duration
      } },
      { 'ItemStart' => $anchor_pos },
      { 'ItemCount' => scalar @children || 0 },
      \@children
    ]
  };

  return $return;

}



##
## TiVo::Server->command_UNKNOWN( $ )
##
##  Generates response to Unknown commands
##  Expects to be passed a TiVo::Request object
##  Returns data structure suitable for use with xml_out
##
sub command_UNKNOWN {
  my $self = shift;
  my $params = shift;

  return {};

}



##############################################################################
# TiVo::Container
#   Attaches TiVo methods to a particular directory
##############################################################################
package TiVo::Container;
@ISA = ('TiVo');

##
## TiVo::Container->new( % )
##
##  Generic TiVo::Container constructor
##  Accepts parameters via an argument hash.
##  Expects to be passed a full pathname and either a string describing
##  the service prefix (if this container is to be a service) or another
##  TiVo::Container object (if this container is to be a subdirectory
##  of an existing service). 
##
sub new {
  my $class = shift;

  my $self = {};
  bless $self, $class;

  my %params = ( @_ );

  my $service = $params{'SERVICE'} || return undef;
  $self->_Path = $params{'PATH'};

  # This container is a subdirectory
  if( (ref $service) =~ /^TiVo::Container/ ) {

    $self->_Object = $service->path_to_obj($self->_Path) || return undef;
    $self->_Service = $service;

  # This container is a service container
  } else {

    $self->_Object = $service;
    $self->_Service = $self;

  }

  # Set folder title, if provided
  $self->_Title = $params{'TITLE'};

  # Defaults common to all Containers
  $self->_SourceFormat = 'x-container/folder';
  $self->_Url = '?Command=QueryContainer&Container=' .
                 $self->uri_escape( $self->_Object );

  # Call class-specific init method
  $self->init || return undef;

  return $self;

}



##
## TiVo::Container->init( )
##
##  Generic TiVo::Container initialization
##
sub init {
  my $self = shift;

  $self->_ContentType = 'x-container/folder';

  $self->_Title = $self->_Title || $self->basename;

  return 1;

}





##
## TiVo::Container->path_to_obj( $ )
##
##  Converts the given pathname to an object path relative to the
##  current service
##
sub path_to_obj {
  my $self = shift;
  my $path = shift || return undef;

  my $service_p = $self->_Path;
  my $service_o = $self->_Object;

  $path =~ s/^$service_p/$service_o/;

  return $path;

}



##
## TiVo::Container->obj_to_path( $ )
##
##  Converts the given object path (relative to the current service) to
##  a full filesystem pathname
##
sub obj_to_path {
  my $self = shift;
  my $path = shift || return undef;

  my $service_p = $self->_Path;
  my $service_o = $self->_Object;

  $path =~ s/^$service_o/$service_p/;

  return $path;

}


##
## TiVo::Container->contents( $ )
##
##  Returns the contents of a TiVo::Container directory as a list ref
##  of Item and Container objects.
##
sub contents {
  my $self = shift;
  my $server = shift;

  return $self->_Contents if defined $self->_Contents;

  my @contents;

  local *DIR;
  opendir(DIR, $self->_Path) || return undef;

  while( defined( my $file = readdir DIR ) ) {
    next if $file =~ /^\./;

    if( defined $server ) {

      my $object_path = $self->_Object . "/" . $file;
      my $child = $server->thaw($object_path) || next;

      push(@contents, $child);

    } else {

      my $full_path = $self->_Path . "/" . $file;

      if( -d $full_path ) {   

        my $child = TiVo::Container->new(
          PATH => $full_path,
          SERVICE => $self->_Service
        ) || next;

        push(@contents, $child);

      } elsif( -r $full_path ) {

        my @parts = split(/\./, $full_path);
        my $suffix = uc( pop @parts);
  
        my $class = "TiVo::Item::$suffix";
        my $child = eval{ $class->new( $full_path, $self->_Service ); } || next;

        push(@contents, $child);

      }

    }

  }

  closedir(DIR);

  # Cache the new information we just built
  $self->_Contents = \@contents;
  $server->freeze($self) if defined $server;

  return \@contents;

}



##
## TiVo::Container->explode( $ )
##
##  Converts the single-directory Container and Item list format of an
##  object's contents() to a recursive list of all Containers and Items.
##
sub explode {
  my $self = shift;
  my $server = shift;

  my $list = $self->contents($server);

  # We'll always perform the default Sort of Type,Title
  @$list = sort {
    return -1 if (ref $a) =~ /^TiVo::Container/ && (ref $b) =~ /^TiVo::Item/;
    return 1 if (ref $b) =~ /^TiVo::Container/ && (ref $a) =~ /^TiVo::Item/;
    return uc($a->_Title) cmp uc($b->_Title);
  } @$list;

  my @return;

  foreach my $item ( @$list ) {

    if( (ref $item) =~ /^TiVo::Container/ ) {

      # Fetch the most current copy of this item from Cache
      $item = $server->thaw($item->_Object) || next;

      push(@return, $item);
      push(@return, @{ $item->explode($server) } );

    } else {

      push(@return, $item);

    }

  }

  return \@return;

}



package TiVo::Container::Server;
@ISA = ("TiVo::Container");

##
## TiVo::Container::Server->init( )
##
##  Defines a Server psuedo-container which overrides the generic init
##  method. Sets content types unique to a Server container;
##
sub init {
  my $self = shift;

  $self->_Object = "/";
  $self->_Service = "/";

  $self->_ContentType = 'x-container/tivo-server';

  $self->_Title = $self->_Title || "TiVo Server";

  return 1;

}



# TiVo::Container extension
package TiVo::Container::Music;
@ISA = ("TiVo::Container");

##
## TiVo::Container::Music->init( )
##
##  Defines a Music container which overrides the generic init
##  method. Sets content and media types unique to a 'Music'
##  container.
##
sub init {
  my $self = shift;

  $self->_ContentType = 'x-container/tivo-music';

  # Media types accepted for this container.
  # When creating a handler for a new media type, be sure to
  # register it with the appropriate service via:
  #   $service->_MediaTypes->{'NewSuffix'} = 'mime/type';
  #
  $self->_MediaTypes = {
    'MP3'  => 'audio/mpeg',
    'WAV'  => 'audio/wav',
    'PLS'  => 'audio/scpls',
    'M3U'  => 'text/plain'
  };

  $self->_Title = $self->_Title || "Music";

  return 1;

}



# TiVo::Container extension
package TiVo::Container::Photos;
@ISA = ("TiVo::Container");

##
## TiVo::Container::Photos->init( )
##
##  Defines a Photo container which overrides the generic init
##  method. Sets content and media types unique to a 'Photos'
##  container.
##
sub init {
  my $self = shift;

  $self->_ContentType = 'x-container/tivo-photos';

  # Media types accepted for this container.
  # When creating a handler for a new media type, be sure to
  # register it in the appropriate service with:
  #   $service->_MediaTypes->{'NewSuffix'} = 'mime/type';
  #
  $self->_MediaTypes = {
    'JPG'  => 'image/jpeg',
    'PNG'  => 'image/png',
    'GIF'  => 'image/gif'
  };

  $self->_Title = $self->_Title || "Photos";

  return 1;

}




##############################################################################
# TiVo::Item
#   Attaches TiVo methods to a particular file
##############################################################################
package TiVo::Item;
@ISA = ('TiVo');

##
## TiVo::Item->new( $ $ )
## 
##  Constructor for generic TiVo::Item
##  Expects to be passed a full pathname and a TiVo::Container service
##  to pull container information from
##
sub new {
  my $class = shift;

  my $self = {};
  bless $self, $class;

  $self->_Path = shift || return undef;
  $self->_Service = shift || return undef;

  # use the file suffix to determine file type
  my @parts = split(/\./, $self->_Path);
  my $suffix = uc( pop @parts);

  # Skip this file if the service doesn't claim to support it
  return undef unless defined $self->_Service->_MediaTypes;

  $self->_SourceFormat = $self->_Service->_MediaTypes->{$suffix} || return undef;

  $self->_Object = $self->_Service->path_to_obj($self->_Path) || return undef;
  $self->_Url = $self->uri_escape($self->_Object);

  # Contruct ContentType from SourceFormat
  my $content_type = $self->_SourceFormat;
  $content_type =~ s/\/.*$/\/\*/;

  $self->_ContentType = $content_type;

  # Call class-specific init method
  $self->init || return undef;

  return $self;

}


##
## TiVo::Item->init( )
##
##  Generic TiVo::Item initialization
##
sub init {
  my $self = shift;

  return 1;

}



##
## TiVo::Item->send( )
##
##  Generic TiVo::Item file transfer
##
sub send {
  my $self = shift;

  require IO::File;

  my $handle = IO::File->new($self->_Path);

  my $headers = {
    'Content-Type'	=> $self->_SourceFormat,
    'Content-Length'	=> $self->_SourceSize
  };

  return($headers, $handle);

}



# TiVo::Item extension
package TiVo::Item::MP3;
@ISA = ('TiVo::Item');


##
## TiVo::Item::MP3->init( )
##
##  Overrides generic init method for TiVo::Item and includes MP3
##  specific fields
##
sub init {
  my $self = shift;

  require MP3::Info;

  my $tag = MP3::Info::get_mp3tag($self->_Path);
  my $info = MP3::Info::get_mp3info($self->_Path);

  return undef unless defined $info;

  $self->_SourceBitRate = sprintf("%d", $info->{'BITRATE'} * 1000) || 0;
  $self->_SourceSampleRate = sprintf("%d", $info->{'FREQUENCY'} * 1000) || 0;
  $self->_Duration = sprintf("%d", ( $info->{'SECS'} * 1000 )) || 0;

  $self->_Genre = $tag->{'GENRE'} || "";
  $self->_Artist = $tag->{'ARTIST'} || "";
  $self->_Album = $tag->{'ALBUM'} || "";
  $self->_Year = $tag->{'YEAR'} || "";
  $self->_Title = $tag->{'TITLE'} || $self->basename;

  # Get timestamps and size if the file referenced by Path exists
  if( stat($self->_Path) ) {

    $self->_SourceSize = -s $self->_Path;

    my $change_date = ( stat(_) )[9];
    my $access_date = ( stat(_) )[8];

    $change_date = sprintf("0x%x", $change_date);
    $access_date = sprintf("0x%x", $access_date);

    # *nix does not seem to have a portable "creation date" stamp.
    # Using last change date, instead.
    $self->_CreationDate = $change_date;
    $self->_LastChangeDate = $change_date;
    $self->_LastAccessDate = $access_date;

  }

  return 1;

}



##
## TiVo::Item::MP3->query_container
## 
##   Returns a data structure suitable for use with xml_out which
##   describes this object in response to a QueryContainer command
##
sub query_container {
  my $self = shift;
  my $params = shift;

  my $script_name = $params->_EnvScriptName || "";

  my $details = {
    'Item' => [
      {
        'Details' => {
          'Title'        => $self->_Title,
          'ContentType'  => $self->_ContentType,
          'SourceFormat' => $self->_SourceFormat,
          'ArtistName'   => $self->_Artist,
          'SongTitle'    => $self->_Title,
          'AlbumTitle'   => $self->_Album,
          'MusicGenre'   => $self->_Genre,
          'Duration'     => $self->_Duration
        }
      },
      {
        'Links' => {
          'Content' => {
            'Url'      => $script_name . $self->_Url,
            'Seekable' => 'Yes'
          }
        }
      }
    ]
  };

  return $details;

}



##
## TiVo::Item::MP3->send( $ )
##
##  TiVo::Item send extension supporting MP3 seeking
##
sub send {
  my $self = shift;
  my $params = shift;

  require IO::File;

  my $handle = IO::File->new($self->_Path);
  my $length = $self->_SourceSize;

  if( defined $params->_Seek ) {

    my $seek_ms = $params->_Seek;
    my $seek_offset = sprintf("%d", ( $seek_ms / $self->_Duration ) * $self->_SourceSize );

    seek($handle, $seek_offset, 0);

    $length = $length - $seek_offset;
  }

  my $headers = {
    'Content-Type'		=> $self->_SourceFormat,
    'Content-Length'		=> $length,
    'TivoAccurateDuration'	=> $self->_Duration
  };
  
  return($headers, $handle);

}     



# TiVo::Item extension
package TiVo::Item::JPG;
@ISA = ('TiVo::Item');


##
## TiVo::Item::JPG->init( )
##
##  Overrides generic init method for TiVo::Item and includes JPG
##  specific fields
##
sub init {
  my $self = shift;

  require Image::Magick;

  my $img = new Image::Magick;
  $img->Read($self->_Path);

  return undef unless defined $img;

  my($width, $height, $depth) = $img->Get('width', 'height', 'depth');

  $self->_SourceWidth = $width || 0;
  $self->_SourceHeight = $height || 0;
  $self->_SourceColors = $depth || 0;

  $self->_Title = $self->basename;

  # Get timestamps and size if the file referenced by Path exists
  if( stat($self->_Path) ) {

    $self->_SourceSize = -s $self->_Path;

    my $change_date = ( stat(_) )[9];
    my $access_date = ( stat(_) )[8];

    $change_date = sprintf("0x%x", $change_date);
    $access_date = sprintf("0x%x", $access_date);

    # *nix does not seem to have a portable "creation date" stamp.
    # Using last change date, instead.
    $self->_CreationDate = $change_date;
    $self->_LastChangeDate = $change_date;
    $self->_LastAccessDate = $access_date;

  }

  return 1;

}



##
## TiVo::Item::JPG->query_container
## 
##   Returns a data structure suitable for use with xml_out which
##   describes this object in response to a QueryContainer command
##
sub query_container {
  my $self = shift;
  my $params = shift;

  my $script_name = $params->_EnvScriptName || "";

  my $details = {
    'Item' => [
      {
        'Details' => {
          'Title'          => $self->_Title,
          'ContentType'    => $self->_ContentType,
          'SourceFormat'   => $self->_SourceFormat,
          'LastChangeDate' => $self->_LastChangeDate
        }
      },
      {
        'Links' => {
          'Content' => {
            'Url' => $script_name . $self->_Url
          }
        }
      }
    ]
  };

  return $details;

}



##
## TiVo::Item::JPG->send( )
##
##  TiVo::Item send extension supporting image transforms
##
sub send {
  my $self = shift;
  my $params = shift;
  my $server = shift;

  my $path = $self->_Path;
  my $mime_type = $self->_SourceFormat;
  my $filename = $self->basename;

  # Use filename suffix to determine image format
  $filename =~ s/\.(.+?)$//;
  my $suffix = $1;
  my $source_suffix = $suffix;

  # Check for support if a specific format was requested
  if( defined( $params->_Format ) ){

    my $found = 0;

    foreach my $type ( keys %{ $self->_Service->_MediaTypes } ) {

      next unless defined $type;

      if( $self->_Service->_MediaTypes->{$type} eq $params->_Format ) {

        $found = 1;
        $suffix = $type;
        $mime_type = $params->_Format;
        last;

      }

    }

    # Fail if an unavailable format was requested
    return undef unless $found;
  }

  $suffix = uc($suffix);

  # We will check cache if a transform has been requested
  if( defined( $params->_Width ) ||
      defined( $params->_Height ) ||
      defined( $params->_PixelShape ) ||
      ( uc($suffix) ne uc($source_suffix) ) ) {

    # Use MD5 to hash the filename
    require Digest::MD5;

    my $cache_name = Digest::MD5::md5_hex($path);

    my $string = "";
    $string .= "_H" . $params->_Height if defined($params->_Height);
    $string .= "_W" . $params->_Width if defined($params->_Width);
    $string .= "_S" . $params->_PixelShape if defined($params->_PixelShape);

    # Append transform data to filename
    $cache_name .= $string;

    my $cache_dir = $server->_ImageDir || '/tmp';
    my $cache_path = "$cache_dir/$cache_name.$suffix";

    # Send cached image directly, if it exists
    if( -f $cache_path ) {

      $path = $cache_path;

    # Otherwise, use Image::Magick to perform requested transforms
    } else {

      require Image::Magick;

      my $width = $self->_SourceWidth;
      my $height = $self->_SourceHeight;
      my $ratio = 1;

      # Calculate the pixel scaling ratio
      if( defined( $params->_PixelShape ) ) {

        my( $xscale, $yscale ) = split(/:/, $params->_PixelShape);

        if( $yscale > $xscale ) {
          $width *= $yscale / $xscale;
        } elsif ( $xscale > $yscale ) {
          $height *= $xscale / $yscale;
        }

      }

      # Calculate the scaling ratio if a new Width or Height is specified
      if( defined( $params->_Width ) || defined( $params->_Height ) ) {
  
        my $s_width = 0;
        my $s_height = 0;
  
        if( defined( $params->_Width ) ) {
          $s_width = $params->_Width;
          $s_width = $s_width / $width;
        }

        if( defined( $params->_Height ) ) {
          $s_height = $params->_Height;
          $s_height = $s_height / $height;
        }

        $ratio = $s_width < $s_height ? $s_width : $s_height;

      }

      my $img = new Image::Magick;
      $img->Read($self->_Path);

      if( $ratio ) {
      $img->Scale(width => $width * $ratio,
                  height => $height * $ratio);
    }

      $img->Write(filename => $cache_path);
      $path = $cache_path;

    }

  }

  require IO::File;

  my $handle = IO::File->new($path);
  my $length = -s $path;

  my $headers = {
    'Content-Type'	=> $mime_type,
    'Content-Length'	=> $length
  };

  return($headers, $handle);

}



# TiVo::Item extension
package TiVo::Item::GIF;
@ISA = ('TiVo::Item::JPG');   

# TiVo::Item extension
package TiVo::Item::PNG;
@ISA = ('TiVo::Item::JPG');


##############################################################################
# TiVo::Request
#   Stores information about a given command request which needs to be
#   passed from object to object
##############################################################################
package TiVo::Request;
@ISA = ( 'TiVo' );

##
## TiVo::Request->new( $ $ $ )
##
##  Constructor for TiVo::Request.
##  Expects to be passed three strings:
##
##    Script Name:  The path and name of the CGI/server as requested in the URI
##                  This is the same string provided by webserver in the
##                  $SCRIPT_NAME environment variable
##    Path Info:    The path information appended after the CGI/server in
##                  the URI, but before the paramater list.
##                  This is the same string provided by webserver in the
##                  $PATH_INFO environment variable
##    Query String  The key/value query string appended to the end of the URI
##                  This is the same string provided by webserver in the
##                  $QUERY_STRING environment variable
##
sub new {
  my $class = shift;

  my $self = {};
  bless $self, $class;

  $self->_EnvScriptName = shift;
  $self->_EnvPathInfo = shift;
  $self->_EnvQueryString = shift;

  # Parse the query_string, if provided
  if( defined($self->_EnvQueryString) ) {
    $self->parse ( $self->_EnvQueryString );
  }

  return $self;

}



##
## TiVo::Request->parse( $ )
##
##   Trim, split, and decode a standard CGI query string. The key/value
##   pairs are stored in the object's internal DATA hash
##
sub parse {
  my $self = shift;
  my $query = shift;

  # Skip the query if it doesn't contain anything useful
  if( defined($query) && $query =~ /[=&]/ ) {

    # remove everything before the '?' and replace '+' with a space
    $query =~ s/.*\?//;
    $query =~ s/\+/ /g;

    my @pairs = split(/&/, $query);

    foreach my $pair ( @pairs ) {

      my($key, $value) = split(/=/, $pair, 2);

      if( defined($key) ) {

        # Escape each key and value before storing
        $key = $self->uri_unescape($key);
        $self->{'DATA'}->{ uc($key) } = $self->uri_unescape($value);

      }

    }

  }

}



1;