tests/syntax-tests/source/Perl/test.pl · bat

git.iko.soy/bat

on 7a7bb80 help sign in

bat/tests/syntax-tests/source/Perl/test.pl

157 lines 3.3 kB history raw

1# Perl Test

2# By saul-bt

3# PUBLIC DOMAIN

5use strict;

6use warnings;

8## REFERENCES ##

9my @colors = ("red", "green", "blue");

11# '\' can be used to get a reference

12my $colorsRef = \@colors;

14my %superHash = (

15 "colors" => $colorsRef,

16 # Also you can create an anonymous

17 # array with '[]' ({} for hashes)

18 # that returns the reference

19 "numbers" => [1, 2, 3]

20);

22# Now the hash stores something like

23# this: ("colors", ARRAY(0x...),

24# "numbers", ARRAY(0x...))

26# And you can access these arrays with:

27print qq(@{$superHash{"colors"}}\n);

29# To print an element:

30print qq(${$superHash{"numbers"}}[0]\n);

31print $superHash{"colors"} -> [0], "\n";

33# Size of array:

34print scalar @{$superHash{"colors"}};

37## ARRAYS ##

38%meh1 = (num => 0, val => 4);

39%meh2 = (

40 num => 1,

41 val => 3

42);

44@mehs = (\%meh1, \%meh2);

46print $mehs[0]{val};

49## HANDLERS & HEREDOC ##

50print "What's your name? ";

51$name = <STDIN>;

52chomp($name);

54print <<WELCOME;

56Hi $name, Where are you from?

57WELCOME

59$place = <STDIN>;

60chomp($place);

62print <<GOODBYE;

64Oh, you are $name from $place...

65I hear that $place is a beautiful place.

66It's nice meet people like you $name.

67I hope to see you soon :)

69Bye $name.

70GOODBYE

72open (content, "<", "file.txt");

74for $line (<content>) {

75 print $line;

76}

78print "What are you looking for? ";

79$numResults = 0;

80$word = <STDIN>;

81chomp($word);

83for $line (<>) {

84 if ($line =~ m/\b$word\b/i) {

85 $numResults += 1;

86 print "[$word FOUND]> $line\n";

87 next;

88 }

89 print $line;

90}

92print "\n\n=== There are $numResults coincidences ===";

95## SCRIPT ARGUMENTS ##

96$nargs = $#ARGV + 1;

98print "There are $nargs arguments:\n";

100for $arg (@ARGV) {

101 print "- $arg\n";

102}

103

104## REGEX STUFF ##

105$string = "Perl is cool";

106

107if ($string =~ m/[Pp]erl/) {

108 print "Yeah";

109}

110elsif ($string =~ m(perl)i) {

111 print "Sad";

112}

113else {

114 print "MEH";

115}

116

117# From my dummy recreation of printf

118sub checkTypes {

119 my @percents = @{scalar(shift)};

120 my @args = @{scalar(shift)};

121 my $size = scalar(@percents);

122

123 foreach my $n (0..$size - 1) {

124 my $currArg = $args[$n];

125 my $currFormat = substr($percents[$n],-1);

126

127 $currFormat eq 's' && $currArg =~ m/^\D+$/ ||

128 $currFormat =~ m/[dx]/ && $currArg =~ m/^\d+$/ ||

129 $currFormat eq 'f' && $currArg =~ m/^\d+(?:\.\d+)?$/ or

130 die "'$currArg' can't be formatted as '$currFormat'";

131 }

132}

133

134## WEIRD STUFF (JAPH) ##

135# VMS <3

136not exp log srand xor s qq qx xor

137s x x length uc ord and print chr

138ord for qw q join use sub tied qx

139xor eval xor print qq q q xor int

140eval lc q m cos and print chr ord

141for qw y abs ne open tied hex exp

142ref y m xor scalar srand print qq

143q q xor int eval lc qq y sqrt cos

144and print chr ord for qw x printf

145each return local x y or print qq

146s s and eval q s undef or oct xor

147time xor ref print chr int ord lc

148foreach qw y hex alarm chdir kill

149exec return y s gt sin sort split

150

151@P=split//,".URRUU\c8R";@d=split//,"\nrekcah xinU / lreP rehtona tsuJ";sub p{

152@p{"r$p","u$p"}=(P,P);pipe"r$p","u$p";++$p;($q*=2)+=$f=!fork;map{$P=$P[$f^ord

153($p{$_})&6];$p{$_}=/ ^$P/ix?$P:close$_}keys%p}p;p;p;p;p;map{$p{$_}=~/^[P.]/&&

154close$_}%p;wait until$?;map{/^r/&&<$_>}%p;$_=$d[$q];sleep rand(2)if/\S/;print

155

156''=~('(?{'.('-)@.)@_*([]@!@/)(@)@-@),@(@@+@)'

157^'][)@]`}`]()`@.@]@%[`}%[@`@!#@%[').',"})')