script/lsec.pl
changeset 358 f557be43b8c7
parent 357 277de5572f99
child 499 fb005e975181
equal deleted inserted replaced
357:277de5572f99 358:f557be43b8c7
    40 require 'sys/ioctl.ph';
    40 require 'sys/ioctl.ph';
    41 
    41 
    42 use strict;
    42 use strict;
    43 use Getopt::Std;
    43 use Getopt::Std;
    44 
    44 
       
    45 my %opt;
    45 my $master_index;
    46 my $master_index;
    46 my $master_dir;
    47 my $master_dir;
    47 my $term_width;
    48 my $term_width;
    48 
    49 
    49 #------------------------------------------------------------------------------
    50 #------------------------------------------------------------------------------
    50 
    51 
    51 $term_width = &get_terminal_width;
    52 $term_width = &get_terminal_width;
    52 &get_options;
    53 &get_options;
    53 &query_master;
    54 &query_master;
    54 exit 0;
    55 exit 0;
    55 
       
    56 #------------------------------------------------------------------------------
       
    57 
       
    58 sub get_terminal_width
       
    59 {
       
    60     my $winsize;
       
    61     die "no TIOCGWINSZ " unless defined &TIOCGWINSZ;
       
    62     open(TTY, "+</dev/tty") or die "No tty: $!";
       
    63     unless (ioctl(TTY, &TIOCGWINSZ, $winsize='')) {
       
    64 	die sprintf "$0: ioctl TIOCGWINSZ (%08x: $!)\n", &TIOCGWINSZ;
       
    65     }
       
    66     (my $row, my $col, my $xpixel, my $ypixel) = unpack('S4', $winsize);
       
    67     return $col;
       
    68 }
       
    69 #------------------------------------------------------------------------------
       
    70 
       
    71 sub print_line
       
    72 {
       
    73     for (my $i = 0; $i < $term_width; $i++) {print "-";}
       
    74     print "\n";
       
    75 }
       
    76 
    56 
    77 #------------------------------------------------------------------------------
    57 #------------------------------------------------------------------------------
    78 
    58 
    79 sub query_master
    59 sub query_master
    80 {
    60 {
    89     my $dirhandle;
    69     my $dirhandle;
    90     my $entry;
    70     my $entry;
    91     my @slaves;
    71     my @slaves;
    92     my $slave;
    72     my $slave;
    93     my $abs;
    73     my $abs;
    94 	my $line;
    74     my $line;
       
    75     my $ring_cols;
       
    76     my $adv_cols;
       
    77     my $fmt;
       
    78     my $cols;
    95 
    79 
    96     unless (opendir $dirhandle, $master_dir) {
    80     unless (opendir $dirhandle, $master_dir) {
    97 		print "Failed to open directory \"$master_dir\".\n";
    81 		print "Failed to open directory \"$master_dir\".\n";
    98 		exit 1;
    82 		exit 1;
    99     }
    83     }
   130     }
   114     }
   131     closedir $dirhandle;
   115     closedir $dirhandle;
   132 
   116 
   133     @slaves = sort { $a->{'ring_position'} <=> $b->{'ring_position'} } @slaves;
   117     @slaves = sort { $a->{'ring_position'} <=> $b->{'ring_position'} } @slaves;
   134 
   118 
   135     print "EtherCAT bus listing for master $master_index:\n";
   119     $ring_cols = 0;
       
   120     $adv_cols = 0;
   136     for $slave (@slaves) {
   121     for $slave (@slaves) {
   137 	print_line if $slave->{'coupler'} eq "yes";
   122 	$cols = length $slave->{'ring_position'};
   138 	$abs = sprintf "%i", $slave->{'ring_position'};
   123 	$ring_cols = $cols if ($cols > $ring_cols);
   139 	printf(" %3s %8s  %-6s  %s\n",
   124 	$cols = length $slave->{'advanced_position'};
   140 	       $abs, $slave->{'advanced_position'},
   125 	$adv_cols = $cols if ($cols > $adv_cols);
       
   126     }
       
   127     $fmt = sprintf " %%%is  %%-%is  %%-6s  %%s\n", $ring_cols, $adv_cols;
       
   128 
       
   129     for $slave (@slaves) {
       
   130 	&print_line if $slave->{'coupler'} eq "yes" and !defined $opt{n};
       
   131 	printf($fmt, $slave->{'ring_position'}, $slave->{'advanced_position'},
   141 	       $slave->{'state'}, $slave->{'name'});
   132 	       $slave->{'state'}, $slave->{'name'});
   142     }
   133     }
   143 }
   134 }
   144 
   135 
   145 #------------------------------------------------------------------------------
   136 #------------------------------------------------------------------------------
   146 
   137 
   147 sub get_options
   138 sub get_options
   148 {
   139 {
   149     my %opt;
   140     my $optret = getopts "m:nh", \%opt;
   150     my $optret;
       
   151 
   141 
   152     $optret = getopts "m:h", \%opt;
   142     &print_usage if defined $opt{h} or $#ARGV > -1 or !$optret;
   153 
   143 
   154     &print_usage if defined $opt{'h'} or $#ARGV > -1 or !$optret;
   144     if (defined $opt{m}) {
   155 
   145 	$master_index = $opt{m};
   156     if (defined $opt{'m'}) {
       
   157 		$master_index = $opt{'m'};
       
   158     }
   146     }
   159     else {
   147     else {
   160 		$master_index = 0;
   148 	$master_index = 0;
   161     }
   149     }
   162 }
   150 }
   163 
   151 
   164 #------------------------------------------------------------------------------
   152 #------------------------------------------------------------------------------
   165 
   153 
   166 sub print_usage
   154 sub print_usage
   167 {
   155 {
   168 	my $cmd = `basename $0`;
   156     my $cmd = `basename $0`;
   169 	chomp $cmd;
   157     chomp $cmd;
   170     print "Usage: $cmd [OPTIONS]\n";
   158     print "Usage: $cmd [OPTIONS]\n";
   171     print "        -m <IDX>    Query master <IDX>.\n";
   159     print "        -m <IDX>    Query master <IDX>.\n";
       
   160     print "        -n          Display no coupler lines.\n";
   172     print "        -h          Show this help.\n";
   161     print "        -h          Show this help.\n";
   173     exit 0;
   162     exit 0;
   174 }
   163 }
   175 
   164 
   176 #------------------------------------------------------------------------------
   165 #------------------------------------------------------------------------------
       
   166 
       
   167 sub get_terminal_width
       
   168 {
       
   169     my $winsize;
       
   170     die "no TIOCGWINSZ " unless defined &TIOCGWINSZ;
       
   171     open(TTY, "+</dev/tty") or die "No tty: $!";
       
   172     unless (ioctl(TTY, &TIOCGWINSZ, $winsize='')) {
       
   173 	die sprintf "$0: ioctl TIOCGWINSZ (%08x: $!)\n", &TIOCGWINSZ;
       
   174     }
       
   175     (my $row, my $col, my $xpixel, my $ypixel) = unpack('S4', $winsize);
       
   176     return $col;
       
   177 }
       
   178 #------------------------------------------------------------------------------
       
   179 
       
   180 sub print_line
       
   181 {
       
   182     for (my $i = 0; $i < $term_width; $i++) {print "-";}
       
   183     print "\n";
       
   184 }
       
   185 
       
   186 #------------------------------------------------------------------------------