Thanks!

I've downloaded a distribution with many modules and submodules. I'm wondering if there is a tool out there to help analyze the contents of the distribution's modules. It might, for example, give me a simple breakdown of all the different modules and what directory they are in as well as provide a listing of what functions/methods each module provided and other relevant information that might help me more quickly assess how the distribution is laid out. Does any such beast exist? Thanks.

This probably sounds like a very basic question, but I just spent the last half-hour going through the perl documentation (and even through the system sprintf man page), and couldn't find it.

Let's suppose I have an array that I don't know the length of (or even one long enough that I don't want to write out the format for each variable). Yes, I know I could build an output string by looping over the array, but I am trying to learn about sprintf. :)

Two questions:

1. Is there some way of "repeating" a format (ie. use this parameter for the next ten variables or for all remaining variables)?

2. What happens when perl "runs out" of parameters (there are more variables to print than parameters in the format)? Does it start from the beginning (probably not), repeat the last format (think some languages do this), or just throw an error?

#!/usr/bin/perl -w
use strict;

open (FILEHANDLE, '<', 'some.file') or die "Can't open some.file for r
+eading.\n";
<FILEHANDLE>;
print;

close FILEHANDLE;
[download]

Use of uninitialized value $_ in print at ./file.pl line 6, <FILEHANDL
+E> line 1.
[download]

Hello,

I am trying to make a script to automate our project build process and I run into a surprising issue:

With either of open('-|'), IPC::Open3 or IPC::Cmd::run, the child process lingers still alive after a keyboard interrupt (^C) or a timeout alarm from IPC::Cmd. The main script receives the signal and exits as expected, but the build process is still running in the background and visible in Task Manager window.

Contrast this with a call to system() which does The Right Thing: keyboard interrupt will stop the child process, and only after that will the parent process by interrupted.

Can I fix this somehow please ?

I would like to run a couple of my build commands in parallel, and ensure they always terminate before the main script, especially in case of errors, abort, interrupt, other signals like TERM, HUP, QUIT...

Is this possible please ?

Issue not present on Linux or with perl6 Proc class

I want to recognize a uSWin directory type '<JUNCTION>'

If I do a command window 'dir' this entry is not shown.

If I do a command window 'dir /a:d' the entry is shown as: 07/14/2009  12:08 AM    <JUNCTION>     Documents and Settings [C:\Users]

If I do a perl opendir and iterate, the entry, array file name, is shown as:  Documents and Settings

Using file tests -d and -l has not helped me recognize the junction. Is there a way to do so?

env:
This is perl 5, version 18, subversion 4 (v5.18.4) built for MSWin32-x64-multi-thread
uSWin7pro64

Thank you.

Hi Folks,

I am working on a Project to migrate the Legacy App in Perl to Catalyst Framework. Legacy app has its own authentication mechanism. And it uses Crypt::PBKDF2 to store the password in the database.

I want to use Catalyst::Plugin::Authentication instead of custom login mechanism for catalyst but I didn't find a way to authenticate password using Authentication Plugin

Legacy:

 
           $pbk_crypt = Crypt::PBKDF2->new(
                hash_class => 'HMACSHA2',
                hash_args => {
                        sha_size => 512,
                },
                iterations => 10000,
                salt_len => 10,
        );

        $pass = $pbk_crypt->generate('password');
 
[download]

Catalyst

__PACKAGE__->config(
    'Plugin::Authentication' => {
        default => {
            class                    => 'SimpleDB',
            user_model          => 'DB::User',
            password_type   => 'self_check',
        },
)
[download]

__PACKAGE__->add_columns(
    'password' => {
        passphrase       => 'rfc2307',
        passphrase_class => 'SaltedDigest',
        passphrase_args  => {
            algorithm   => 'SHA-512',
            salt_random => 10,
            iterations => 10000,
        },
        passphrase_check_method => 'check_password',
    },
); 
[download]

And in Controller :

 if ($username and $password) {
    if ($c->authenticate({ username => $username,
                               password => $password  } )) {
            
            $c->response->redirect($c->uri_for_action('/profile'));
            return;
        } else {
            # Set an error message
            $c->stash(error_msg => "Bad username or password.");
        }
}
[download]

Hello,

I want to connect to a MSSQL server and catch a connection error if it happens. I used to use on MySQL an eval which, as far as I remember worked fine. However, I can not catch an error if it happens now, if for example the password is wrong. This is what I am using:

print "Connecting to MSSQL terminology database... ";
eval{
 $dbh = DBI->connect("dbi:ODBC:Driver={SQL Server};Server=$SqlDatabase
+Name;UID=$SqlDatabaseUser;PWD=$SqlDatabasePassword", {PrintError => 0
+, RaiseError => 1, AutoCommit => $AutoCommit, FetchHashKeyName => 'NA
+ME_lc',}) ;
 $dbh->{'mysql_enable_utf8'} = 1;
};    
if ($@) {
 print "ERRRRRRRRRRRROR\n";
}  
[download]

Any idea what I am doing wrong?

I am new to Perl , I have an rpm package that is when installed establishes and checks for SSL connections with different algorithm .

ECDH+AES128:ECDH+AESGCM:ECDH+AES256:DH+AES:DH+AESGCM:DH+AES256:RSA+AES:RSA+AESGCM:!aNULL:!RC4:!MD5:!DSS:!3DES:!SSLv3

I want to use add the above list to the arguments passed to the instantiation of the IO:Socket:SSL object by the rpm . How do I use SSL object in the bin file for the rpm so that while installation of the rpm it checks for the list above of SSL cipherlist. If I would keep the above list in a config file of the rpm then how do I mention that list to refer for SSL in bin files of SSL object :

use IO::Socket::SSL qw(debug3); my $socket = IO::Socket::SSL->new ( PeerAddr => 'some.server.com', PeerPort => 443, Proto => 'tcp', SSL_use_cert => 1, SSL_verify_mode => SSL_VERIFY_NONE, SSL_cert_file => 'server.pem' ) or die "failed connect or ssl handshake: $!,",&IO::Socket::SSL::errs +tr,"\n";

I have a need to read a two dimensional matrix of BITS one column at a time. (For the curious, it's a TIFF file but that's not important.)

The data is stored in a binary "chunk" with parameters telling me the physical storage represents Y rows of X BYTES each. I read the chunk into a Perl array with each element containing one row of the file. As a result, "$binimage[$row]" contains a string of bits as wide as my image - one per pixel.

To transform this data into a required format I actually need to read columns of BITS in reverse order - I want row 5/bit 0, row 4/bit 0, … row 0/bit 0 … row 5/bit 1 … row 0/bit 1 … row 0/bit 7 etc., until the end of the file. (Let's not go into why!)

Snippets of code and results...
(some variables, $nextrow, $col, $subcol, are set in outer loops not shown)

for my $index (0..5) {
    my $thisrow = $nextrow - $index;
    print "processing row/column/bit $thisrow/$col/$subcol: " . substr
+($binimage[$thisrow], $col, 1) . "\n";
    printf ("Incoming byte is %d/%x/%8b/%s.  Test bitmask is %d/%x/%8b
+/%s.\n", 
    substr($binimage[$thisrow], $col, 1),substr($binimage[$thisrow], $
+col, 1),substr($binimage[$thisrow], $col, 1),
            unpack('B8',substr($binimage[$thisrow], $col, 1)), 
    2**(7-$subcol), 2**(7-$subcol), 2**(7-$subcol), unpack('B8', 
            2**(7-$subcol)));
    substr ($char, $index + 2, 1) = ((substr($binimage[$thisrow], $col
+, 1)) & 2**(7-$subcol))? "1" : "0";  # Update tracker where a "1" is 
+found!
}
[download]

processing row/column/bit 5/0/0: (unprintable square box symbol)
Incoming byte is 0/0/       0/00000000.  Test bitmask is 128/80/100000
+00/00110001.
processing row/column/bit 4/0/0: (unprintable square box symbol)
Incoming byte is 0/0/       0/00000000.  Test bitmask is 128/80/100000
+00/00110001.
processing row/column/bit 3/0/0: (unprintable square box symbol)
Incoming byte is 0/0/       0/00000000.  Test bitmask is 128/80/100000
+00/00110001.
processing row/column/bit 2/0/0: (unprintable square box symbol)
Incoming byte is 0/0/       0/00000000.  Test bitmask is 128/80/100000
+00/00110001.
processing row/column/bit 1/0/0: (unprintable square box symbol) 
Incoming byte is 0/0/       0/00000000.  Test bitmask is 128/80/100000
+00/00110001.
processing row/column/bit 0/0/0: ?
Incoming byte is 0/0/       0/10010000.  Test bitmask is 128/80/100000
+00/00110001.
...
[download]

I know from my hex editor that the first BYTE of rows 5..1 contain 0b00000000 and the first BYTE of row 0 contains 0b10010000 which matches unpack('B8', …).

I expect that my bitwise & of 0b10010000 with 0x80 should produce 0x80 which will be "TRUE" which should tell me that the first bit of the byte is set.

I expect that, similarly, bitwise & of 0b00000000 with 0x80 will be 0 indicating that the first bit of the byte is not set.

Why is this demonstrably not so?

Why does my unpack of 0x80 generate the pattern "00110001" when unpack of 0x00 from the file generates "00000000"?

The joy of Perl: How Larry Wall invented a messy programming language — and changed the face of the Web.

http://www.salon.com/1998/10/13/feature_269

Having it both ways: Larry Wall, Perl and the technology and culture of the early web

http://www.tandfonline.com/doi/full/10.1080/24701475.2018.1495810

Hello, fellow monks!

This isn't really all that cool, but I'm posting it just in case someone might be interested. I'm trying to get back to my QRP transmitter/receiver project and had just wanted to convince myself that Pi attenuators properly reduced to the expected input and output impedance. Rather than do a couple by hand, I went full nerd and wrote code to do it instead.

Essentially, the code lets you create a network of resistors (via the build_impedance() function) and pi_pads (via build_pad()) and attach them together via the named ports. Once you've got the network built, remove all named nodes you don't care about and then tell it to generate the simplified network.

The code, as it is now, should give you:

$ perl attenuator_pad.pl

**********************************************************************
+**********
10dB Attenuator terminated w/ 50 ohms
**********************************************************************
+**********
10dB Pad
   N: in_neg(1) in_pos(2) out_neg(3) out_pos(4)
   (1 3 0.05), (2 1 100), (2 4 75), (4 3 100)

50 ohm terminator
   N: in_neg(5) in_pos(6)
   (6 5 50)

10dB Pad + terminator
   N: in_neg(1) in_pos(2)
   (1 3 0.05), (2 1 100), (2 4 75), (4 3 50), (4 3 100)

Simplified network
   N: in_neg(1) in_pos(2)
   (1 2 52)


**********************************************************************
+**********
Two pads cascaded and terminated
**********************************************************************
+**********
PAD 10dB
   N: in_neg(1) in_pos(2) out_neg(3) out_pos(4)
   (1 3 0.05), (2 1 100), (2 4 75), (4 3 100)

PAD 20dB
   N: in_neg(5) in_pos(6) out_neg(7) out_pos(8)
   (5 7 0.05), (6 5 68), (6 8 270), (8 7 68)

TERM 50ohm
   N: in_neg(9) in_pos(10)
   (10 9 50)

PAD 20dB + TERM 50ohm
   N: in_neg(5) in_pos(6)
   (5 7 0.05), (6 5 68), (6 8 270), (8 7 50), (8 7 68)

PAD 10dB + PAD 20dB + TERM 50ohm
   N: in_neg(1) in_pos(2)
   (1 3 0.05), (2 1 100), (2 4 75), (3 7 0.05), (4 3 68), (4 3 100), (
+4 8 270), (8 7 50), (8 7 68)

RESULT!
   N: in_neg(1) in_pos(2)
   (1 2 52.5)
[download]

I just hardcode the commands to build the networks up front, and then let it do its thing.

Comments about my coding style are always welcome, as I'm typically the only person who ever reads my code. Questions about it are just as welcome.

...roboticus

When your only tool is a hammer, all problems look like your thumb.

I was inspired by LanX's comment here:

You know, you could use this technology to build a training site for Perl with interactive programming challenges...

And I created a set of HTML pages that can be embedded into <iframe>s and run Perl!

WebPerl Code Demo Editor

Includes documentation, I hope it's clear, let me know if you have questions!