File Coverage

blib/lib/Smil.pm

Criterion	Covered	Total	%
statement	82	193	42.4
branch	13	44	29.5
condition	5	18	27.7
subroutine	23	51	45.1
pod	0	45	0.0
total	123	351	35.0

package Smil;

$VERSION = "0.898";

use Carp;
use SMIL::XMLBase;
use SMIL::XMLContainer;
use SMIL::XMLTag;
use SMIL::Head;
use SMIL::Body;

my $TRUE = 'true';

@ISA = qw( SMIL::XMLContainer );

my $head = "head";
my $body = "body";
my @timelineStack;
my $smil;
my $file = "file";
my $INLINE = 'inline';

my $CV_SYSTEM_COMPONENT = "cv:systemComponent";
my @RP_SYSTEM_REQUIRED_ATTRIBUTE = ( "system-required" => "cv" );

my $RN_EXTENSIONS = 'rn-extensions';
my $RN_SHORT = 'rn';
my $QT_EXTENSIONS = 'qt-extensions';
my $QT_SHORT = 'qt';
my $QT_NS_URL = "http://www.apple.com/quicktime/resources/smilextensions";
my $QT_NS = "xmlns:qt";

my $SMIL_2_NS = 'xmlns';
my $SMIL_2_NS_URL = 'http://www.w3.org/2001/SMIL20/Language';

my $RN_SMIL_2_NAMESPACE = 'rnSmil2';
my $RN_SMIL_2_NS_URL = "http://features.real.com/2001/SMIL20/Extensions";
my $RN_SMIL_2_NS = "xmlns:$RN_SMIL_2_NAMESPACE";

my $VERSION_COMPATIBLE = 'version';
my $PLAYER_COMPATIBLE = 'player';
my $RP_COMPATIBLE = 'rp';
my $QT_COMPATIBLE = 'qt';

my $QT_AUTOPLAY = "qt:autoplay";
my $QT_CHAPTER_MODE = "qt:chapter-mode";
my $QT_IMMEDIATE_INSTANTIATION = "qt:immediate-instantiation";
my $QT_NEXT = "qt:next";
my $QT_TIME_SLIDER = "qt:time-slider";

my $RN_NS = "xmlns:cv";
my $RN_NS_URL = "http://features.real.com/systemComponent";

my %earliestAttribute = ( 'inline' => 7 );

my @RP_VERSION_MAPPING = ( "",  		# 0
																													"", 		# 1, unsupported
																													"", 		# 2, unsupported
																													"", 		# 3, unsupported
																													"", 		# 4, unsupported
																													"", 		# 5, unsupported
																													"", 		# 6, no switch allowed

																													# 7, Gold Player 7
																													"http://features.real.com/?component;player=6.0.7.380",

																													# 8, Gold Player 8
																													"http://features.real.com/?component;player=6.0.9.450",
																													);

my %VERSION_MAPPING = ( $RP_COMPATIBLE => \@RP_VERSION_MAPPING );

my %RP_FEATURE_VERSION_MAPPING = ( 'inline' => 7, 'newwindow' => 7 );

my %FEATURE_VERSION_MAPPING = ( $RP_COMPATIBLE => \%RP_FEATURE_VERSION_MAPPING );

my @smilAttributes = ( $RN_NS,
																							$QT_AUTOPLAY,
																							$QT_CHAPTER_MODE,
																							$QT_IMMEDIATE_INSTANTIATION,
																							$QT_NEXT,
																							$QT_TIME_SLIDER );

my @smil2Extensions = ( 'syncBehavior' );
my @rnSmil2Extensions = ( 'backgroundOpacity', 'bgcolor', 'chromaKey',
																										'chromaKeyOpacity', 'chromaKeyTolerance', 'mediaOpacity' );


sub init {
    my $self = shift;
    $self->SUPER::init( "smil" );

    my %hash = @_;
    my %smilAttrs = $self->createValidAttributes( { %hash },
																																																		[ @smilAttributes ] );

    if( $hash{ $QT_SHORT } or
								$hash{ $QT_EXTENSIONS } ) {
								$self->useQtExtensions;
    }

    if( $hash{ $RN_EXTENSIONS } or
								$hash{ $RN_SHORT } ) {
								$self->useRnExtensions;
    }

    $self->setAttributes( %smilAttrs );

    $self->setFavorite( $favorite ) if $favorite;
    $self->initHead( @_ );
    $self->initBody( @_ );
    $self->initFile( @_ );
}

sub setQtAutoplay {
				my $self = shift;
				$self->setAttribute( $QT_AUTOPLAY => $TRUE );
				$self->useQtExtensions;
}

sub setQtChapterMode {
				my $self = shift;
				my $dur = shift;
				$self->setAttribute( $QT_CHAPTER_MODE => $dur );
				$self->useQtExtensions;
}

sub useQtImmediateInstantiation {
				my $self = shift;
				$self->setAttribute( $QT_IMMEDIATE_INSTANTIATION => $TRUE );
				$self->useQtExtensions;
}

