motelist-linux2

tinyos最新版

#!/usr/bin/perl -w
use strict;

my $help = <<'EOF';
usage: motelist [-l] [-c] [device_list]

  $Revision: 1.4 $

options:
  -h  display this help
  -c  compact format, not pretty but easier for parsing
  -f  specify the usb-serial file (for smote.cs)
  -dev_prefix  force the device prefix for the serial device
  -usb  display extra usb information
EOF

my %Opt = (
  compat => 0,
  usb => 0,
  usbserial => "sudo cat /proc/tty/driver/usbserial |",
  dev_prefix => "auto",
);

while (@ARGV) {
  last unless $ARGV[0] =~ /^-/;
  my $opt = shift @ARGV;
  if( $opt eq "-h" ) { print "$help\n"; exit 0; }
  elsif( $opt eq "-c" ) { $Opt{compact} = 1; }
  elsif( $opt eq "-f" ) { $Opt{usbserial} = shift @ARGV; }
  elsif( $opt eq "-dev_prefix" ) { $Opt{dev_prefix} = shift @ARGV; }
  elsif( $opt eq "-usb" ) { $Opt{usb} = 1; }
  else { print STDERR "$help\nerror, unknown command line option $opt\n"; exit 1; }
}

my $text_devs = snarf("< /proc/bus/usb/devices");
my $text_serial = snarf($Opt{usbserial});

my @usbdevs = map { {parse_usb_devices_text($_)} }
              grep { !/^\s*$/ } split /\n+(?=T:)/, $text_devs;
my %usbtree = build_usb_tree( @usbdevs );
my %usbserialtree = build_usbserial_tree( $text_serial );
for my $tts ( values %usbserialtree ) {
  $usbtree{$tts->{path}}{usbserial} = $tts if defined $tts->{path};
}

my @motes = grep { ($_->{Vendor}||"") =~ /^(0403)$/
                   && ($_->{ProdID}||"") =~ /^(6001)$/ }
	    values %usbtree;

if( @motes == 0 ) {
  print "No devices found.\n";
  exit 0;
}

if( !$Opt{compact} ) {
  if( $Opt{usb} ) {
    print << "EOF" unless $Opt{compact};
Bus Dev USB Path                 Reference  Device           Description
--- --- ------------------------ ---------- ---------------- -------------------------------------
EOF
  } else {
    print << "EOF" unless $Opt{compact};
Reference  Device           Description
---------- ---------------- ---------------------------------------------
EOF
  }
}

for my $dev (sort { cmp_usbdev($a,$b) } @motes) {

  #  For each device, force to use dev_prefix if it's set and not "auto".
  #  Otherwise, check a set of standard prefixes, and commit to the first one
  #  that actually exists.
  my $serial = " (none)";
  if( exists $dev->{usbserial} ) {
    if( $Opt{dev_prefix} eq "auto" ) {
      for my $prefix ("/dev/usb/tts/", "/dev/ttyUSB") {
	my $file = $prefix . $dev->{usbserial}{tts};
	if( -e $file ) { $serial = $file; last; }
      }
    } else {
      $serial = $Opt{dev_prefix} . $dev->{usbserial}{tts};
    }
  }

  my $desc = join( " ", $dev->{Manufacturer}||"", $dev->{Product}||"" ) || " (none)";
  my @output = ( $dev->{SerialNumber}||" (none)", $serial, $desc );
  @output = ( $dev->{nbus}, $dev->{ndev}, $dev->{usbpath}, @output ) if $Opt{usb};
  if( $Opt{compact} ) {
    print join(",",@output) . "\n";
  } else {
    printf( ($Opt{usb}?"%3d %3d %-24s ":"")."%-10s %-16s %s\n", @output );
  }
}

sub build_usb_tree {
  my @devs = @_;
  my %tree = ();
  for my $dev (sort { $a->{Lev} <=> $b->{Lev} } @devs) {
    my ($bus,$lev,$prnt) = ( $dev->{Bus}+0, $dev->{Lev}+0, $dev->{Prnt}+0 );
    my $devnum = $dev->{"Dev#"}+0;
    $dev->{nbus} = $bus;
    $dev->{ndev} = $devnum;
    $tree{"bus$bus"} = {} unless exists $tree{"bus$bus"};
    $tree{"bus$bus"}{"dev$devnum"} = $dev;
    if( $lev == 0 ) {
      $dev->{usbpath} = "usb-$dev->{SerialNumber}";
    } else {
      my $sep = ($lev==1) ? "-" : ".";
      $dev->{parent} = $tree{"bus$bus"}{"dev$prnt"};
      $dev->{usbpath} = $dev->{parent}{usbpath} . $sep . ($dev->{Port}+1);
    }
    $tree{$dev->{usbpath}} = $dev;
  }
  return %tree;
}

sub cmp_usbdev {
  my ($a,$b) = @_;
  if( defined $a->{usbserial} ) {
    if( defined $b->{usbserial} ) {
      return $a->{usbserial}{tts} <=> $b->{usbserial}{tts};
    }
    return -1;
  }
  return 1 if defined $b->{usbserial};
  return ($a->{usbpath}||"") cmp ($b->{usbpath}||"");
}

sub parse_usb_devices_text {
  my $text = shift;
  $text =~ s/^\S+\s*//gm;
  return ($text =~ m/([^\s=]+)=\s*(.*?\S)\s*(?=[^\s=]+=|$)/mg);
}

sub build_usbserial_tree {
  my $text = shift;
  my %tree = ();
  while( $text =~ /^([^:]+):(.*)/mg ) {
    my ($tts,$params) = ($1,$2);
    $tree{$tts} = { tts => $tts };
    while ($params =~ m/\s+([^:]+):(?:"([^"]*)"|(\S+))/g) {
      $tree{$tts}{$1} = $2||$3;
    }
  }
  return %tree;
}

sub snarf {
  open my $fh, $_[0] or die "ERROR, could not open \"$_[0]\", $!\n";
  my $text = do{local $/;<$fh>};
  close $fh;
  return $text;
}