A new teammate demonstrated something like the following at the beginning of a script.

use strict;
use warnings;

our @arr = <ABC DEF GHI>;
[download]

I'm going to go over when to use our but I'm struggling with what to say about using glob like this. It works as long as there isn't a metacharacter other than curly braces. He has been told already about the use of qw() to create an array like this but I suspect he copied this from somewhere. In the perldocs for glob I found this:

If non-empty braces are the only wildcard characters used in the glob, no filenames are matched, but potentially many strings are returned. For example, this produces nine strings, one for each pairing of fruits and colors: 1.    my @many = glob "{apple,tomato,cherry}={green,yellow,red}";

I created the following to try to show why it's a bad idea.

use strict;
use warnings;
use Data::Dumper;

my @arr1 = <     abc def ghi f* >;
my @arr2 = qw(   abc def ghi f* );
my @arr3 = glob('abc def ghi z*');

print Dumper(\@arr1);
print Dumper(\@arr2);
print Dumper(\@arr3);

__DATA__
$VAR1 = [
          'abc',
          'def',
          'ghi',
          'file1.txt',
          'file2.txt'
        ];
$VAR1 = [
          'abc',
          'def',
          'ghi',
          'f*'
        ];
$VAR1 = [
          'abc',
          'def',
          'ghi'
        ];
[download]

perl -MO=Deparse glob_to_array.pl produces the following.

use Data::Dumper;
use File::Glob ();
use warnings;
use strict 'refs';
my(@arr1) = glob('     abc def ghi f* ');
my(@arr2) = ('abc', 'def', 'ghi', 'f*');
my(@arr3) = glob('abc def ghi z*');
print Dumper(\@arr1);
print Dumper(\@arr2);
print Dumper(\@arr3);
glob_to_array.pl syntax OK

[download]

Deparse shows that qw() does the job without calling glob and risking something unexpected if the text happens to contain a metacharacter (other than curly braces). The best thing I can come up with is for a program that the team will need to support this is a bad idea since it could cause unintended and confusing side effects. Suggestions for better demonstrations or documentation would be appreciated. Maybe I'm being too critical and should lower my critic setting.

Note: I changed the title

I'm asking this as a result of someone who has an 'impossible' problem on their Mac asking on a Mac list.

They have a file that originated before MacOS X, that is before the Mac OS became Unix based. The first three characters of the filename are NULLs. Needless to say, any Unix function that tries to manipulate that file fails at the name -> inode lookup stage because the filename string terminates at the first char.

I fixed a similar problem around 35 years ago by doing a binary edit on the directory file, but that option is no-longer available, especially on a Mac, so I'm looking at Perl. I am reasonably familiar with Perl, but not an expert.

In Perl I can opendir() and readdir() to find the entry but that doesn't give me the rest of the directory entry structure. If I had that, I could change the name and hopefully re-write the directory file.

Does anyone have any pointers? I can't think of any other group where I would find real 'bit twiddlers'.

Thanks, David

I currently have the following workflow in place :

• server listening on a TCP port awaiting for connections
• a payload is sent to the server
• I fork through fork() and launch the treatment of the child
• the child exit(0)

The problem I'm facing is that the child, following the inner working of fork, gets the memory copied from the parent, and the subsequent perl modules initialy loaded by the server.

However said modules can be updated from time to time, but the loaded copy of the modules are not refreshed so the child always ends up with the older modules even though the modules have been updated on disk.

I understand that this behaviour is standard and expected but it doesn't suits my needs, so I'm seeking some information or pointers on the best way to achieve the following :

• i want to keep the server listening behaviour, which is just a lightweight process listening and sending payload to be worked on
• i don't need to handle the child return in the server (parent), i can keep track of it through another way if needed
• i absolutely need to make sure that the child doing the work has the last version of the modules loaded, the existing child running can work on the last copy until they die off

I tried to use Module::Reload but given the complexity of modules being loaded I always ended up generating infinite loops and i'm sure i need that.