sub setQtNextPresentation {
				$self = shift;
				$next = shift;
				$self->setAttribute( $QT_NEXT => $next );
				$self->useQtExtensions;
}

sub useQtTimeSlider {
				$self = shift;
				$self->setAttribute( $QT_TIME_SLIDER => $TRUE );
				$self->useQtExtensions;
}

sub useRnExtensions {
				my $self = shift;
				my $version = shift;

				$self->setAttribute( $RN_NS => $RN_NS_URL );
				$self->setFavorite( $RN_NS );
}

sub useQtExtensions {
				my $self = shift;
				$self->setAttribute( $QT_NS => $QT_NS_URL );
				$self->setFavorite( $QT_NS );
}

sub getRootHeight {
    my $self = shift;
    my $hd = $self->getContentObjectByName( $head );
    return $hd ? $hd->getRootHeight() : 0;
}

sub getRootWidth {
    my $self = shift;
    my $hd = $self->getContentObjectByName( $head );
    return $hd ? $hd->getRootWidth() : 0;
}

sub getAsString {
    my $self = shift;

#    croak "Need to make sure to match start with end when defining timeline"
#	if( $check_errors && @{$self->{$timelineStack}} );

    return $self->SUPER::getAsString();
}

sub initFile {
    my $self = shift;
    my %hash = @_;
    if( $hash{ $file } ) {
								$self->{$file} = $hash{ $file };
    }
}

sub initHead {
    my $self = shift;
    my %hash = @_;
    $self->setTagContents( $head => new SMIL::Head( @_ ) )
								if( ( $hash{ 'height' } && $hash{ 'width' } ) ||
												$hash{ 'meta' } );
}

sub initBody {
    my $self = shift;
    $self->setTagContents( $body => new SMIL::Body( @_ ) ) unless $self->{$body};
}

sub startSequence {
    my $self = shift;
    $self->getContentObjectByName( $body )->startSequence( @_ );
}

sub startParallel {
    my $self = shift;
    $self->getContentObjectByName( $body )->startParallel( @_ );
}

sub endParallel {
    my $self = shift;
    $self->getContentObjectByName( $body )->endParallel();
}

sub endSequence {
    my $self = shift;
    $self->getContentObjectByName( $body )->endSequence();
}

sub hasQtExtensions {

				my $self = shift;
				my %hash = @_;
				my $returnValue = 0;

				foreach my $item ( keys %hash ) {
								$returnValue = 1 if $item =~ /^qt:/;
   }

				return $returnValue;
}

sub hasRnSmil2Extensions {
				my $self = shift;

				my $returnValue = 0;

				my %the_hash = @_;

				foreach my $item ( keys %the_hash ) {
								foreach my $rnAttribute ( @rnSmil2Extensions ) {
												$returnValue = 1 if $item eq $rnAttribute;
								}
				}

				return $returnValue;
}

sub useRnSmil2Extensions {
				my $self = shift;
				$self->setAttribute( $RN_SMIL_2_NS => $RN_SMIL_2_NS_URL );
}

sub hasSmil2Extensions {
				my $self = shift;

				my $returnValue = 0;

				my %the_hash = @_;

				foreach my $item ( keys %the_hash ) {
								foreach my $rnAttribute ( @smil2Extensions ) {
												$returnValue = 1 if $item eq $rnAttribute;
								}
				}

				return $returnValue;
}

sub useSmil2Extensions {
				my $self = shift;
				$self->setAttribute( $SMIL_2_NS => $SMIL_2_NS_URL );
}

sub checkForExtensions {

				my $self = shift;

    # Check for QT extensions, and add if necessary
    if( $self->hasQtExtensions( @_ ) ) {
								$self->useQtExtensions;
    }

				# Check for SMIL 2.0 attributes
				if( $self->hasSmil2Extensions( @_ ) ) {
								$self->useSmil2Extensions;
				}

				# Check for RN Smil 2.0 extensions
				if( $self->hasRnSmil2Extensions( @_ ) ) {
								$self->useRnSmil2Extensions;
				}

}

sub addInlinedMedia {
				my $self = shift;

				$self->addMedia( @_, inline => 1 );
}

sub addMedia {
    my $self = shift;

				$self->checkForExtensions( @_ );

    # Make sure that if we are adding inline that we
    # add the RP version checking code in case
    # we need to add a switch because we are authoring
    # for all players...
    if( &isInlined( @_ ) and $self->authoringBackwardsCompatible() ) {
								$self->useRnExtensions;
								# Add a switch statement of the possible entries here.
								$self->addBackwardsCompatibleSwitch( 'inline', @_ );
    }
    else {
								$self->getContentObjectByName( $body )->addMedia( @_ );
    }
}

sub getEarliestSupportedVersion {

   my $type = shift;
			my $feature = shift;

   print STDERR "Only RealPlayer is supported as backwards compatible type so far.: $type\n"
							unless $type eq $RP_COMPATIBLE;

   return( $FEATURE_VERSION_MAPPING{ $type }->{ $feature } );  # $RP_VERSION_COMPONENT );

}

