File dvsource-firewire-next.pl of Package dvswitch-git

#! /usr/bin/perl -w
# dvsource-firewire_jw.pl -- a rewrite of the firewire grabber.
# The original dvsource-firewire suffers from the following issues:
# if we have both /dev/fw0 and /dev/fw1, it takes the first one, even if the 
#  other one is only functional.
#
# (C) 2012, jw@suse.de, distribute under GPL-2.0+ or ask.
# 2012-10-14 -- V0.1 initial draft.
# 2012-10-16 -- V0.2 skip empty units
#
#############
## Requires: dvgrab
#
# Improvement: 
# check all cat /sys/bus/firewire/devices/*/guid
# and ignore those with 0x0000000000000000
# and ignore those with empty /sys/bus/firewire/devices/*/units

use strict;
use Data::Dumper;
use File::stat;
use File::Glob;
use Getopt::Long qw(:config no_ignore_case);
use Pod::Usage;

my $version = '0.2';
my $a_chan = undef;
my $a_name = undef;
my $retry_connect = 0;
my $host = undef;
my $port = undef;
my $tally = undef;
my $verbose = 0;
my $help = undef;
my $dvgrab = 'dvgrab';
my $dvgrab_opts = '-noavc';
my $ignore_missing_units = 0;

sub get_ps();

pod2usage(-verbose => 1, -msg => qq{
dvsource-firewire_jw.pl V$version

$0 [OPTIONS]

Start a dvsource on the next available firewire device. Dead devices (without guid) are skipped,
devices that are in use (guid appears in /proc/*/cmdline) are also skipped.
Returns nonzero if no usable devices were found.

Valid options are:
 -v	Print more information at startup.

-R, --retry	
 	Keep retrying to connect, in case DVswitch is not yet listening.

-h, --host=HOST
 -p, --port=PORT
 	Specify the network address on which DVswitch is listening.  The
	host address may be specified by name or as an IPv4 or IPv6 literal.

-t, --tally
 	Print notices of activation and deactivation in the  mixer,  for
	use with a tally light.  These will take the form "TALLY: on" or
	"TALLY: off".

}) if $help;

opendir DIR, "/sys/bus/firewire/devices/" or die "no /sys/bus/firewire/devices/: $!";
my @fw = grep { !/^\./ } readdir DIR;
closedir DIR;
my %fw = map { $_ => { guid => undef } } @fw;
my @good;
for my $fw (sort @fw)
  {
    if (open IN, '<', "/sys/bus/firewire/devices/$fw/guid")
      {
        my $guid = <IN> || '';
        chomp $guid;
        $fw{$fw}{guid} = $guid;
        close IN;

if (open IN, '<', "/sys/bus/firewire/devices/$fw/units")
          {
	    # expect 0x00a02d:0x010001
            my $units = <IN> || '';
            chomp $units;
            $fw{$fw}{units} = $units;
            close IN;
	    $units = '0x0:0x0' if $ignore_missing_units;

if (($guid =~ m{^0x[\da-f]*[1-9a-f][\da-f]*$}) and
	        ($units =~ m{^0x[\da-f]+:0x[\da-f]+$}))
	      {
		push @good, [$fw, $guid];
		print STDERR "Usable devices: /dev/$fw guid=$guid\n" if $verbose > 1;
	      }
	  }
      }
  }

my $all_commands = join("\n", get_ps());
while (@good && $all_commands =~ m{\b$good[0][1]\b})
  {
    print STDERR "already in use: /dev/$good[0][0] guid=$good[0][1]\n" if $verbose > 1;
    $fw{$good[0][0]}{in_use} = 1;
    shift @good;
  }
die "No usable devices: " . Dumper \%fw unless scalar @good;
$dvgrab_opts .= " -g '$good[0][1]'";
	
my $cmd = 'dvsource-command';
$cmd .= " --tally" if $tally;
$cmd .= " --verbose" if $verbose;
$cmd .= ' --retry' if $retry_connect;
$cmd .= " --port=$port" if defined $port;
$cmd .= " --host=$host" if defined $host;

print STDERR "+ $cmd '$dvgrab $dvgrab_opts -'\n" if $verbose;
system "$cmd '$dvgrab $dvgrab_opts -'" and die "failed to run '$cmd \"$dvgrab -noavc $dvgrab_opts -\"'\n";
exit 0;

#####################################################
sub get_ps()
{
  my @r = ();
  opendir DIR, "/proc/" or return @r;
  my @pids = grep { /^\d+$/ } readdir DIR;
  closedir DIR;

for my $pid (@pids)
    {
      if (open IN, "<", "/proc/$pid/cmdline")
        {
          my $cmdline = <IN> || '';
          chomp $cmdline;
          push @r, $cmdline;
        }
    }
  return @r;
}