It seems that using pipes might help, but not quite sure about that or how to implement it.

Thanks for your help and tips on the best way to achieve that.

Best, M

Hi Monks, I am writing a script to generate a Array of Hashes by reading a input file which contains the text below

I was not able to generate the data for the interface gif0, Can I please know if there is also a better way to parse this file ?

lo0: flags=8049<UP,LOOPBACK,RUNNING,MULTICAST> mtu 16384
    options=1203<RXCSUM,TXCSUM,TXSTATUS,SW_TIMESTAMP>
    inet 127.0.0.1 netmask 0xff000000 
    inet6 ::1 prefixlen 128 
    inet6 fe80::1%lo0 prefixlen 64 scopeid 0x1 
    nd6 options=201<PERFORMNUD,DAD>
gif0: flags=8010<POINTOPOINT,MULTICAST> mtu 1280
en0: flags=8863<UP,BROADCAST,SMART,RUNNING,SIMPLEX,MULTICAST> mtu 1500
    ether f4:0f:24:29:df:4d 
    inet6 fe80::1cb5:1689:1826:cc7b%en0 prefixlen 64 secured scopeid 0
+x4 
    inet 10.176.85.19 netmask 0xffffff00 broadcast 10.176.85.255
    nd6 options=201<PERFORMNUD,DAD>
    media: autoselect
    status: active
en1: flags=963<UP,BROADCAST,SMART,RUNNING,PROMISC,SIMPLEX> mtu 1500
    options=60<TSO4,TSO6>
    ether 06:00:58:62:a3:00 
    media: autoselect <full-duplex>
    status: inactive
p2p0: flags=8843<UP,BROADCAST,RUNNING,SIMPLEX,MULTICAST> mtu 2304
    ether 06:0f:24:29:df:4d 
    media: autoselect
    status: inactive
[download]

Below is my code

#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
################
my @AoH;
my $rec;
my $flag = 0;
open my $fh, '<', 'interface.txt' or die;
while (<$fh>) {
    chomp;
    if (/^(\w+\d{1}):\s+flags=(.*?>)/) {
        $flag = 1;
        $rec = {};
        $rec->{'interface'} = $1;
        $rec->{'flags'} = $2;
    } elsif (/ether\s+(.*$)/) {
        $rec->{'ether'} = $1;
    } elsif (/media:\s+(\w+)/) {
        $rec->{'media'} = $1;
    } elsif (/inet\s+(\w+\.\w+\.\w+\.\w+)/) {
        $rec->{'inet'} = $1;
    }  elsif (/status: (\w+)/) {
        $rec->{'status'} = $1;
    } elsif ($flag) {
        push @AoH, $rec;
        $flag = 0;
    }
}

close($fh);
print Dumper \@AoH;

[download]

Output

./create_arr_of_hashes_from_file.pl
$VAR1 = [
          {
            'flags' => '8049<UP,LOOPBACK,RUNNING,MULTICAST>',
            'inet' => '127.0.0.1',
            'interface' => 'lo0'
          },
          {
            'ether' => 'f4:0f:24:29:df:4d ',
            'flags' => '8863<UP,BROADCAST,SMART,RUNNING,SIMPLEX,MULTIC
+AST>',
            'status' => 'active',
            'media' => 'autoselect',
            'interface' => 'en0',
            'inet' => '10.176.85.19'
          },
          {
            'status' => 'inactive',
            'media' => 'autoselect',
            'interface' => 'en1',
            'flags' => '963<UP,BROADCAST,SMART,RUNNING,PROMISC,SIMPLEX
+>',
            'ether' => '06:00:58:62:a3:00 '
          },
          {
            'status' => 'inactive',
            'media' => 'autoselect',
            'interface' => 'p2p0',
            'flags' => '8843<UP,BROADCAST,RUNNING,SIMPLEX,MULTICAST>',
            'ether' => '06:0f:24:29:df:4d '
          }
        ];
[download]

#!/usr/bin/perl

