Matching differently encoded strings

(for shmem)

#!/usr/bin/perl use warnings; use strict; use feature qw{ say }; use Encode; my $iso8859 = join '', map chr, 191 .. 207, 209 .. 214, 216, 217 .. 221, 223 .. 239, 241 .. 246, 248 .. 253; my $utf8 = encode('utf8', decode('latin1', join '|', split //, $iso8 +859)); my $valid = qr/ ^ (?: [[:print:]$iso8859] | $utf8 ) $ /x; my $o_uml = decode('latin1', "\N{LATIN CAPITAL LETTER O WITH DIAERESI +S}"); my $o_l1 = encode('latin1', $o_uml); my $o_utf8 = encode('utf8', $o_uml); say 'bytes' if $o_uml =~ /$valid/; say 'latin' if $o_l1 =~ /$valid/; say 'utf8' if $o_utf8 =~ /$valid/; say 'yup' if "\x82" =~ /$valid/; # chr 130
[download]

Instance and class methods

#!/usr/bin/perl use warnings; use strict; use feature qw{ say }; { package Method::Types; use Carp; use Attribute::Handlers; sub handler { my ($package, $symbol, $ref, $attr, $data, $phase) = @_; die if 'CHECK' ne $phase; my $method_type = { Class => 'static', Instance => 'instance', }->{$attr}; { no warnings 'redefine'; *$symbol = sub { croak("Can't call $method_type method '", *{$symbol}{N +AME}, "' on ", ref $_[0] ? 'an object' : 'a class', ".\n") if ref $_[0] xor 'instance' eq $method_ty +pe; goto $ref }; } } sub Class : ATTR(CODE) { handler(@_) } sub Instance : ATTR(CODE) { handler(@_) } } { package Named; use parent -norequire => 'Method::Types'; sub new : Class { bless {}, shift } sub set_name : Instance { $_[0]->{name} = $_[1] } sub get_name : Instance { shift->{name} } } my $o = 'Named'->new; $o->set_name('John'); say $o->get_name; eval {$o->new; 1} or warn $@; eval {'Named'->get_name; 1} or warn $@;
[download]

Tied scalar remembereing previous values

Discipulus mmh.. could a tied scalar know his previous value?

In this example, the variable reports the previous value when assigned.

#!/usr/bin/perl use warnings; use strict; use Syntax::Construct '//'; { package Previous; use Tie::Scalar; use parent -norequire => 'Tie::StdScalar'; sub TIESCALAR { bless \ my $o, shift } sub STORE { my ($self, $value) = @_; warn 'I was ', $$self // 'undefined', "\n"; $$self = $value; } } tie my $p, 'Previous'; $p = $_ for 'a' .. 'z';
[download]


Magic date

[chacham] Yesterday was 3/24/2015 using all numbers 0-5. In just over a week it'll happen again.

#! /usr/bin/perl use warnings; use strict; use Time::Piece; use Time::Seconds qw{ ONE_DAY }; sub is_magical { my $s = shift; my %chars; undef @chars{ split //, $s }; my ($first, $last) = (sort keys %chars)[0, -1]; return (keys %chars == length $s and $last - $first + 1 == length $s) } my $t = 'Time::Piece'->strptime('2015-01-01', '%Y-%m-%d'); while () { print $t->ymd, "\n" if is_magical(join q(), $t->mon, $t->mday, $t- +>year); $t = $t + ONE_DAY; }
[download]

Inspired by yitzchak

(1)$ perl -MO=Deparse -e 'do("foo")->{bar};' do $foo{'bar'}; -e syntax OK (2)$ perl -MO=Deparse -e '(do "foo")->{bar};' do('foo')->{'bar'}; -e syntax OK (3)$ perl -MO=Deparse -Mstrict -e 'do("foo")->{bar};' Global symbol "%foo" requires explicit package name at -e line 1. -e had compilation errors. use strict 'refs'; do $<none>::foo{'bar'}; ERROR CODE: [34] (4)$ perl -MO=Deparse -Mstrict -e '(do "foo")->{bar};' use strict 'refs'; do('foo')->{'bar'}; -e syntax OK
[download]

So, (3) is not permitted under strict. (4) is permitted, but deparses to (3). What's going on here? (v5.14.4 under cygwin)


For pankaj_it09

#!/usr/bin/perl use warnings; use strict; use feature qw{ say }; my $number = '343243-23423*234-2342-3'; my @separators = $number =~ /([^0-9])/g; my %uniq; undef @uniq{@separators}; say 1 == keys %uniq ? 'Same' : 'Different';
[download]

Grouping similar elements

For mohan2monks:

#!/usr/bin/perl use warnings; use strict; use Data::Dumper; my @array = qw(AB AB CD AB AB AB); my @result = [ shift @array ]; for (@array) { if ($_ eq $result[-1][0]) { push @{ $result[-1] }, $_; } else { push @result, [ $_ ]; } } print Dumper \@result;
[download]