The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/usr/bin/perl
use strict ;
use Pod::Usage ;
use Getopt::Long qw/:config no_ignore_case/ ;
use File::Basename ;

++$! ;

use Linux::DVB::DVBT::TS ;

our $VERSION = '1.002' ;

    my $progname = basename $0 ;

	my ($help, $man, $DEBUG, $VERBOSE, $dbg_ts, $split) ;
	GetOptions('v|verbose=i' => \$VERBOSE,
			   'debug=i' => \$DEBUG,
			   'dbg-ts=i' => \$dbg_ts,
			   'h|help' => \$help,
			   'man' => \$man,
			   'split' => \$split,
			   ) or pod2usage(2) ;


    pod2usage(1) if $help;
    pod2usage(-verbose => 2) if $man;
    pod2usage("$0: No arguments given.")  if (@ARGV == 0) ;
    pod2usage("$0: No input filename given.")  if (@ARGV < 1) ;
    pod2usage("$0: No cut filename given.")  if (@ARGV < 2) ;
    pod2usage("$0: No output filename given.")  if (@ARGV < 3) ;
	
	my $filename = $ARGV[0] ;
	my $cutfilename = $ARGV[1] ;
	my $ofilename = $ARGV[2] ;
	
	## Read cuts list
	my @cuts ;
	open my $fh, "<$cutfilename" or die "Error: unable to read $cutfilename : $!" ;
	my $line ;
	while (defined($line=<$fh>))
	{
		chomp $line ;
		
		$line =~ s/^\s+// ;
		next if $line =~ /^#/ ;

		#	p=0:344787
		#	p=970972:1417421
		#	p=2085377:2477139
		#	p=3472767:3856038
		#	p=4184100:4471197
		#
		if ($line =~ /^(\w+)\s*=\s*(\d+)\s*:\s*(\d+)/)
		{
			my ($start, $end) = ($2, $3) ;
			push @cuts, {
				'start_pkt' => $start,
				'end_pkt'   => $end,
			} ;
		}
	
	}
	close $fh ;	
	
	if (!@cuts)
	{
		print "Unable to find any cuts in $cutfilename\n" ;
		exit 1 ;
	}
	
	
	if ($DEBUG)
	{
		print "Cuts:\n" ;
		foreach (@cuts)
		{
			print "  pkt=$_->{start_pkt}:$_->{end_pkt}\n" ;
		}
		print "\n" ;
		
	}


	## If not specified, set debug level to 1 so we get some feedback on when the fiels are created
	$dbg_ts = 1 unless defined($dbg_ts) ;
	
	## Cut the file
	my $settings_href = {
		'debug'			=> $dbg_ts,
	} ;
	if ($split)
	{
		print "Splitting file...\n" ;
		ts_split($filename, $ofilename, \@cuts, $settings_href) ;
	}
	else
	{
		print "Cutting file...\n" ;
		ts_cut($filename, $ofilename, \@cuts, $settings_href) ;
	}
	

#=================================================================================
# CALLBACKS
#=================================================================================


#---------------------------------------------------------------------------------
#
sub error_display
{
	my ($info_href) = @_ ;
	
	if ($VERBOSE)
	{
		print STDERR "ERROR: PID $info_href->{'pidinfo'}{'pid'} $info_href->{'error'}{'str'} [$info_href->{'pidinfo'}{'pktnum'}]\n" ;
	}
}



#=================================================================================
# END
#=================================================================================
__END__

=head1 NAME

dvbt-ts-cut - Chop up a transport stream file

=head1 SYNOPSIS

dvbt-ts-cut [options] filename cutfile outfile

Options:

       -debug level         set debug level
       -verbose level       set verbosity level
       -help                brief help message
       -man                 full documentation
       -split               split file
       
=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exits.

=item B<-man>

Prints the manual page and exits.

=item B<-verbose>

Set verbosity level. Higher values show more information.

=item B<-debug>

Set debug level. Higher levels show more debugging information (only really of any interest to developers!)

=item B<-split>

Instead of deleting the cut regions, split the source file into multiple files at the cut region boundaries

=back

=head1 DESCRIPTION

Script that uses the perl Linux::DVB::DVBT::TS package to provide transport stream video file functions.
 
Runs the transport stream cut utility on a file, creating a new file (or files) with the specified regions
removed. Alternatively, using the -split option, splits the file at each start and end boundary.

The cut file format is in the form of lines containing:

	ad=[start packet]:[end packet]

Each line specifies an advert region in transport stream packet numbers. 

for example, the following defines 4 advert regions (the first region starting at the start of the video):

	ad=0:344787
	ad=970972:1417421
	ad=2085377:2477139
	ad=3472767:3856038


In -split mode, the specified B<outfile> name will be used but suffixed with a count starting at 1.  


=head1 FURTHER DETAILS

For full details of the DVBT functions, please see L<Linux::DVB::DVBT::TS>:

   perldoc Linux::DVB::DVBT::TS
 
=cut