in reply to Using Win32::SerialPort in a module

During Global Destruction, object destructors run in random order. This means sometimes an inner part of an object get destroyed before the thing that owns it. The solution is to clean more things up yourself before global destruction begins. In this case, I think probably the Win32::SerialPort module ought to check for global destruction and skip closing the handle.

But, you can solve this in your module, too. When you're writing a module affected by a global-destruction problem, add an END block that frees up any resources that you allocated during the setup of the module. END blocks run before global destruction, in the reverse order that modules were loaded.

Putting this at the end of Serial.pm should do the trick: 

END {
  undef $port; # free it before global destruction runs
}

[download]

Replies are listed 'Best First'.
Re^2: Using Win32::SerialPort in a module
by jmClifford (Beadle) on Sep 06, 2024 at 09:39 UTC

    Hi. Thanks for the help. I am rid of the warning. In the same way as before, the next 3 sections give my module's code, my test routine and console output 

     
--------------------------------------------------------
Serial.pm

use Win32::SerialPort;
my $port;

package Serial;

# The following 2 lines I suspect are the lines that make a package in
+to a module
# Also, they seem to make it a member of a class Exporter.
require Exporter;
@ISA = qw( Exporter );  # This module "is a" Exporter class member

#Now declare what we permit to be visible within the module.
@EXPORT = qw( &Serial_Init &Serial_TrxRcv &Serial_Close);

use Time::HiRes qw(usleep);

# ############ subroutine Serial_Init ################################
+###################

sub Serial_Init {

    my $port_name = 'COM5';
    #my $config_file = 'setup.cfg';    # use this to configure from th
+e file

    $port = new Win32::SerialPort( $port_name ) 
                    ||  die "Unable to open: $^E\n";    # $^E EXTENDED
+_OS_ERROR
                                             
    #$port = new Win32::SerialPort($port_name, $config_file) || die "U
+nable to open: $^E\n";

    $port->handshake('none');     # none dtr rts xoff
    $port->baudrate(38400);       # 19200 57600 1200 9600 115200 4800 
+600 2400 300 38400
    $port->parity('none');        # space none odd even mark
    #$port->parity_enable(1);       #      for any parity except "none
+"
    $port->databits(8);           # options 7 8
    $port->stopbits(1);           # options 2 1
    $port->buffers(256, 256);
    $port->read_interval(0);      #RI
    $port->read_const_time(20);   #RC
    $port->write_char_time(1);    #WM
    $port->write_const_time(100); #WC

    print "Write settings;  ";

    $port->write_settings || undef $port;
    # A report out to the console
    my $baud   = $port->baudrate;
    my $parity = $port->parity;
    my $data   = $port->databits;
    my $stop   = $port->stopbits;
    my $hshake = $port->handshake;

    print "B = $baud, D = $data, S = $stop, P = $parity, H = $hshake\n
+\n";
            
    # use the below to save the current configuration
    # if ( $port ) { $port->save('setup.cfg') ; print "Serial Port OK 
+\n" };

    # pack: used for assembling binary stuff
    # my $status = pack('H2' * 6, 'ca', '00', '01', '00', '00', 'fe');

    #$port->write("ati\x0D\x0A");      # carriage return and line feed
+:  no different
    #$port->write("ate0"."\r");    

    #print "test 01\n";
    #usleep 0;
    #print "test 02\n";
    
}

# ############## subroutine Serial_TrxRcv ###############
sub Serial_TrxRcv {
    
    my ($cmd) = @_;
    my $response = "";
    
    #print "cmd; $cmd\n";
    
    $port->write($cmd."\r");
    my $loop = 1;
    while( $loop ) {
        usleep(200000);         # 0.2 of a second
        my $partial_resp;
        $partial_resp = $port->input;
        chomp $partial_resp;    
        $response = $response.$partial_resp;
       
        # print $response;
        
        #my $responseHex = unpack ('H*', $response);
        #print $responseHex."\n";
         
        my $last = substr ( $response, -1 );    # get the last charact
+er
        if ($last eq ">") { $loop = 0; 
                             $response = substr( $response, 0, -1);   
+  # -1 removes the ">";
                             chomp $response;
                             next; 
                          }
        print ".";
    }
    
    return $response;    
}

# ############## subroutine Serial_Close #################
sub Serial_Close {
    $port->close();
}

# ############## Execute when module exits  ##############
END {
  undef $port; # free it before global destruction runs
}

1;

------------------------------------------------------------

    [download]
    ------------------------------------------------------------
test_Serialpm.pl

#!usr/bin/perl

use strict;
use warnings;


use lib '.';      # The Serial.pm is in the current folder

use Serial;       # use a "1 off type of macro expansion" of the Seria
+l module
#use Serial 'Serial_Init';

Serial_Init();    # Initialise the interface

my $response = Serial_TrxRcv("at dp");   # Transmit "AT Diplay Protoco
+l" and get a response

print "Response is; $response\n";
print "Response num char; ".length($response)."\n";

#Serial_Close();    # This approached removed the closing error wrt $p
+ort
                    # now is not required due to END code added to mod
+ule

----------------------------------------------------------------

    [download]
     
-----------------------------------------------------------------
Console output for a simple test;

Write settings;  B = 38400, D = 8, S = 1, P = none, H = none

Response is; at dp
AUTO, SAE J1850 PWM

Response num char; 27
-----------------------------------------------------------------

    [download]

    The approach of another subroutine "Serial_Close" seems like a work around, but similar to Corion's suggestion.

    Other key changes with my initial presentation are removal (from Serial.pm) of warnings, strict and "#!usr/bin/perl" lines. Also the "my" was removed from the @ISA and @EXPORT global arrays. This permitted shorter names in test_Serialpm.pl.

    Regards JC.....

[reply]
[d/l]
[select]
      
# The following 2 lines I suspect are the lines that make a package in
+to a module
# Also, they seem to make it a member of a class Exporter.
require Exporter;
@ISA = qw( Exporter );  # This module "is a" Exporter class member

      [download]

      That's not what I suggested you use.

      Please use

      require Exporter;
Exporter->import('import');

      [download]

      There is no need to employ inheritance here, and the usage is what Exporter recommends too.

      Also, why did you remove use strict; use warnings; from your code? These allow Perl to spot errors in your code and tell you about it.

[reply]
[d/l]
[select]
      Other key changes with my initial presentation are removal (from Serial.pm) of warnings, strict and "#!usr/bin/perl" lines.

      You don't need the #! line if your file isn't going to be executed, so it is (almost) never needed in a module. However, strict and warnings are there to help you. I would very strongly recommend that you reinstate them.

      🦛

[reply]
[d/l]
      Also the "my" was removed from the @ISA and @EXPORT global arrays

      Oh, I missed in your original code that you used 'my' when it should have been 'our'. The 'our' keyword declares a global package variable1, where 'my' declares a lexical variable that can't be seen by Exporter afterward.

      As Corion pointed out, you should put back strict and warnings (which will still work once you declare the variables with 'our'), and use Exporter 'import'; is cleaner than messing with our @ISA=('Exporter').


      (1) Actually, 'our' adds a global package variable into your lexical scope, which is a little bit different from "declaring a global".

[reply]
[d/l]
[select]
        (1) Actually, 'our' adds a global package variable into your lexical scope, which is a little bit different from "declaring a global".

        Technically, it creates an alias to a package variable, so 'our $foo' is an alias for '$Package::foo'. The purpose is so that you can say '$foo = 10' under 'use strict' instead of having to say '$Package::foo = 10'.

[reply]

In Section Seekers of Perl Wisdom