use Net::OpenSSH;
use strict;
use warnings;

$Net::OpenSSH::debug=-1;
# Define varilables
my $vpntype=$ARGV[2];
my $requestor=$ARGV[1];
my $user='username';
my $password='password';
my $peerIP=$ARGV[0];
my $log_file="/share/www/vpndb/tunnel_clear.log";
my $host;
my $datestring;
my $message;

# Determine which host to connect to
if($vpntype eq 'ASP VPN') {
        $host='192.168.254.1';
} else {
        $host='192.168.254.2';
}

# Connect to host
print "Connecting to $host\n";
#my $ssh = Net::OpenSSH->new($host, user => $user, password => $passwo
+rd, master_opts => '-vv');
my $ssh = Net::OpenSSH->new($host, user => $user, password => $passwor
+d);
$ssh->error and die "Unable to connect: " . $ssh->error;
print "Connected to $host\n";

# Clear the VPN tunnel
my $cmd = "vpn-sessiondb logoff ipaddress $peerIP noconfirm";
my $sshen = "\nen\n$password\n$cmd\nexit\n";
my @output = $ssh->capture("$sshen");

# Check to make sure VPN was cleared successfully
$datestring = localtime();
if ( grep( /logged off : 1/, @output ) ) {
        print "\nFound!\n\n";
        $message = "Tunnel SUCCESSFULLY cleared for peer $peerIP, requ
+ested by $requestor with service: $vpntype";
} else {
        print "\nNot Found!\n\n";
        $message = "Tunnel NOT SUCCESSFULLY cleared for peer $peerIP, 
+requested by $requestor with service: $vpntype";
}
# Write to log file
open my $log_fh, ">>", $log_file;
print "Output = @output\n\n";
write_to_log ($log_fh, $message);
print $log_fh "Output = @output\n\n";

# Clean up
close $log_fh;
undef $ssh;

# Sub Routines
sub write_to_log {
    my $file_handle  = shift;
    $message      = shift;

    my $time = localtime();
    return print $file_handle "$time: $message\n";
}
[download]

