# Perl Test # By saul-bt # PUBLIC DOMAIN use strict; use warnings; ## REFERENCES ## my @colors = ("red", "green", "blue"); # '\' can be used to get a reference my $colorsRef = \@colors; my %superHash = ( "colors" => $colorsRef, # Also you can create an anonymous # array with '[]' ({} for hashes) # that returns the reference "numbers" => [1, 2, 3] ); # Now the hash stores something like # this: ("colors", ARRAY(0x...), # "numbers", ARRAY(0x...)) # And you can access these arrays with: print qq(@{$superHash{"colors"}}\n); # To print an element: print qq(${$superHash{"numbers"}}[0]\n); print $superHash{"colors"} -> [0], "\n"; # Size of array: print scalar @{$superHash{"colors"}}; ## ARRAYS ## %meh1 = (num => 0, val => 4); %meh2 = ( num => 1, val => 3 ); @mehs = (\%meh1, \%meh2); print $mehs[0]{val}; ## HANDLERS & HEREDOC ## print "What's your name? "; $name = ; chomp($name); print <; chomp($place); print <) { print $line; } print "What are you looking for? "; $numResults = 0; $word = ; chomp($word); for $line (<>) { if ($line =~ m/\b$word\b/i) { $numResults += 1; print "[$word FOUND]> $line\n"; next; } print $line; } print "\n\n=== There are $numResults coincidences ==="; ## SCRIPT ARGUMENTS ## $nargs = $#ARGV + 1; print "There are $nargs arguments:\n"; for $arg (@ARGV) { print "- $arg\n"; } ## REGEX STUFF ## $string = "Perl is cool"; if ($string =~ m/[Pp]erl/) { print "Yeah"; } elsif ($string =~ m(perl)i) { print "Sad"; } else { print "MEH"; } # From my dummy recreation of printf sub checkTypes { my @percents = @{scalar(shift)}; my @args = @{scalar(shift)}; my $size = scalar(@percents); foreach my $n (0..$size - 1) { my $currArg = $args[$n]; my $currFormat = substr($percents[$n],-1); $currFormat eq 's' && $currArg =~ m/^\D+$/ || $currFormat =~ m/[dx]/ && $currArg =~ m/^\d+$/ || $currFormat eq 'f' && $currArg =~ m/^\d+(?:\.\d+)?$/ or die "'$currArg' can't be formatted as '$currFormat'"; } } ## WEIRD STUFF (JAPH) ## # VMS <3 not exp log srand xor s qq qx xor s x x length uc ord and print chr ord for qw q join use sub tied qx xor eval xor print qq q q xor int eval lc q m cos and print chr ord for qw y abs ne open tied hex exp ref y m xor scalar srand print qq q q xor int eval lc qq y sqrt cos and print chr ord for qw x printf each return local x y or print qq s s and eval q s undef or oct xor time xor ref print chr int ord lc foreach qw y hex alarm chdir kill exec return y s gt sin sort split @P=split//,".URRUU\c8R";@d=split//,"\nrekcah xinU / lreP rehtona tsuJ";sub p{ @p{"r$p","u$p"}=(P,P);pipe"r$p","u$p";++$p;($q*=2)+=$f=!fork;map{$P=$P[$f^ord ($p{$_})&6];$p{$_}=/ ^$P/ix?$P:close$_}keys%p}p;p;p;p;p;map{$p{$_}=~/^[P.]/&& close$_}%p;wait until$?;map{/^r/&&<$_>}%p;$_=$d[$q];sleep rand(2)if/\S/;print ''=~('(?{'.('-)@.)@_*([]@!@/)(@)@-@),@(@@+@)' ^'][)@]`}`]()`@.@]@%[`}%[@`@!#@%[').',"})')