pashanoid has asked for the wisdom of the Perl Monks concerning the following question:

Dear Bretheren, I'm almost the serial opener exraordinare by now. Except, I'm getting a strange error message from my two serial ports on Linux which I'm trying to 1. supress 2. not use those ports. How do I do that?. The errors I'm getting are: (I have ttyS0, ttyS1, ttyS2, ttyS3 - the later two complaint)

can't getattr: Input/output error at registry.pl line 36
can't getattr: Input/output error at registry.pl line 36
ports opening are: /dev/ttyS1 /dev/ttyS0

[download]

Code

eval "use Device::SerialPort; 1" or die $@;
my $directory = '/dev';
opendir (DIR, $directory) or die $!;
while (my $file = readdir(DIR)) {
  push (@ports, "$directory/$file") if ($file =~ /ttyS/g);
  push (@ports, "$directory/$file") if ($file =~ /ttyUSB/g);
}
 closedir(DIR);
foreach my $port (@ports){
    $PortObj = new Device::SerialPort($port, 1) or next; 
    $PortObj->close; 
    push(@ok_ports, $port);
    sleep (1);
}
print "ports opening are: @ok_ports \n";

[download]

Replies are listed 'Best First'.
Re: Supressing error messages on serial port open in Linux
by Eliya (Vicar) on Sep 02, 2011 at 12:25 UTC

    The code that produces the unwanted message is in SerialPort.pm: 

        # get the current attributes
    $ok = $self->{TERMIOS}->getattr($self->{FD});

    unless ( $ok ) {
        carp "can't getattr: $!";
        undef $self;
        return undef;
    }

    [download]

    So either comment out the carp ... line, or (if you don't want to mess with the module's source) overwrite the carp routine that has been imported into the Device::SerialPort namespace.  I.e., in your code, before you call the constructor, say 

    {
  no warnings 'redefine';
  sub Device::SerialPort::carp { };  # no-op
}

...
    $PortObj = new Device::SerialPort($port, 1) or next;

    [download]

    The latter is somewhat of a dirty hack, because it of course also disables any carp messages that you might actually want to see...

[reply]
[d/l]
[select]
      {
  no warnings 'redefine';
  sub Device::SerialPort::carp { };  # no-op
}

      [download]

      Please don't do it that way. Always localize the overwriting of subroutines:

      {
  no warnings 'redefine';
  local *Device::SerialPort::carp = sub { 
    # no-op
  };
  $PortObj = new Device::SerialPort($port, 1) or next; 
}
# carp works again

      [download]
[reply]
[d/l]
[select]
        Works great! Error messages are goner! Thank you!
[reply]

        Ooops, now I'm getting this error:

        Name "Device::SerialPort::carp" used only once: possible typo at dial.
+pl line 58.

        [download]
        This is my code: 
        eval "use Device::SerialPort; 1" or die $@;
   my $directory = '/dev';
   opendir (DIR, $directory) or die $!;
   while (my $file = readdir(DIR)) {
        #print "$file\n";
        push (@ports, "$directory/$file") if ($file =~ /ttyS/g);
        push (@ports, "$directory/$file") if ($file =~ /ttyUSB/g);
   }
       closedir(DIR);
       foreach my $port (@ports){
          no warnings 'redefine';
          local *Device::SerialPort::carp = sub {};
          $PortObj = new Device::SerialPort($port, 1) or next;
          $PortObj->close;
          push(@ok_ports, $port);
          sleep (1);
    };

        [download]
[reply]
[d/l]
[select]
Re: Supressing error messages on serial port open in Linux
by Khen1950fx (Canon) on Sep 02, 2011 at 16:49 UTC
    I'm on Linux, but on my system there is no ttyS or ttyUSB. I tried your script and got the same warnings; however, if you use /dev/tty1, /dev/tty2, etc., then everything comes together. For example, 
    #!/usr/bin/perl -slw

use strict;
$|=1;

BEGIN {
    eval "use Device::SerialPort qw( :PARAM ); 1;"; 
    die "$@\n" if ($@);
}

my $port = $ARGV;
foreach $port(@ARGV) {
    my $ob = Device::SerialPort->new($port, 1)
    or die "Could not open $port: $!";
    sleep 1;
    print "$port is open";
    undef $ob;
}

    [download]
    I used undef $ob rather than $ob->close. It just worked better.
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom