Help-Site Computer Manuals
Software
Hardware
Programming
Networking
  Algorithms & Data Structures   Programming Languages   Revision Control
  Protocols
  Cameras   Computers   Displays   Keyboards & Mice   Motherboards   Networking   Printers & Scanners   Storage
  Windows   Linux & Unix   Mac

/var/sites/help-site.com/auto/tmp/CPAN/9677/TiVo-Calypso-1.3.3/TiVo/Calypso.pm

/var/sites/help-site.com/auto/tmp/CPAN/9677/TiVo-Calypso-1.3.3/TiVo/Calypso.pm


    # 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;

    }

=cut

    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::Calypso::Server->command_UNKNOWN( $ ) ## ## Generates response to Unknown commands ## Expects to be passed a TiVo::Calypso::Request object ## Returns data structure suitable for use with xml_out

sub command_UNKNOWN { my $self = shift; my $params = shift;


    return {};

}

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

## TiVo::Calypso::Container->new( % ) ## ## Generic TiVo::Calypso::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::Calypso::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::Calypso::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 );

    $self->_Expired = 0;

    # Call class-specific init method

    $self->init(%params) || return undef;

    return $self;

}

## TiVo::Calypso::Container->init( ) ## ## Generic TiVo::Calypso::Container initialization

sub init { my $self = shift;


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

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

    return 1;

}

## TiVo::Calypso::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::Calypso::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::Calypso::Container->contents( $ ) ## ## Returns the contents of a TiVo::Calypso::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;

    if ( $self->_Path eq '/Shuffle' ) {

        my ( @artists, @songs );

        opendir( DIR, $server->_Services->{'/Shuffle'}->_Path ) || return undef;

        while ( defined( my $file = readdir DIR ) ) {

            next if $file =~ /^\./;

            push @artists, $file;

        }

        closedir(DIR);

        srand();

        for (1) {

            my ( @albums, @songlist );

            my $artist = $artists[ rand @artists ];

            opendir( DIR,

                $server->_Services->{'/Shuffle'}->_Path . '/' . $artist )

              || return undef;

            while ( defined( my $file = readdir DIR ) ) {

                next if $file =~ /^\./;

                push @albums, $artist . '/' . $file;

            }

            closedir(DIR);

            my $album = $albums[ rand @albums ];

            opendir( DIR,

                $server->_Services->{'/Shuffle'}->_Path . '/' . $album )

              || return undef;

            while ( defined( my $file = readdir DIR ) ) {

                next if $file =~ /^\./;

                push @songlist, $album . '/' . $file;

            }

            closedir(DIR);

            push @songs, $songlist[ rand @songlist ];

        }

        foreach my $song (@songs) {

            my @parts  = split( /\./, $song );

            my $suffix = uc( pop @parts );

            my $class = "TiVo::Calypso::Item::$suffix";

            my $child = eval {

                $class->new(

                    $server->_Services->{'/Shuffle'}->_Path . '/' . $song,

                    $self->_Service );

            } || next;

            push @contents, $child;

        }

    }

    elsif ( $self->_Path eq $server->_Services->{'/Music'}->_Path ) {

        foreach (qw/ * A B C D E F G H I J K L M N O P Q R S T U V W X Y Z /) {

            my $child = TiVo::Calypso::Container->new(

                PATH    => $self->_Path . "/Browse/" . $_,

                SERVICE => $self->_Service

              )

              || next;

            push( @contents, $child );

        }

    }

    else {

        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::Calypso::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::Calypso::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::Calypso::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);

    @$list = sort {

        return -1

          if ( ref $a ) =~ /^TiVo::Calypso::Container/ && ( ref $b ) =~ /^TiVo::Calypso::Item/;

        return 1

          if ( ref $b ) =~ /^TiVo::Calypso::Container/ && ( ref $a ) =~ /^TiVo::Calypso::Item/;

        return uc( $a->_Path ) cmp uc( $b->_Path );

        #$        return uc($a->_Album) cmp uc($b->_Album) ||

        #$            $a->_Track <=> $b->_Track ||

        #$            $a->_Path  <=> $b->_Path ||

        #$            uc($a->_Title) cmp uc($b->_Title);

    } @$list;

    my @return;

    foreach my $item (@$list) {

        if ( ( ref $item ) =~ /^TiVo::Calypso::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::Calypso::Container::Server; @ISA = (``TiVo::Calypso::Container'');

## TiVo::Calypso::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::Calypso::Container extension package TiVo::Calypso::Container::Music; @ISA = (``TiVo::Calypso::Container'');

## TiVo::Calypso::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;


    my %params = (@_);

    $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' };

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

    if ( $params{'SCROBBLER'} ) {

        $self->_Scrobble        = 1;

        $self->_ScrobblePostUrl = $params{'SCROBBLER'}->{'POSTURL'};

        $self->_ScrobbleU       = $params{'SCROBBLER'}->{'USERNAME'};

        $self->_ScrobbleP       = $params{'SCROBBLER'}->{'PASSWORD'};

    }

    return 1;

}

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

## TiVo::Calypso::Item->new( $ $ ) ## ## Constructor for generic TiVo::Calypso::Item ## Expects to be passed a full pathname and a TiVo::Calypso::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;

    $self->_Dirty = 0;

    # Call class-specific init method

    $self->init || return undef;

    return $self;

}

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


    return 1;

}

## TiVo::Calypso::Item->send( ) ## ## Generic TiVo::Calypso::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::Calypso::Item extension package TiVo::Calypso::Item::MP3; @ISA = ('TiVo::Calypso::Item');

## TiVo::Calypso::Item::MP3->init( ) ## ## Overrides generic init method for TiVo::Calypso::Item and includes MP3 ## specific fields

sub init { my $self = shift;


    # use the file suffix to determine file type

    my @parts  = split( /\./, $self->_Path );

    my $suffix = uc( pop @parts );

    # Assume MP3 for lack of anything better.

    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::Calypso::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::Calypso::Item::MP3->send( $ ) ## ## TiVo::Calypso::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::Calypso::Request # Stores information about a given command request which needs to be # passed from object to object ############################################################################## package TiVo::Calypso::Request; @ISA = ('TiVo::Calypso');

## TiVo::Calypso::Request->new( $ $ $ ) ## ## Constructor for TiVo::Calypso::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::Calypso::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;

Programminig
Wy
Wy
yW
Wy
Programming
Wy
Wy
Wy
Wy