sub getSupportedVersionAttribute {

   my $version = shift;
   my $player = shift;

   print STDERR "Only RealPlayer supported as backwards compatible type so far.: $player\n"
							unless $player eq $RP_COMPATIBLE;

   return( $CV_SYSTEM_COMPONENT, $VERSION_MAPPING{ $player }->[ $version ] );

}

sub getEarliestVersionForAttribute {
				my $attribute = shift;
				return $earliestAttribute{ $attribute };
}

sub addBackwardsCompatibleSwitch {

    my $self = shift;

				# Check for this 'feature' when adding switch code
				my $feature = shift;
    my @medias = ();

    my $earliestVersion = &getEarliestVersionForAttribute( $feature );
				# $self->getPrivate( $VERSION_COMPATIBLE ); # Don't really need this right now..
    my $playerType = $self->getPrivate( $PLAYER_COMPATIBLE );

				# Need a attribute list with the attribute we are switching on
				# and another without.
				my %withSwitchingAttribute = @_;

				# Remove the attribute
				my %withoutSwitchingAttribute = @_;
				undef( $withoutSwitchingAttribute{ $feature } );

    # Create a different media object for each of the versions
    # to support.  Make sure to go backwards since switch uses first
    # match
				my $supportedIndex = &getEarliestSupportedVersion( $playerType, $feature );

				my @attributes = ( %withSwitchingAttribute,
																							( @RP_SYSTEM_REQUIRED_ATTRIBUTE,
																									&getSupportedVersionAttribute( $supportedIndex,
																																																								$self->getPrivate( $PLAYER_COMPATIBLE ) ) ) );
				# attributes, and push it on the stack
				push @medias, SMIL::MediaFactory::getMediaObject( @attributes );

				# Now, add the one without the attribute
				push @medias, SMIL::MediaFactory::getMediaObject( %withoutSwitchingAttribute );

				# Create the different medias
				$self->addSwitchedMedia( 'switch' => 'system-required',
																													medias => [ \@medias ] );
}

sub authoringBackwardsCompatible {
				my $self = shift;
				return( $self->getPrivate( $VERSION_COMPATIBLE ) and $self->getPrivate( $PLAYER_COMPATIBLE ) );
}

sub setBackwardsCompatible {

				my $self = shift;

				# Get a version number, if they gave it to us.
				my %args = @_;

				my $version = $args{ $VERSION_COMPATIBLE };

				my $player = $args{ $PLAYER_COMPATIBLE };

				# Only do it for RN players right now...
				if( $player eq $RP_COMPATIBLE ) {
								$self->setPrivate( $PLAYER_COMPATIBLE => $player );
								$self->setPrivate( $VERSION_COMPATIBLE => $version );
				}
				else {
								print STDERR "Backwards compatible only supported for RealPlayer so far.";
				}
}

sub isInlined {
				my %args = @_;
				return defined( $args{ $INLINE } );
}

sub addTransition {
				my $self = shift;
				# Need to add the transition to the head.
				$self->useSmil2Extensions;
				my $head_ref;
				if( !( $head_ref = $self->getContentObjectByName( $head ) ) ) {
								$head_ref = new SMIL::Head();
								# Head must go at the top of the items in the
								$self->unshiftTagContents( $head => $head_ref );
				}
				$head_ref->addTransition( @_ );
}

sub addAnimation {
				my $self = shift;

				$self->useSmil2Extensions;

				die "addAnimation NYI";
}

sub addCode {
    my $self = shift;
    $self->getContentObjectByName( $body )->addCode( @_ );
}

sub addComment {
    my $self = shift;
    my $comment = shift;
    $self->getContentObjectByName( $body )->addCode( "" );
}

sub getRegionAttributeByName
{
    my $self = shift;
    my $region_name = shift;
    my $attr = shift;
    my $the_head = $self->getContentObjectByName( $head );
    my $return_value;
    if( $the_head ) {
	$return_value = $the_head->getRegionAttribute( $region_name, $attr );
    }
    if( 'ZERO_STRING' eq $return_value )
    {
	$return_value = "0";
    }
    return $return_value;
}

sub addSwitchedMedia {
    my $self = shift;
    $self->getContentObjectByName( $body )->addSwitchedMedia( @_ );
}

# Can only have one layout, so "set" rather than "add"
sub setSwitchedLayout {
    my $self = shift;
    if( $self->{$head} ) {
								$self->setTagContents( $head => new SMIL::Head( @_ ) );
    }
    $self->getContentObjectByName( $head )->setSwitchedLayout( @_ );
}

sub header {
    return "Content-type: " . &getMimeType() . "\n\n";
}

sub getMimeType {
				return "application/smil";
}

sub setMeta {
    my $self = shift;
    croak "Setting meta for SMIL NYI.";
}

sub setLayout {
    my $self = shift;
    croak "SetLayout for SMIL NYI.";
}

sub addRegion {
    my $self = shift;
    $self->getContentObjectByName( $head )->addRegion( @_ );
}

1;
__END__