1 #!/usr/bin/perl

     2 

     3 #------------------------------------------------------------------------------

     4 #

     5 #  e c _ l i s t . p l

     6 #

     7 #  Userspace tool for listing EtherCAT slaves.

     8 #

     9 #  $Id: slave.c 340 2006-04-11 10:17:30Z fp $

    10 #

    11 #------------------------------------------------------------------------------

    12 

    13 use strict;

    14 use Getopt::Std;

    15 

    16 my $master_index;

    17 my $master_dir;

    18 

    19 #------------------------------------------------------------------------------

    20 

    21 &get_options;

    22 &query_master;

    23 exit 0;

    24 

    25 #------------------------------------------------------------------------------

    26 

    27 sub query_master

    28 {

    29     $master_dir = "/sys/ethercat" . $master_index;

    30     &query_slaves;

    31 }

    32 

    33 #------------------------------------------------------------------------------

    34 

    35 sub query_slaves

    36 {

    37     my $dirhandle;

    38     my $slave_dir;

    39     my $entry;

    40     my $slave_index;

    41     my $file_name;

    42     my $vendor_name;

    43     my @slaves;

    44     my $slave;

    45 

    46     unless (opendir $dirhandle, $master_dir) {

    47 	print "Failed to open directory \"$master_dir\".\n";

    48 	exit 1;

    49     }

    50 

    51     while ($entry = readdir $dirhandle) {

    52         next unless $entry =~ /^slave(\d+)$/;

    53 	$slave_dir = $master_dir . "/" . $entry;

    54 

    55 	$slave = {};

    56 	$slave->{'ring_position'} =

    57 	    &read_integer("$slave_dir/ring_position");

    58 	$slave->{'station_address'} =

    59 	    &read_integer("$slave_dir/station_address");

    60 	$slave->{'vendor_name'} =

    61 	    &read_string("$slave_dir/vendor_name");

    62 	$slave->{'product_name'} =

    63 	    &read_string("$slave_dir/product_name");

    64 	$slave->{'product_desc'} =

    65 	    &read_string("$slave_dir/product_desc");

    66 	$slave->{'type'} =

    67 	    &read_string("$slave_dir/type");

    68 

    69 	push @slaves, $slave;

    70     }

    71     closedir $dirhandle;

    72 

    73     @slaves = sort { $a->{'ring_position'} <=> $b->{'ring_position'} } @slaves;

    74 

    75     my $coupler_index = -1;

    76     my $slave_index = 0;

    77     my $abs;

    78     my $rel;

    79     print "EtherCAT bus listing for master $master_index:\n";

    80     for $slave (@slaves) {

    81 	if ($slave->{'type'} eq "coupler") {

    82 	    print "--------------------------------------------------------\n";

    83 	    $coupler_index++;

    84 	    $slave_index = 0;

    85 	}

    86 

    87 	$abs = sprintf "%i", $slave->{'ring_position'};

    88 	$rel = sprintf "%i:%i", $coupler_index, $slave_index;

    89 	printf("%4s %6s   %-15s %-15s %-15s\n", $abs, $rel,

    90 	       $slave->{'vendor_name'}, $slave->{'product_name'},

    91 	       $slave->{'product_desc'});

    92 

    93 	if ($slave->{'type'} eq "coupler") {

    94 	    print "--------------------------------------------------------\n";

    95 	}

    96 

    97 	$slave_index++;

    98     }

    99     print "--------------------------------------------------------\n";

   100 }

   101 

   102 #------------------------------------------------------------------------------

   103 

   104 sub read_string

   105 {

   106     (my $file_name) = @_;

   107     my $data;

   108 

   109     $data = `cat $file_name 2>/dev/null`;

   110     if ($?) {

   111 	print "ERROR: Unable to read string $file_name!\n";

   112 	exit 1;

   113     }

   114 

   115     chomp $data;

   116     return $data;

   117 }

   118 

   119 #------------------------------------------------------------------------------

   120 

   121 sub read_integer

   122 {

   123     (my $file_name) = @_;

   124 

   125     if (`cat $file_name 2>/dev/null` !~ /^(\d+)$/) {

   126 	print "ERROR: Unable to read integer $file_name!\n";

   127 	exit 1;

   128     }

   129 

   130     return int $1;

   131 }

   132 

   133 #------------------------------------------------------------------------------

   134 

   135 sub get_options

   136 {

   137     my %opt;

   138     my $optret;

   139 

   140     $optret = getopts "m:h", \%opt;

   141 

   142     &print_usage if defined $opt{'h'} or $#ARGV > -1;

   143 

   144     if (defined $opt{'m'}) {

   145 	$master_index = $opt{'m'};

   146     }

   147     else {

   148 	$master_index = 0;

   149     }

   150 }

   151 

   152 #------------------------------------------------------------------------------

   153 

   154 sub print_usage

   155 {

   156     print "Usage: ec_list [OPTIONS]\n";

   157     print "        -m <IDX>    Query master IDX.\n";

   158     print "        -h          Show this help.\n";

   159     exit 0;

   160 }

   161 

   162 #------------------------------------------------------------------------------