view release on metacpan or  search on metacpan

scripts/dvbt-iplay  view on Meta::CPAN

# 
#
sub match_iplay
{
	my ($index_aref, $history_href, $target, $found_aref, $force) = @_ ;

print STDERR "match_iplay($target)\n" if $DEBUG ;		

	my @get ;

	## Convert title into regexp
	my $regexp = title2regexp($target) ;
	
	for (my $i=0; $i < @$index_aref; ++$i)
	{
#print STDERR "regexp='$regexp' : search='$index_aref->[$i]{'search'}'\n" ;		
		if ($index_aref->[$i]{'search'} =~ /$regexp/i)
		{
			my $entry_href = $index_aref->[$i] ;
			
			my $id = $entry_href->{'pid'} ;
			
			# check download history
			$entry_href->{'downloaded'} = 0 ;
			if (exists($history_href->{$id}))
			{
				$entry_href->{'downloaded'} = $history_href->{$id} ;
			}
			
			# save
			push @$found_aref, $entry_href ;
print STDERR " + FOUND (download=$entry_href->{'downloaded'})\n" if $DEBUG ;		
		}
	}

Linux::DVB::DVBT::prt_data("Found list=", $found_aref) if $DEBUG>=2 ;

print STDERR "Create get list:\n" if $DEBUG ;		
	
	foreach my $href (@$found_aref)
	{
		# skip already downloaded AND not forced
		if ($href->{'downloaded'} && !$force)
		{
			next ;
		}

print STDERR " + GET $href->{'pid'} : $href->{name} : $href->{desc}\n" if $DEBUG ;		
		
		# add to list of files to get
		push @get, $href ;
	}

Linux::DVB::DVBT::prt_data("Get list=", \@get) if $DEBUG>=2 ;

	return @get ;
}

#-----------------------------------------------------------------------------
# Update the 'get' list with the latest download history
sub update_iplay
{
	my ($get_aref, $history_href) = @_ ;

print STDERR "update_iplay()\n" if $DEBUG ;		

	foreach my $entry_href (@$get_aref)
	{
		my $id = $entry_href->{'pid'} ;
		
		# check download history
		$entry_href->{'downloaded'} = 0 ;
		if (exists($history_href->{$id}))
		{
			$entry_href->{'downloaded'} = $history_href->{$id} ;
		}
	}
}


#-----------------------------------------------------------------------------
sub title2regexp
{
	my ($title) = @_ ;

	my @fields = split(/[^\w\d\']+/, $title) ;
	
	my $regexp = "" ;
	foreach my $field (@fields)
	{
		$field =~ s/\'/.{0,1}/g ;
		if (!$regexp)
		{
			$regexp = "^" ;
		}
		else
		{
			$regexp .= ".+\\b";
		}
		$regexp .= "$field\\b" ;
	}


	print STDERR "Regexp: $regexp\n" if $DEBUG>=3 ;
	
	return $regexp ;
}


#-----------------------------------------------------------------------------
# Run get_iplayer and check for errors
#
# Fills in the recorded HASH ref with details for each get_iplayer index:
#
#{ # HASH(0x8fd74a0)
#  b007jwv5 => 
#    { # HASH(0x965b018)
#      error => 0,
#      file => /home/sdprice1/svn/record-multirec-devel/temp/All_the_Worlds_a_Globe_-_Episode_6_b007jwv5_default.aac,
#      status => recorded,
#    },