view release on metacpan or  search on metacpan

PortScanner.pm  view on Meta::CPAN

}

sub num_found_devices($) {
    my $serial = shift;

    return defined( $serial->{FOUND_DEVICE} ) ? scalar( @{ $serial->{FOUND_DEVICE} } ) : 0;
}

sub found_devices($) {
    my $serial = shift;

    return defined( $serial->{FOUND_DEVICE} ) ? @{ $serial->{FOUND_DEVICE} } : ();
}

sub connection($) {
    my $serial = shift;

    return $serial->{CONNECTION};
}

sub available_com_ports(;@) {
    my $serial = shift;
    my $com_port;
    my $com_device_name;
    my @ports;
    my $PortObj;

    for ( $com_port = 1 ; $com_port <= $serial->{MAX_PORT} ; $com_port++ ) {

        $PortObj = $serial->_get_com_connection($com_port);

        if ($PortObj) {
            push( @ports, $com_port );
            $PortObj->close;
            undef $PortObj;
        }

        undef $PortObj;    # Just extra safe measure
    }

    return @ports;
}

sub scan_ports(;@) {
    my $serial = shift;
    my $com_port;
    my $com_device_name;
    my $PortObj;
    my $feedback;
    my $count_in;
    my $send;
    my $baud;
    my $parm;
    my $value;
    my $key;
    my ( $databits, $parity, $stopbits, $handshake );
    my $setting;
    my $device;
    my $config = $serial->{SEARCH_PARM} = {};
    my $parm_found;
    my $read_iterations;
    my $iterations;
    my $chars = 0;
    my ( $bytes_read, $data_read );
    my $waited;

    $serial->_add_scan_log("Scan Ports Request");
    $serial->_add_scan_log("==================");

    # Parse parameters

    while ( $parm = uc shift ) {
        $value      = shift;
        $parm_found = 0;

        $key = "BAUD";
        if ( $parm eq $key ) {
            if ( ref $value eq "ARRAY" ) {
                @{ $config->{$key} } = @{$value};
            }
            elsif ( ref $value eq "" ) {
                @{ $config->{$key} } = ($value);
            }
            else {
                croak "ERROR: (scan_ports): $key value must be either a SCALAR or ARRAY REF\n";
            }

            foreach ( @{ $config->{$key} } ) {
                if ( !/^\d+$/ ) {
                    croak "ERROR: (scan_ports): BAUD rate \$_\" not valid\n";
                }
            }
            $parm_found++;
        }

        $key = "COM";
        if ( $parm eq $key ) {

            if ( ref $value eq "ARRAY" ) {
                @{ $config->{$key} } = map { s/^COM(\d+)/$1/; $_; } @{$value};
            }
            elsif ( ref $value eq "" ) {
                @{ $config->{$key} } = map { s/^COM(\d+)/$1/; $_; } ($value);
            }
            else {
                croak "ERROR: (scan_ports): $key value must be either a SCALAR or ARRAY REF\n";
            }

            foreach ( @{ $config->{$key} } ) {
                if ( !( /^\d+$/ && $_ > 0 && $_ <= 50 ) ) {
                    croak "ERROR: (scan_ports): COM port \"$_\" not valid\n";
                }
            }
            $parm_found++;
        }

        $key = "SETTING";
        if ( $parm eq $key ) {
            foreach ( ref $value eq "ARRAY" ? @{$value} : ($value) ) {

                $value = uc $value;
                if (/^([5678])([NEO])([12])([NRX])?$/) {

PortScanner.pm  view on Meta::CPAN

        }

        $key = "TEST_STRING";
        if ( $parm eq $key ) {
            if ( ref $value eq "" ) {
                $config->{$key} = $value;
            }
            else {
                croak "ERROR: (scan_ports): $key value must be a SCALAR\n";
            }
            $parm_found++;
        }

        $key = "VALID_REPLY_RE";
        if ( $parm eq $key ) {
            if ( ref $value eq "" ) {
                $config->{$key} = qr/$value/;
            }
            else {
                croak "ERROR: (scan_ports): $key value must be a SCALAR\n";
            }
            $parm_found++;
        }

        if ( !$parm_found ) {
            croak "ERROR: (scan_ports): Parameter \"$parm\" is not valid for scan port\n";
        }

    }

    if ( !exists( $config->{TEST_STRING} ) || !exists( $config->{VALID_REPLY_RE} ) ) {
        croak "ERROR: (scan_ports): TEST_STRING and VALID_REPLY must be provided to scan_ports\n";
    }

    # Handle Default when certain parms were not provided

    if ( !exists( $config->{BAUD} ) ) {
        @{ $config->{BAUD} } = (qw/1200 2400 4800 9600 19200 38400 57600 115200/);
    }

    if ( !exists( $config->{COM} ) ) {
        @{ $config->{COM} } = ( 1 .. $serial->{MAX_PORT} );
    }

    if ( !exists( $config->{SETTING} ) ) {

        # Default for setting when not provided

        push(
            @{ $config->{SETTING} },
            {
                DATABITS  => 8,
                PARITY    => "none",
                STOPBITS  => 1,
                HANDSHAKE => "none",
                SETTING   => "8N1"
            }
        );
    }

    # Figure the number of read iterations is needed

    if ( exists( $config->{MAX_WAIT} ) ) {
        $serial->_add_scan_log("(Max Wait set at $config->{MAX_WAIT})");
        $read_iterations = int( $config->{MAX_WAIT} / ( $serial->{READ_CONST_TIME} / 1000 ) );
        $read_iterations = 1 if ( $read_iterations < 1 );

    }
    else {

        # Must always go though the loop once
        $read_iterations = 1;
    }

    # Begin Scan of Com Ports

  PORT:
    foreach $com_port ( sort { $a <=> $b } @{ $config->{COM} } ) {

        $com_device_name = $serial->_get_com_device_name($com_port);
        $serial->_add_scan_log("Scan Port COM${com_port} @ $com_device_name");

        # Baud rates are attempted from highest to lowest because some
        # might be using a virtual COM via USB and it "looks" nicer to
        # see the faster buad rate (virtual USB com ports dont care about baud rates or settings)

      BAUD:
        foreach $baud ( sort { $b <=> $a } @{ $config->{BAUD} } ) {
            $serial->_add_scan_log("   Checking with baudrate of $baud");

          SETTING:
            foreach $setting ( sort { $b <=> $a } @{ $config->{SETTING} } ) {
                $serial->_add_scan_log("      Checking with setting of $setting->{SETTING}");
                $PortObj = $serial->_get_com_connection($com_port);

                if ($PortObj) {

                    #$PortObj->user_msg("ON");
                    if ( !$PortObj->baudrate($baud) ) {

                        # If *::SerialPort says this baudrate is invalid then go to the next one
                        # (eg. Dont keep scanning it at other settings)
                        $serial->_add_scan_log("      Warning: Baud rate of $baud is not valid for this com port - skipping to next one");
                        next BAUD;
                    }

                    $PortObj->databits( $setting->{DATABITS} );
                    $PortObj->parity( $setting->{PARITY} );
                    $PortObj->stopbits( $setting->{STOPBITS} );
                    $PortObj->handshake( $setting->{HANDSHAKE} );

                    # Just kept this based on *::SerialPort examples
                    $PortObj->buffers( 4096, 4096 );

                    if ( $PortObj->write_settings ) {

                        # Ok, port is available, now is it our device?

                        $PortObj->write( $config->{TEST_STRING} );

                        $serial->_add_scan_log("         Sending test string \"$config->{TEST_STRING}\"");

                        # Due to a bug or something, this locks up
                        # on Windows sometimes

                        $PortObj->read_char_time( $serial->{READ_CHAR_TIME} );
                        $PortObj->read_const_time( $serial->{READ_CONST_TIME} );

                        $feedback = "";

                        # Calculated outside loops for performance

                        $waited = 0;

                        # Wait a maximum amount of time to get expected output but move on
                        # if we dont get it in the alloted amount of time.  This also protects
                        # us from a device just spewing data.

                        for ( $iterations = 1 ; $iterations <= $read_iterations ; $iterations++ ) {

                            # Read from the port
                            ( $bytes_read, $data_read ) = $PortObj->read(255);    # docs say this must be 255 always
                            $waited += $serial->{READ_CONST_TIME};

                            if ( $bytes_read > 0 ) {
                                $feedback .= $data_read;

                                # This is what makes this loop faster
                                last if ( $feedback =~ /$config->{VALID_REPLY_RE}/ );
                            }
                        }

                        $feedback =~ s/\015?\012$//;

                        $serial->_add_scan_log( sprintf( "         Received back from device \"%s\" (Waited %.2f secs)", $feedback, $waited / 1000 ) );

                        if ( $feedback =~ /$config->{VALID_REPLY_RE}/ ) {

                            # Get a new "device" and store all the properties in it

                            $device = Hardware::PortScanner::Device->new_device($serial);

                            $device->com_port("COM${com_port}");
                            $device->baudrate($baud);
                            $device->databits( $setting->{DATABITS} );
                            $device->parity( $setting->{PARITY} );
                            $device->stopbits( $setting->{STOPBITS} );
                            $device->handshake( $setting->{HANDSHAKE} );
                            $device->port_name($com_device_name);
                            $device->setting( $setting->{SETTING} );
                            $device->{VALID_REPLY} = $feedback;
                            $device->{TEST_STRING} = $config->{TEST_STRING};
                            $device->{MAX_WAIT}    = $config->{MAX_WAIT} if ( exists( $config->{MAX_WAIT} ) );

                            push( @{ $serial->{FOUND_DEVICE} }, $device );

                            # Since this device was found, skip scanning on this port anymore

                            $serial->_add_scan_log("         Matched valid reply RE so returning");
                            last BAUD;
                        }
                    }

                    $PortObj->close;
                    undef $PortObj;

                }    # PortObj
                else {
                    $serial->_add_scan_log("   Com Port $com_port appears not to be available - skipping to next port");
                    next PORT;
                }
            }    # Setting
        }    # Baud
    }    # Com Port

}

sub connect_to_device(@) {
    my $serial = shift;