Perl Cheat Sheet - Revision history

Admin: /* ISO8601 Dates */

2025-09-30T18:17:58Z

ISO8601 Dates

← Older revision		Revision as of 18:17, 30 September 2025
Line 220:		Line 220:
	local $\| = 1; # Or use IO::Handle; STDOUT->autoflush;		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=		=ISO8601 Dates=

Admin at 19:19, 11 November 2022

2022-11-11T19:19:27Z

← Older revision		Revision as of 19:19, 11 November 2022
Line 327:		Line 327:
	}		}
	close FH;		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";
			}

Admin: /* Options/Arguments */

2021-11-12T18:09:54Z

Options/Arguments

← Older revision		Revision as of 18:09, 12 November 2021
Line 319:		Line 319:
	);		);
	print "($flag,$string,$integer)\n";		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;

Admin: /* File download */

2021-11-12T16:48:22Z

File download

← Older revision		Revision as of 16:48, 12 November 2021
Line 4:		Line 4:
	==File download==		==File download==
	use LWP::Simple;		use LWP::Simple;
	getstore("http://ftp.~~hitchhiker~~.com/data/~~currency~~.zip", "c:\\~~curbla~~.zip");		getstore("http://ftp.server.com/data/file.zip", "c:\\file.zip.zip");


	=Manip=		=Manip=

Admin: /* Options/Arguments */

2021-11-12T16:43:16Z

Options/Arguments

← Older revision		Revision as of 16:43, 12 November 2021
Line 319:		Line 319:
	"int=i" => \$integer		"int=i" => \$integer
	);		);
			print "($flag,$string,$integer)\n";

Admin: /* Parameter */

2021-11-12T16:42:39Z

Parameter

← Older revision		Revision as of 16:42, 12 November 2021
Line 312:		Line 312:


	=~~Parameter~~=		=Options/Arguments=
	use Getopt::Long;		use Getopt::Long;
	GetOptions (		GetOptions (

Admin: /* DBI */

2021-11-12T16:39:05Z

DBI

← Older revision		Revision as of 16:39, 12 November 2021
Line 310:		Line 310:
	print "@row\n";		print "@row\n";
	}		}


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

Admin: Created page with " =LWP= ==File download== use LWP::Simple; getstore("http://ftp.hitchhiker.com/data/currency.zip", "c:\\curbla.zip"); =Manip= ==DateCalc== use Date::Manip; $bla=&UnixDat..."

2020-11-27T18:15:40Z

Created page with " =LWP= ==File download== use LWP::Simple; getstore("http://ftp.hitchhiker.com/data/currency.zip", "c:\\curbla.zip"); =Manip= ==DateCalc== use Date::Manip; $bla=&UnixDat..."

New page

=LWP=
==File download==
use LWP::Simple;
getstore("http://ftp.hitchhiker.com/data/currency.zip", "c:\\curbla.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";
}
}
}

<br>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;

=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";
}