# open_ex: ['ssh','-V']
Connecting to 192.168.254.1
# io3 mloop, cin: 0, cout: 1, cerr: 0
# io3 fast, cin: 0, cout: 1, cerr: 0
# stdout, bytes read: 48 at offset 0
#> 4f 70 65 6e 53 53 48 5f 37 2e 34 70 31 2c 20 4f 70 65 6e 53 53 4c 20 31 2e 30 2e 32 6b 2d 66 69 | OpenSSH_7.4p1, OpenSSL 1.0.2k-fi
#> 70 73 20 20 32 36 20 4a 61 6e 20 32 30 31 37 0a | ps 26 Jan 2017.
# io3 fast, cin: 0, cout: 1, cerr: 0
# stdout, bytes read: 0 at offset 48
# leaving _io3()
# _waitpid(105560) => pid: 105560, rc:
# OpenSSH verion is 7.4p1,
# ctl_path: /root/.libnet-openssh-perl/username-192.168.254-105559-879808, ctl_dir: /root/.libnet-openssh-perl/
# _is_secure_path(dir: /root/.libnet-openssh-perl, file mode: 16832, file uid: 0, euid: 0
# _is_secure_path(dir: /root, file mode: 16744, file uid: 0, euid: 0
# set_error(0 - 0)
# call args: ['ssh','-o','ServerAliveInterval=30','-o','ControlPersist=no','-2MNx','-o','NumberOfPasswordPrompts=1','-o','PreferredAuthentications=keyboard-interactive,password','-S','/root/.libnet-openssh-perl/username-192.168.254-105559-879808','-l','username','192.168.254.1','--']
# file object not yet found at /root/.libnet-openssh-perl/username-192.168.254-105559-879808, state: waiting_for_passwd_prompt
# file object not yet found at /root/.libnet-openssh-perl/username-192.168.254-105559-879808, state: waiting_for_passwd_prompt
# file object not yet found at /root/.libnet-openssh-perl/username-192.168.254-105559-879808, state: waiting_for_passwd_prompt
# file object not yet found at /root/.libnet-openssh-perl/username-192.168.254-105559-879808, state: waiting_for_passwd_prompt
# file object not yet found at /root/.libnet-openssh-perl/username-192.168.254-105559-879808, state: waiting_for_passwd_prompt
# file object not yet found at /root/.libnet-openssh-perl/username-192.168.254-105559-879808, state: waiting_for_passwd_prompt
# tracer attached, ssh pid: 105561, tracer pid: 105562
# file object not yet found at /root/.libnet-openssh-perl/username-192.168.254-105559-879808, state: waiting_for_passwd_prompt
# passwd/passphrase requested (username@192.168.254.1's password:)
# file object not yet found at /root/.libnet-openssh-perl/username-192.168.254-105559-879808, state: waiting_for_mux_socket
# file object not yet found at /root/.libnet-openssh-perl/username-192.168.254-105559-879808, state: waiting_for_mux_socket
# file object found at /root/.libnet-openssh-perl/username-192.168.254-105559-879808
# call args: ['ssh','-O','check','-T','-S','/root/.libnet-openssh-perl/username-192.168.254-105559-879808','-l','username','192.168.254.1','--']
# open_ex: ['ssh','-O','check','-T','-S','/root/.libnet-openssh-perl/username-192.168.254-105559-879808','-l','username','192.168.254.1','--']
# io3 mloop, cin: 0, cout: 1, cerr: 0
# io3 fast, cin: 0, cout: 1, cerr: 0
# stdout, bytes read: 29 at offset 0
#> 4d 61 73 74 65 72 20 72 75 6e 6e 69 6e 67 20 28 70 69 64 3d 31 30 35 35 36 31 29 0d 0a | Master running (pid=105561)..
# io3 fast, cin: 0, cout: 1, cerr: 0
# stdout, bytes read: 0 at offset 29
# leaving _io3()
# _waitpid(105563) => pid: 105563, rc:
# call args: ['ssh','-S','/root/.libnet-openssh-perl/username-192.168.254-105559-879808','-l','username','192.168.254.1','--','
en
password
vpn-sessiondb logoff ipaddress 69.18.79.158 noconfirm
exit
']
# open_ex: ['ssh','-S','/root/.libnet-openssh-perl/username-192.168.254-105559-879808','-l','username','192.168.254.1','--','
en
password
vpn-sessiondb logoff ipaddress 69.18.79.158 noconfirm
exit
']
Connected to 192.168.254.1
# io3 mloop, cin: 0, cout: 1, cerr: 0
# io3 fast, cin: 0, cout: 1, cerr: 0
# stdout, bytes read: 52 at offset 0
#> 54 79 70 65 20 68 65 6c 70 20 6f 72 20 27 3f 27 20 66 6f 72 20 61 20 6c 69 73 74 20 6f 66 20 61 | Type help or '?' for a list of a
#> 76 61 69 6c 61 62 6c 65 20 63 6f 6d 6d 61 6e 64 73 2e 0d 0a | vailable commands...
# io3 fast, cin: 0, cout: 1, cerr: 0
Connection to 192.168.254.1 closed by remote host.
# stdout, bytes read: 0 at offset 52
# leaving _io3()
# _waitpid(105564) => pid: 105564, rc:
# set_error(5 - child exited with code 255)
# DESTROY(Net::OpenSSH=HASH(0x1a47cb8), pid: 105561)
# killing master
# sending exit control to master
# set_error(1 - control command failed: master ssh connection broken)
# _kill_master: 105561
# waitpid(master: 105561) => pid: 105561, rc: No such file or directory

The 'Type help or '?' for a list of available commands' output that is captured makes me think that the $sshen commands, even though they are seen in the debug output, aren't really being passed through.

Any thoughts?

