Perl Cheat Sheet

LWP

File download

use LWP::Simple;
getstore("http://ftp.server.com/data/file.zip", "c:\\file.zip.zip");

Manip

DateCalc

use Date::Manip;
$bla=&UnixDate(DateCalc("2013-05-31","+ 1 days",\$err),"%Y-%m-%d")

my $pageDate = "201402190000";
$pageDate = UnixDate("$pageDate","%A %d %B %Y %H:%M");
print "$pageDate";

Array

Return array from function

#!/usr/bin/perl
use strict;
use Data::Dumper;
my @ret=&retTest;
print "=>$ret[0]\n";
print "=>$ret[1]\n";
sub retTest {
 my @subRet;
 @subRet=("a","b");
 return @subRet;
}

Hash

Double nested

Double nested sample,

for( @{$_->{FaresResponsePassenger}} ){

Experts Exchange

I got the following hash by a soap response, example:

$VAR1 = {
   'Response' => {
     'Category' => [
                   {
                    'ID' => '12345',
                    'Articel' => {
                      'Segment' => [
                                   {
                                          'Number' => '1',
                                   },
                                   {
                                          'Number' => '2',
                                   }
                                    ]                                                                                                                    
                                 }                                                                                      
                    },
                    {
                     'ID' => '6789',
                     'Articel' => {
                       'Segment' => [
                                    {
                                          'Number' => '1',
                                    },
                                    {
                                         'Number' => '2',
                                    }
                                   ]
                                  }                                                                                      
                    }
                    ]
     },
   };

my $n=0;
$n += grep$_->{Number},@{$_->{Articel}{Segment}} for @{$VAR1->{Response}{Category}};

ExpertsExchange-1

This is a follow up question from ID 25120698. I got the following hash by a soap response, example:

$VAR1 = {
   'Response' => {
     'Category' => [
                   {
                    'ID' => '123',
                    'Articel' => {
                      'Segment' => [
                                   {
                                          'Number' => '1',
                                   },
                                   {
                                          'Number' => '2',
                                   }
                                    ]                                                                                                                    
                                 }                                                                                      
                    },
                    {
                     'ID' => '456',
                     'Articel' => {
                       'Segment' => [
                                    {
                                          'Number' => '3',
                                    },
                                    {
                                          'Number' => '4',
                                    }
                                   ]
                                  }                                                                                      
                    },

                    {
                     'ID' => '789',
                     'Articel' => {
                       'Segment' => {
                                          'Number' => '5',
                                    }
                                  }                                                                                      
                    }


                    ]
     },
   };

you can check the ref is ARRAY or HASH and depend on which you can print it.

for my $v (@{$VAR1->{Response}{Category}}){
 if(ref($v->{Articel}{Segment}) eq "ARRAY"){ ### Check it is ARRAy or HASH
  for my $w (@{$v->{Articel}{Segment}}){
   print "$w->{Number}\n";
  }
 } else {
  for my $w (keys (%{$v->{Articel}{Segment}})){ ###Get the element as HASH ref and print
   print "$v->{Articel}{Segment}{$w}\n";  
  }
 }              
}

Another sample:

$w contains this:

$VAR1 = [
{
  'value' => {
    'text' => 'auto_generated_pool_enterprise'
  },
  'k' => 'Pool'
},
{
  'k' => 'used',
  'value' => {
    'text' => '43.98'
  }
}
];

Want 43.98

for my $x ( @{$w}){
 if ($x->{'value'}->{'text'} !~ /auto/) {
  print $x->{'value'}->{'text'} . "\n";
 }
}	

EE3

Hi i'm looking for a regex to split the filename from a path, eg $_ = '/path/to/my//file/space /my music - name.mp3';

how do i get the filename (my music - name.mp3) and the path (/path/to/my//file/space /) into a variable, i'm trying to do something like $MP3= '/path/to/my//file/space /my music - name.mp3'; ($var,$value) = split(/\/([^.]*)/ig,$MP3,2);

i'm lost, any idea ?

thx

$_ = '/path/to/my//file/space /my music - name.mp3'; my ($var,$value) = /^(.*\/)(.*)$/;

FILE STAT

Get the mod date of a file

use File::stat qw(:FIELDS); 
my $stat = stat($_) or die "No File :$!";  #PS: So behandelt man Filstats!
$tmpsize = $st_size;
$tmpmod = $st_mtime;

Sort

Sort scalar

@splunkfiles = sort {$b cmp $a} @splunkfiles;

Close DB Handle

$sql->finish;  #Close DB Handle

Socket receive

  #Thanks!
  #http://stackoverflow.com/questions/14444539/perl-client-socket-recv-vs-when-server-socket-is-invoking-send-multiple-ti	
  my $buf;
  do {
   defined $socket->recv($buf, 8129) or die "recv: $!";
   #print qq(received: "$buf"\n);
   $RecData.=$buf;
 } while ($buf !~ /~~/);

Console autoflush

#Use autoflush with STDOUT:
local $| = 1; # Or use IO::Handle; STDOUT->autoflush;

Json

• Json

cat /usr/local/docker-data/zigbee2mqtt-data/state.json
 {
   "0xa4c1388406c666af": {
       "state": "ON",
       "power_outage_memory": "restore",
       "indicator_mode": "off/on",
       "child_lock": "UNLOCK",
       "energy": 9.51,
       "power": 0,
       "current": 0,
       "voltage": 234,
       "linkquality": 72
   },
   "0x00158d0008ab1626": {
       "temperature": 16.55,
       "humidity": 56.77,
       "pressure": 905.4,
       "linkquality": 127,
       "voltage": 2855,
       "battery": 3,
       "power_outage_count": 11208
   },
   ...
   ...
 }

• Script

#!/usr/bin/perl
use JSON qw();
use Data::Dumper;
my $file_zigbee_state = '/usr/local/docker-data/zigbee2mqtt-data/state.json';
open my $fh, '<:encoding(UTF-8)', $file_zigbee_state or die "Can't open $file_zigbee_state: $!";
my $json_text = do { local $/; <$fh> };
$data = JSON->new->decode($json_text);
return undef;
# top-level keys are device IDs
for my $device (keys %$data) {
   print "Device: $device\n";
   my $info = $data->{$device};
   # each device has its own key/value pairs
   for my $k (keys %$info) {
       my $v = $info->{$k};
       print "  $k => $v\n";
   }
   print "\n";
}

ISO8601 Dates

ISO 8601 Date to Unix

#https://metacpan.org/pod/DateTime::Format::ISO8601
use DateTime::Format::ISO8601;
my $dt = DateTime::Format::ISO8601->parse_datetime('2019-02-14T00:00:00');
print $dt->strftime('%F %T') . "\n";
print $dt->strftime('%F') . "\n";
print $dt->strftime('%a') . "\n";
print $dt->strftime('%T') . "\n";

Returns:

2019-02-14 00:00:00
2019-02-14
Thu
00:00:00
560
09:20:00

ISO 8601 Duration to Minutes

#https://metacpan.org/pod/DateTime::Format::Duration::ISO8601a
use DateTime::Format::Duration::ISO8601;
my $format = DateTime::Format::Duration::ISO8601->new;
my $d = $format->parse_duration('PT9H20M');
print $d->in_units('minutes'); # => 61

Format Duration

use DateTime::Format::Duration;
my $duration = DateTime::Duration->new(minutes => 560);
my $formatter = DateTime::Format::Duration->new(
      pattern     => "%H:%M:%S",
      normalize   => 1,
);
$duration=$formatter->format_duration($duration);
print "\n$duration\n";

Epoch TIme

use Date::Manip;  
my $tEpoche=UnixDate('2018-03-30 10:00:00' ,"%s");

Timezones

• See: https://en.wikipedia.org/wiki/List_of_time_zone_abbreviations
• See: https://en.wikipedia.org/wiki/List_of_tz_database_time_zones

Get Timezoe with short name abbreviation and offset

 use DateTime;
 use DateTime::TimeZone;
 my $tz = DateTime::TimeZone->new( name => 'Europe/Berlin' );
 $dt = DateTime->new( {
              year => 2014, month => 12,  day => 19,
              hour => 2,  minute=> 2,  second=> 0
 };
 my $offset = $tz->offset_for_datetime($dt);
 my $sn = $tz->short_name_for_datetime( $dt );
 print "$dt $offset $sn\n";

Returns:

2014-12-19T02:02:00 3600 CET

 use DateTime;
 use DateTime::TimeZone;
 my $tz = DateTime::TimeZone->new( name => 'Europe/Berlin' );
 $dt = DateTime->new( {
              year => 2014, month => 10,  day => 19,
              hour => 2,  minute=> 2,  second=> 0
 };
 my $offset = $tz->offset_for_datetime($dt);
 my $sn = $tz->short_name_for_datetime( $dt );
 print "$dt $offset $sn\n";

Returns:

2014-10-19T02:02:00 7200 CEST

Convert to GMT

$datestring = strftime "%x %T", gmtime;
print "GMT date and time $datestring\n";

Convert to GMT to CEST

my $datex = UnixDate( Date_ConvTZ( $datestring, 'GMT', 'CEST' ), "%Y-%m-%d %T");
print "Convert GMT to CST - $datestring -  $datex\n";

DBI

Return entire row from a sql statement

my $sth = $dbh->prepare('select * from sys.dm_qn_subscriptions');
$sth->execute;
while ( my @row = $sth->fetchrow_array ) {
  print "@row\n";
}

Options/Arguments

use Getopt::Long; 
GetOptions (
 "flag!" => \$flag, 
 "string=s" => \$string, 
 "int=i" => \$integer
);
print "($flag,$string,$integer)\n";

Simple read file

open(FH, '<', '/path/file') or die "Unable to open file, $!";
while (<FH>) {
 chomp;
 print "$_\n";	
}
close FH;

Telegram Send Sample

#!/usr/bin/perl
use LWP;

my $telegram_token="5392.....";
my $telegram_chat_id="-100....";
my $telegram_text="This
is
one
more
message";

my $ua = LWP::UserAgent->new();
$url = "https://api.telegram.org/bot$telegram_token/sendMessage?chat_id=$telegram_chat_id&text=$telegram_text";
$req = HTTP::Request->new(GET=>$url);
$res = $ua->request($req);
if ($res->is_success) {
 print "Send OK\n";
}