my @fruits = ('apple','orange','apple','orange');
my $num_apple = grep /^apple$/i, @fruits;
print $num_apple."\n";
####
@unique = grep { ++$count{$_} < 2 } qw(a b a c d d e f g f h h);print "@unique\n";
##
##
my @crops = qw(wheat corn barley rice corn soybean hay alfalfa rice hay beets corn hay);
my @dupes = grep { $count{$_} == 2 } grep { ++$count{$_} > 1 } @crops;print "@dupes\n";
##
##
@files = grep { -f and -T } glob '* .*';
print "@files\n";
##
##
@a = (0 .. 9, 'a' .. 'z');
$password = join '', map { $a [int rand @a ] } 0 .. 7;
print "$password\n";
##
##
sub visible {
print "var has value $var\n";
}
sub dynamic {
local $var = 'local'; # new temporary value for the still-global
visible(); # variable called $var
}
sub lexical {
my $var = 'private'; # new private variable, $var
visible(); # (invisible outside of sub scope)
}
$var = 'global';
visible(); # prints global
dynamic(); # prints local
lexical(); # prints global
##
##
%hash = ( Elliot => Babbage,
Charles => Babbage,
Grace => Hopper,
Herman => Hollerith
);
@sorted = map { { ($_ => $hash{$_}) } }
sort { $hash{$a} cmp $hash{$b}
or $a cmp $b
} keys %hash;
foreach $hashref (@sorted) {
($key, $value) = each %$hashref;
print "$key => $value\n";
}
Charles => Babbage
Elliot => Babbage
Herman => Hollerith
Grace => Hopper
##
##
my %data = (bananas => 1,oranges => 7,apples => 12, mangoes => 3,pears => 8,);
# Using <=> instead of cmp because of the numbers
foreach my $fruit (sort {$data{$a} <=> $data{$b}} keys %data) {
print $fruit . ": " . $data{$fruit} . "\n";
}
##
##
use strict;
use warnings;
use Data::Dumper;
use Encode qw(encode);
my $rupee = encode("UTF-8", chr(0x20B9));
print "\n$rupee"."19264/-\n";
##
##
BEGIN
{
no strict 'refs';
print Dumper(\%{"main::YAML::XS::"});
exit;
};
##
##
my $module = 'My::Module';
eval {
(my $file = $module) =~ s|::|/|g;
require $file . '.pm';
$module->import();
1;
} or do {
my $error = $@;
# ...
};
##
##
sub match_positions {
my ($regex, $string) = @_;
return if not $string =~ /$regex/;
return ($-[0], $+[0]);
}
##
##
sub match_all_positions {
my ($regex, $string) = @_;
my @ret;
while ($string =~ /$regex/g) {
push @ret, [ $-[0], $+[0] ];
}
return @ret
}