So my current code calculates the end date when given the start date and the number of days user entered for. I have many directories that contains different log files such as access logs, system logs and etc. The directories are named according to date; e.g.,

Directory name: 2017-12-08 Inside this directory: access.log sys.log

What I want to achieve is when user key in the IP address, start date and number of days, it will grep through the logs(that contains the IP keyed in) from the start date to the end date. So for e.g. if user key in 2017-12-08 and 2 days, all logs from 2017-12-08 to 2017-12-10 will be grep and printed. This is my current code

use strict;
use warnings;
use Time::Piece ();
use Time::Seconds;

#Ask for IP address
print "Enter an IP address to lookup: ";
my $ipAddress = <STDIN>; # I moved chomp to a new line to make it more
+ readable
chomp $ipAddress; # Get rid of newline character at the end

#Ask for number of days
print "Enter no. of days: ";
my $numdays = <STDIN>; chomp $numdays;

my $dt = Time::Piece->strptime( $sdate, '%Y-%m-%d');
$dt += ONE_DAY * $numdays;
my $edate = $dt->strftime('%Y-%m-%d');

if ($numdays == 1){
            my $result = `grep -R -E '$ipAddress' $LogDir | grep -E '$
+sdate'`;
                        
            
            if ($result){
                print $result;
            }else{
                print "No result found from $sdate. Please try changin
+g your IP address/start date and try again.\n"; 
                }
        }
        elsif($numdays > 1){
            my $result = `grep -R -E '$ipAddress' $LogDir | sed -n '/$
+sdate/,/$edate/{/$edate/d; p}'`;
            if ($result){
            print $result;
            }else{
            print "No result found from $sdate. Please try changing yo
+ur IP address/start date and try again.\n"; 
            }
        }
[download]

How can I grep through the dates? currently my code only grep the dates in actual logs itself but this is not a good solution as my logs date format are very inconsistent hence I want to grep via the directory name instead. Any help would be greatly appreciated

Hi,

I am unsuccessfully trying to build a Where Clause in DBIx::Class.
The where clause should be:

WHERE status='Review' OR
              ( ( status='Offered' OR
                   status='Denied' OR
                   status='Cancelled' OR
                   status='Conditional Offer') AND
                 ( sent_email is NULL OR
                   sent_email='0000-00-00')
             )
[download]

I was successful able to produce this Where Clause:

WHERE ( status='Offered' OR
                status='Denied' OR
                status='Cancelled' OR
                status='Conditional Offer') AND
              ( sent_email is NULL OR
                sent_email='0000-00-00');
[download]

using this snippet of code:

my @proc_requests = $schema->resultset( 'TblRequests' )->search({
                -or => [
                      status => 'Offered',
                      status => 'Denied',
                      status => 'Cancelled',
                      status => 'Conditional Offer',
                          ],
                           -and => [
                               -or => [
                                    sent_email => {'!=', undef },
                                    sent_email => {'!=', '0000-00-00'}
+,
                                ],
                            ],
                });
[download]

All I need is to add is the outer OR for status = 'Review'. Any thoughts on how to
write a DBIx::Class where clause to produce the first Where Clause at the top?

Thanks

Hello friends, I seek help with what I realize may be an XY problem (so I will describe it generally below).

I've inherited some code that is intended to mask sensitive data in logs. The application sends data to be formatted (flattened) for logging. The data may include JSON strings. The current code uses Data::Dumper to flatten the data. The resulting string may have "sensitive" keys quoted with single quotes (from Data::Dumper) or with double quotes (from JSON). Presumably, it could also contain embedded escaped quotes.

A regular expression is used to do the work. The current implementation is broken. I'm working on a replacement, and first it looks for the "quotation mark" in use to quote the key and the value. I'm using a negative lookbehind to skip escaped quotes. This seems to work in simple matching but what I am having trouble with is using the captured "quotation mark" (including the negative lookbehind to skip escaped quotes) in a character class or in a negative lookahead.

