in reply to nodelocked vs floating

#!/usr/bin/perl

# https://perlmonks.org/?node_id=1226185

use strict;
use warnings;

my $lastproduct;
my $lastlicense;
my %hash;

while( <DATA> )
  {
  if( /^\s*"(PRODUCT\w*)"/ ) { $lastproduct = $1 }
  elsif( /floating license/ ) { $lastlicense = "Floating" }
  elsif( /nodelocked license, locked to "(ID=\d+)"/ )
    {
    $lastlicense = "Nodelocked $1";
    }
  elsif( /^\s*user\d+ machine/ )
    {
    $hash{$lastproduct}{$lastlicense}++;
    }
  }

#use Data::Dump 'dd'; dd \%hash;

for my $product (sort keys %hash)
  {
  my @inuse;
  print "$product";
  $hash{$product}{Floating} and
    push @inuse, "Floating in use $hash{$product}{Floating}";
  for my $license (sort grep /^Node/, keys $hash{$product}->%*)
    {
    push @inuse, "$license in use $hash{$product}{$license}"
    }
  local $" = ', ';
  print " @inuse\n";
  }

__DATA__

Users of PRODUCT1:  (Total of 300 licenses issued;  Total of 8 license
+s in use)

  "PRODUCT1" v40, vendor: MLM
  floating license

    user1 machine machine_display (v39) (server/port 306), start Wed 1
+1/21 6:15
    user2 machine machine_display (v33) (server/port 416), start Wed 1
+1/21 7:27
    user3 machine machine_display (v34) (server/port 206), start Wed 1
+1/21 10:01
    user4 machine machine_display (v34) (server/port 804), start Wed 1
+1/21 9:03

  "PRODUCT1" v40, vendor: MLM
    nodelocked license, locked to "ID=123456"

    user5 machine machine_display (v36) (server/port 1213), start Wed 
+11/21 7:25

  "PRODUCT1" v40, vendor: MLM
  floating license

    user6 machine machine_display (v36) (server/port 1701), start Wed 
+11/21 11:00
    user7 machine machine_display (v38) (server/port 1601), start Wed 
+11/21 10:45

  "PRODUCT1" v40, vendor: MLM
  nodelocked license, locked to "ID=89765"

    user8 machine machine_display (v34) (server/port 601), start Tue 1
+1/20 18:16
    

Users of PRODUCT2:  (Total of 300 licenses issued;  Total of 6 license
+s in use)

  "PRODUCT2" v40, vendor: MLM
  floating license

    user1 machine machine_display (v39) (server/port 306), start Wed 1
+1/21 6:15
    user2 machine machine_display (v33) (server/port 416), start Wed 1
+1/21 7:27
    user3 machine machine_display (v34) (server/port 206), start Wed 1
+1/21 10:01
    user4 machine machine_display (v34) (server/port 804), start Wed 1
+1/21 9:03

  "PRODUCT2" v40, vendor: MLM
    nodelocked license, locked to "ID=123456"

    user5 machine machine_display (v36) (server/port 1213), start Wed 
+11/21 7:25

  "PRODUCT2" v40, vendor: MLM
  floating license

    user6 machine machine_display (v36) (server/port 1701), start Wed 
+11/21 11:00

[download]

Replies are listed 'Best First'.
Re^2: nodelocked vs floating
by vkknava (Novice) on Nov 23, 2018 at 05:27 UTC
    Thanks for the answer. I am trying it out. Can you help me to know what the below line does? I am getting compilation error here. for my $license (sort grep /^Node/, keys $hash{$product}->%*)
[reply]
[d/l]

      Must be an older perl :(

      Replace 

      $hash{$product}->%*

      [download]

      with 

      %{ hash{$product}}

      [download]
[reply]
[d/l]
[select]
        I am using strawberry version.I think it should be for my $license (sort grep /^Node/, keys %{$hash{$product}}
[reply]
[d/l]

      G'day vkknava,

      Just to expand on tybalt89's reply, the ->%* (along with ->$*, ->@*, etc.) is a newer feature called "Postfix Dereference Syntax".

      If you're using Perl version

      • 5.18 or earlier, it's unavailable;
      • 5.20 or 5.22 you'll need to add "use feature 'postderef'";
      • 5.24 or later, it should just work without doing anything else.

      See the doco link for more complete details. Also look at the following section, "Postfix Reference Slicing", which provides similar syntax for array and hash slices.

      Although it did take a little while to get used to, I do find this new syntax greatly improves code readability. If you have an appropriate Perl version, I recommend you try it.

      — Ken

[reply]
[d/l]
[select]

        Thanks Ken. I have changed it like this and its working. I am using strawberry version.

          for my $license (sort grep /^Node/, keys %{$hash{$product}})
[reply]
[d/l]

In Section Seekers of Perl Wisdom