my $param = 'password';
for ( q~{'password' => 'secret'}~, q~{"password" => "sec\"ret"}~ ) {
    $_ =~ s/
        (                   # capture everything up to the start of th
+e value
          (                   # capture the quotation mark we are usin
+g
            (?<!\\\\)         # not escaped
            [ ' " ]           # either kind of quote
          )                   # end capture quotation mark
          $param              # the key
          \2                  # the same quotation mark
          \s*                 # any amount of space
          (?: => | : )        # perl or JSON key-value "connector"
          \s*                 # any amount of space
          \2                  # the same quotation mark
        )                   # end capture everything up to start of th
+e value
        (?:                 # group but do not capture the value
          (?!\2) .           # defined as any character except the sam
+e quote
        )*                  # any number of times
    /$1***/smxg;            # the closing quotation mark will remain i
+n place

    say $_;
}
[download]

{'password' => '***'}
{"password" => "***"ret"}
[download]

All suggestions welcome.

Hello Monks!

I've never had this problem before:

$ wget -O - https://install.perlbrew.pl | bash
[...snip normal wget output...]
## Download the latest perlbrew

## Installing perlbrew
Using Perl </usr/bin/perl>
Can't locate Cwd.pm in @INC (you may need to install the Cwd module) (
+@INC contains: /usr/local/share/perl/5.22.1/x86_64-linux-gnu-thread-m
+ulti /usr/local/share/perl/5.22.1 /usr/share/perl5 /usr/lib/x86_64-li
+nux-gnu/perl5/5.22 /usr/lib/x86_64-linux-gnu/perl/5.22 /usr/share/per
+l/5.22) at perlbrew.ytTuXk line 7.
BEGIN failed--compilation aborted at perlbrew.ytTuXk line 9.
[download]

Seems @INC is a little messed up, here. Cwd.pm exists, and works fine when I use it manually with the system Perl (5.22, Ubuntu 16.04 LTS) in /usr/bin/perl:

$ locate Cwd.pm
/usr/lib/x86_64-linux-gnu/perl-base/Cwd.pm
$ perl -MCwd -le 'print cwd()'
/home/wcp
$ uname -a
Linux localhost 4.9.50-x86_64-linode86 #1 SMP Thu Sep 14 19:28:20 UTC 
+2017 x86_64 x86_64 x86_64 GNU/Linux
[download]

Any ideas on what might have broken, here?

Full output:

   rs492602    **CC**     Vitamin B12 deficiency    FUT2    Higher lev
+els of vitamin B12        
        rs492602    CT    Vitamin B12 deficiency    FUT2    Normal lev
+els of vitamin B12        
        rs492602    TT     Vitamin B12 deficiency    FUT2    Normal le
+vels of vitamin B12 
[download]

        rs492602    **GG**    exm-rs492602
        rs492602    **CC**    exm-rs492602 
[download]

rs492602**CC** **GG** Vitamin B12 deficiency    FUT2    Higher levels 
+of vitamin B12    
    rs492602**CC** **CC** Vitamin B12 deficiency    FUT2    Higher lev
+els of vitamin B12    
[download]

use warnings;
use strict;

open(F1,$ARGV[0]) or die("could not open $ARGV[0] due to $!\n");
open(F2,$ARGV[1]) or die("could not open $ARGV[1] due to $!\n");

my @arr1=<F1>;
my @arr2=<F2>;
chomp(@arr1);
chomp(@arr2);

my $x=shift(@arr1);
my $i=0;

print "$x\n";

foreach my $line1(@arr2){
    chomp($line1);
    foreach my $line2(@arr1){
        chomp($line2);
        $line2=~/(\w+)\t.*/;
        my $rsid=$1;
        #while($rsid){
        #    $i++;
        #}
        if($line1 eq $rsid){
            print "$line2\n";
            $i++;
        }
        
    }
}
[download]

I am using LWP::Simple::get($url) library to access data from web pages. The problem is that the get function is not working for the below url. Below is the code snippet:

#!/usr/bin/perl
use LWP::Simple;
use JSON;
use Data::Dumper;
my $url = "https://www.cryptopia.co.nz/api/GetCurrencies";
my $json = get( $url);
die "Could not get $url!" unless defined $json;
my $decoded_json = decode_json($json);
print Dumper($decoded_json);
[download]

After running this code it gives the below error: Could not get https://www.cryptopia.co.nz/api/GetCurrencies! When i replace the url with :

it works fine. Please can you tell me what is the root cause and how I can fix it. Also the url mentioned in the code snippet worked once and now suddenly it does not work.

I'm studying parallel processes and would like all child processes to send some messages to parent process. But I do not understand is it possible to do it via one pipe, or there should be separate pipes for each child process. Also, messages are being delievered to parent process just one time. Could you please advice how to fix it?

Thank you in advance!

#!/usr/bin/perl
#use strict;
#use warnings;
use IO::Handle;         
pipe (READER, WRITER);  
WRITER->autoflush(1);   

my $parent=$$;
print "parent: $parent\n";

# Forking childs
for (my $count = 0; $count < 2; $count++) {
    defined (my $pid = fork) or die "Cant fork: $!";
}

if ($$ == $parent) { # Master process
  while (1) {
    print "parent $$\n";
    close WRITER;        
    chomp (my $line = <READER>);
    print "<<<<<<<<<<<<<<<<<<<$line\n";
    close READER;
    sleep 2;        
  } 
} else  { # Fork process
    while (1) {
    print "\tchild $$\n";
    close READER;
    print WRITER "$$";
    close WRITER;    
    sleep 1;
  }
  exit 0;
} 
[download]

Note that the module itself mentions the following:

For example, you can't say $hash{CONSTANT} because CONSTANT will be interpreted as a string. Use $hash{CONSTANT()} or $hash{+CONSTANT} to prevent the bareword quoting mechanism from kicking in. Similarly, since the => operator quotes a bareword immediately to its left, you have to say CONSTANT() => 'value' (or simply use a comma in place of the big arrow) instead of CONSTANT => 'value'.

The OP used &CONSTANT => 'value' which works but doesn't inline the constant (i.e. expand it during compile time).

ikegami pointed me to a different way which I found more pleasing than CONSTANT() which, as he rightly noted, leaks the internal implementation of constants.

use constant A => 12;
my %hash = ( (A) => 'twelve' ); # beautiful
[download]

I wanted to verify it behaves exactly the same, so I tried running it through B::Deparse, B::Terse, and B::Concise.

m=Deparse
diff <(perl -MO=$m -e 'use constant A => 12; my %hash = ( A() => "twel
+ve")') \
     <(perl -MO=$m -e 'use constant A => 12; my %hash = ( (A) => "twel
+ve")')
[download]

Terse needs some tweaking to skip the pointers:

m=Terse
diff <(perl -MO=$m -e 'use constant A => 12; my %hash = ( A() => "twel
+ve")' \
       | perl -pe 's/0x\w+/X/g') \
     <(perl -MO=$m -e 'use constant A => 12; my %hash = ( (A) => "twel
+ve")' \
       | perl -pe 's/0x\w+/X/g')
[download]

But Concise shows a slight difference:

m=Concise
diff <(perl -MO=$m -e 'use constant A => 12; my %hash = ( A() => "twel
+ve")') \
     <(perl -MO=$m -e 'use constant A => 12; my %hash = ( (A) => "twel
+ve")')

7c7
< 4           <$> const[IV 12] s*/FOLD ->5
---
> 4           <$> const[IV 12] sP*/FOLD ->5
[download]

From the documentation it seems the P just means that A was parenthesized. I can imagine this information could be valuable to Perl (e.g. in the LHS of an assignment, but the structures of scalar versus list assignments are much more different); but probably not in this case.

Update: Topics for meditation include other possible syntaxes (e.g. A ,=> 12), personal preferences, explanation of the Concise's output, etc.

($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord
}map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
[download]