Perl 6 Introduction

say 'hello world';

'hello world'.say;

# 文字列
my $name = 'John Doe';
say $name;

# 整数
my $age = 99;
say $age;

my $name = 'John Doe';
say $name.uc;
say $name.chars;
say $name.flip;

JOHN DOE
8
eoD nhoJ

my $age = 17;
say $age.is-prime;

True

my $age = 2.3;
say $age.numerator;
say $age.denominator;
say $age.nude;

23
10
(23 10)

my @animals = 'camel','llama','owl';
say @animals;

my @animals = 'camel','vicuña','llama';
say "The zoo contains " ~ @animals.elems ~ " animals";
say "The animals are: " ~ @animals;
say "I will adopt an owl for the zoo";
@animals.push("owl");
say "Now my zoo has: " ~ @animals;
say "The first animal we adopted was the " ~ @animals[0];
@animals.pop;
say "Unfortunately the owl got away and we're left with: " ~ @animals;
say "We're closing the zoo and keeping one animal only";
say "We're going to let go: " ~ @animals.splice(1,2) ~ " and keep the " ~ @animals;

The zoo contains 3 animals
The animals are: camel vicuña llama
I will adopt an owl for the zoo
Now my zoo has: camel vicuña llama owl
The first animal we adopted was the camel
Unfortunately the owl got away and we're left with: camel vicuña llama
We're closing the zoo and keeping one animal only
We're going to let go: vicuña llama and keep the camel

my %capitals = ('UK','London','Germany','Berlin');
say %capitals;

my %capitals = (UK => 'London', Germany => 'Berlin');
say %capitals;

my %capitals = (UK => 'London', Germany => 'Berlin');
%capitals.push: (France => 'Paris');
say %capitals.kv;
say %capitals.keys;
say %capitals.values;
say "The capital of France is: " ~ %capitals<France>;

(France Paris Germany Berlin UK London)
(France Germany UK)
(Paris Berlin London)
The capital of France is: Paris

my $var = 'Text';
say $var;
say $var.WHAT;

$var = 123;
say $var;
say $var.WHAT;

my Int $var = 'Text';
say $var;
say $var.WHAT;

my Int @array = 1,2,3;
say @array;
say @array.WHAT;

my Str @multilingual = "Hello","Salut","Hallo","您好","안녕하세요","こんにちは";
say @multilingual;
say @multilingual.WHAT;

my Str %capitals = (UK => 'London', Germany => 'Berlin');
say %capitals;
say %capitals.WHAT;

my Int %country-codes = (UK => 44, Germany => 49);
say %country-codes;
say %country-codes.WHAT;

my Int $var;
say $var.WHAT;    # (Int)
my $var2;
say $var2.WHAT;   # (Any)
$var2 = 1;
say $var2.WHAT;   # (Int)
$var2 = "Hello";
say $var2.WHAT;   # (Str)
$var2 = True;
say $var2.WHAT;   # (Bool)
$var2 = Nil;
say $var2.WHAT;   # (Any)

my $var=1;

{
  my Str $var = 'Text';
  say $var; # はアクセス可能です
}
say $var; # はアクセス可能ではありません。エラーを返します。

{
  my Str $var = 'Text';
  say $var;
}
my Int $var = 123;
say $var;

my Int $var = 123;
say $var;

my Int $var = 123;
say $var;
$var = 999;
say $var;

123
999

my Int $var := 123;
say $var;
$var = 999;
say $var;

123
Cannot assign to an immutable value

my $a;
my $b;
$b := $a;
$a = 7;
say $b;
$b = 8;
say $a;

7
8

my $age = 19;

if $age > 18 {
  say 'Welcome'
}

my $age = 19;

say 'Welcome' if $age > 18;

# 変数の値を変えて同じコードを実行
my $number-of-seats = 9;

if $number-of-seats <= 5 {
  say 'I am a sedan'
} elsif $number-of-seats <= 7 {
  say 'I am 7 seater'
} else {
  say 'I am a van'
}

my $clean-shoes = False;

if not $clean-shoes {
  say 'Clean your shoes'
}

my $clean-shoes = False;

unless $clean-shoes {
  say 'Clean your shoes'
}

my Int $var=1;

with $var {
  say 'Hello'
}

my Int $var;

with $var {
  say 'Hello'
}

my @array = [1,2,3];

for @array -> $array-item {
  say $array-item*100
}

my $var = 42;

given $var {
    when 0..50 { say 'Less than or equal to 50'}
    when Int { say "is an Int" }
    when 42  { say 42 }
    default  { say "huh?" }
}

my $var = 42;

given $var {
    when 0..50 { say 'Less than or equal to 50';proceed}
    when Int { say "is an Int";proceed}
    when 42  { say 42 }
    default  { say "huh?" }
}

loop (my $i=0; $i < 5; $i++) {
  say "The current number is $i"
}

my $name = 'Neo';
run 'echo', "hello $name";
shell "ls";

shell "dir";

say dir;              # カレントディレクトリのファイルとフォルダを表示する
say dir "/Documents"; # 指定されたディレクトリのファイルとフォルダを表示する

mkdir "newfolder";
rmdir "newfolder";

say "script123.pl6".IO.e;
say "folder123".IO.e;

say "script123.pl6".IO.d;
say "folder123".IO.d;

say "script123.pl6".IO.f;
say "folder123".IO.f;

sub alien-greeting {
  say "Hello earthlings";
}

alien-greeting;

sub say-hello (Str $name) {
    say "Hello " ~ $name ~ "!!!!"
}
say-hello "Paul";
say-hello "Paula";

multi greet($name) {
    say "Good morning $name";
}
multi greet($name, $title) {
    say "Good morning $title $name";
}

greet "Johnnie";
greet "Laura","Mrs.";

sub say-hello($name?) {
  with $name { say "Hello " ~ $name }
  else { say "Hello Human" }
}
say-hello;
say-hello("Laura");

sub say-hello($name="Matt") {
  say "Hello " ~ $name;
}
say-hello;
say-hello("Laura");

my @array = <1 2 3 4 5>;
sub squared($x) {
  $x ** 2
}
say map(&squared,@array);

(1 4 9 16 25)

my @array = <1 2 3 4 5>;
say map(-> $x {$x ** 2},@array);

my $squared = -> $x {
  $x ** 2
}
say $squared(9);

my @array = <7 8 9 0 1 2 4 3 5 6 7 8 9 >;
my @final-array = reverse(sort(unique(@array)));
say @final-array;

my @array = <7 8 9 0 1 2 4 3 5 6 7 8 9>;
my @final-array = @array.unique.sort.reverse;
say @final-array;

my @array = <7 8 9 0 1 2 4 3 5 6 7 8 9>;
@array ==> unique()
       ==> sort()
       ==> reverse()
       ==> my @final-array;
say @final-array;

まず `@array`で始まり 次に重複のないリストを返します
                      次にソートします
                      次にリバースします
                      次に結果を `@final-array` に格納します

my @array = <7 8 9 0 1 2 4 3 5 6 7 8 9>;
my @final-array-v2 <== reverse()
                   <== sort()
                   <== unique()
                   <== @array;
say @final-array-v2;

my @array = <0 1 2 3 4 5 6 7 8 9 10>;
sub is-even($var) { $var %% 2 };

say @array>>.is-prime;
say @array>>.&is-even;

my $var = 2;
if $var == 1|2|3 {
  say "The variable is 1 or 2 or 3"
}

my $lazylist = (1 ... 10);
say $lazylist;

my $lazylist = (1 ... Inf);
say $lazylist;

my $lazylist = (0,2 ... 10);
say $lazylist;

my $lazylist = (0, { $_ + 3 } ... 12);
say $lazylist;

class Human {
  has $name;
  has $age;
  has $sex;
  has $nationality;
}

my $john = Human.new(name => 'John', age => 23, sex => 'M', nationality => 'American');
say $john;

my class Human {

}

my $var = 7;
say $var;

my $var = 7;
sub sayvar {
  $var;
}
say sayvar;

class Human {
  has $!name;
  has $!age;
  has $!sex;
  has $!nationality;
}

my $john = Human.new(name => 'John', age => 23, sex => 'M', nationality => 'American');
say $john;

class Human {
  has $.name;
  has $.age;
  has $.sex;
  has $.nationality;
  # デフォルトのコンストラクタをオーバーライドする
  method new ($name,$age,$sex,$nationality) {
    self.bless(:$name,:$age,:$sex,:$nationality);
  }
}

my $john = Human.new('John',23,'M','American');
say $john;

class Human {
  has $.name;
  my $.counter = 0;
  method new($name) {
    Human.counter++;
    self.bless(:$name);
  }
}
my $a = Human.new('a');
my $b = Human.new('b');

say Human.counter;

class Human {
  has $.name;
  has $.age is rw;
}
my $john = Human.new(name => 'John', age => 21);
say $john.age;

$john.age = 23;
say $john.age;

class bar-chart {
  has Int @.bar-values;
  method plot {
    say @.bar-values;
  }
}

class line-chart {
  has Int @.line-values;
  method plot {
    say @.line-values;
  }
}

class combo-chart is bar-chart is line-chart {
}

my $actual-sales = bar-chart.new(bar-values => [10,9,11,8,7,10]);
my $forecast-sales = line-chart.new(line-values => [9,8,10,7,6,9]);

my $actual-vs-forecast = combo-chart.new(bar-values => [10,9,11,8,7,10],
                                         line-values => [9,8,10,7,6,9]);
say "Actual sales:";
$actual-sales.plot;
say "Forecast sales:";
$forecast-sales.plot;
say "Actual vs Forecast:";
$actual-vs-forecast.plot;

Actual sales:
[10 9 11 8 7 10]
Forecast sales:
[9 8 10 7 6 9]
Actual vs Forecast:
[10 9 11 8 7 10]

class bar-chart {
  has Int @.bar-values;
  method plot {
    say @.bar-values;
  }
}

class line-chart {
  has Int @.line-values;
  method plot {
    say @.line-values;
  }
}

class combo-chart is bar-chart is line-chart {
  method plot {
    say @.bar-values;
    say @.line-values;
  }
}

my $actual-sales = bar-chart.new(bar-values => [10,9,11,8,7,10]);
my $forecast-sales = line-chart.new(line-values => [9,8,10,7,6,9]);

my $actual-vs-forecast = combo-chart.new(bar-values => [10,9,11,8,7,10],
                                         line-values => [9,8,10,7,6,9]);
say "Actual sales:";
$actual-sales.plot;
say "Forecast sales:";
$forecast-sales.plot;
say "Actual vs Forecast:";
$actual-vs-forecast.plot;

Actual sales:
[10 9 11 8 7 10]
Forecast sales:
[9 8 10 7 6 9]
Actual vs Forecast:
[10 9 11 8 7 10]
[9 8 10 7 6 9]

role bar-chart {
  has Int @.bar-values;
  method plot {
    say @.bar-values;
  }
}

role line-chart {
  has Int @.line-values;
  method plot {
    say @.line-values;
  }
}

class combo-chart does bar-chart does line-chart {
  method plot {
    say @.bar-values;
    say @.line-values;
  }
}

my $actual-sales = bar-chart.new(bar-values => [10,9,11,8,7,10]);
my $forecast-sales = line-chart.new(line-values => [9,8,10,7,6,9]);

my $actual-vs-forecast = combo-chart.new(bar-values => [10,9,11,8,7,10],
                                         line-values => [9,8,10,7,6,9]);
say "Actual sales:";
$actual-sales.plot;
say "Forecast sales:";
$forecast-sales.plot;
say "Actual vs Forecast:";
$actual-vs-forecast.plot;

role bar-chart {
  has Int @.bar-values;
  method plot {
    say @.bar-values;
  }
}

role line-chart {
  has Int @.line-values;
  method plot {
    say @.line-values;
  }
}

class combo-chart does bar-chart does line-chart {
}

my $actual-sales = bar-chart.new(bar-values => [10,9,11,8,7,10]);
my $forecast-sales = line-chart.new(line-values => [9,8,10,7,6,9]);

my $actual-vs-forecast = combo-chart.new(bar-values => [10,9,11,8,7,10],
                                         line-values => [9,8,10,7,6,9]);
say "Actual sales:";
$actual-sales.plot;
say "Forecast sales:";
$forecast-sales.plot;
say "Actual vs Forecast:";
$actual-vs-forecast.plot;

===SORRY!===
Method 'plot' must be resolved by class combo-chart because it exists in multiple roles (line-chart, bar-chart)

class Human {
  has Str $.name;
  has Int $.age;
  method introduce-yourself {
    say 'Hi i am a human being, my name is ' ~ self.name;
  }
}

class Employee is Human {
  has Str $.company;
  has Int $.salary;
  method introduce-yourself {
    say 'Hi i am a employee, my name is ' ~ self.name ~ ' and I work at: ' ~ self.company;
  }
}

my $john = Human.new(name =>'John',age => 23,);
my $jane = Employee.new(name =>'Jane',age => 25,company => 'Acme',salary => 4000);

say $john.WHAT;
say $jane.WHAT;
say $john.^attributes;
say $jane.^attributes;
say $john.^methods;
say $jane.^methods;
say $jane.^parents;
if $jane ~~ Human {say 'Jane is a Human'};

my Str $name;
$name = "Joanna";
say "Hello " ~ $name;
say "How are you doing today?"

Hello Joanna
How are you doing today?

my Str $name;
$name = 123;
say "Hello " ~ $name;
say "How are you doing today?"

Type check failed in assignment to $name; expected Str but got Int
   in block <unit> at exceptions.pl6:2

my Str $name;
try {
  $name = 123;
  say "Hello " ~ $name;
  CATCH {
    default {
      say "Can you tell us your name again, we couldn't find it in the register.";
    }
  }
}
say "How are you doing today?";

Can you tell us your name again, we couldn't find it in the register.
How are you doing today?

try {
  # コードはここに
  # もし何かが失敗したなら下記のCATCHブロックに入ります
  # もし問題がなかったのなら下記のCATCHブロックは無視されます
  CATCH {
    default {
      # ここのコードは例外が投げられたときだけ評価されます
    }
  }
}

try {
  # コードはここに
  # もし何かが失敗したなら下記のCATCHブロックに入ります
  # もし問題がなかったのなら下記のCATCHブロックは無視されます
  CATCH {
    when X::AdHoc { # X::AdHoc型の例外が投げられたのなら何かを実行します }
    when X::IO { # X::IO型の例外が投げられたのなら何かを実行します }
    when X::OS { # X::OS型の例外が投げられたのなら何かを実行します }
    default { # 上記の型に該当しない例外が投げられたのなら何かを実行します }
  }
}

my Int $age = 21;
die "Error !";

my Int $age = 21;
X::AdHoc.new(payload => 'Error !').throw;

if 'Temperature: 13' ~~ m/ \: / {
    say "The string provided contains a colon :";
}

if 'Age = 13' ~~ m/ '=' / {
    say "The string provided contains an equal character = ";
}

if 'name@company.com' ~~ m/ "@" / {
    say "This is a valid email address because it contains an @ character";
}

if "John123" ~~ / \d / {
  say "This is not a valid name, numbers are not allowed";
} else {
  say "This is a valid name"
}
if "John-Doe" ~~ / \s / {
  say "This string contains whitespace";
} else {
  say "This string doesn't contain whitespace"
}

if "John123" ~~ / <:N> / {
  say "Contains a number";
} else {
  say "Doesn't contain a number"
}
if "John-Doe" ~~ / <:Lu> / {
  say "Contains an uppercase letter";
} else {
  say "Doesn't contain an upper case letter"
}
if "John-Doe" ~~ / <:Pd> / {
  say "Contains a dash";
} else {
  say "Doesn't contain a dash"
}

if 'abc' ~~ m/ a.c / {
    say "Match";
}
if 'a2c' ~~ m/ a.c / {
    say "Match";
}
if 'ac' ~~ m/ a.c / {
    say "Match";
  } else {
    say "No Match";
}

if 'ac' ~~ m/ a?c / {
    say "Match";
  } else {
    say "No Match";
}
if 'c' ~~ m/ a?c / {
    say "Match";
  } else {
    say "No Match";
}

if 'az' ~~ m/ a*z / {
    say "Match";
  } else {
    say "No Match";
}
if 'aaz' ~~ m/ a*z / {
    say "Match";
  } else {
    say "No Match";
}
if 'aaaaaaaaaaz' ~~ m/ a*z / {
    say "Match";
  } else {
    say "No Match";
}
if 'z' ~~ m/ a*z / {
    say "Match";
  } else {
    say "No Match";
}

if 'az' ~~ m/ a+z / {
    say "Match";
  } else {
    say "No Match";
}
if 'aaz' ~~ m/ a+z / {
    say "Match";
  } else {
    say "No Match";
}
if 'aaaaaaaaaaz' ~~ m/ a+z / {
    say "Match";
  } else {
    say "No Match";
}
if 'z' ~~ m/ a+z / {
    say "Match";
  } else {
    say "No Match";
}

if 'Rakudo is a Perl 6 compiler' ~~ m/:s Perl 6/ {
    say "The match is: " ~ $/;
    say "The string before the match is: " ~ $/.prematch;
    say "The string after the match is: " ~ $/.postmatch;
    say "The matching string starts at position: " ~ $/.from;
    say "The matching string ends at position: " ~ $/.to;
}

The match is: Perl 6
The string before the match is: Rakudo is a
The string after the match is:  compiler
The matching string starts at position: 12
The matching string ends at position: 18

my $email = 'john.doe@perl6.org';
my $regex = / <:L>+\.<:L>+\@<:L+:N>+\.<:L>+ /;

if $email ~~ $regex {
  say $/ ~ " is a valid email";
} else {
  say "This is not a valid email";
}

my $email = 'john.doe@perl6.org';
my regex many-letters { <:L>+ };
my regex dot { \. };
my regex at { \@ };
my regex many-letters-numbers { <:L+:N>+ };

if $email ~~ / <many-letters> <dot> <many-letters> <at> <many-letters-numbers> <dot> <many-letters> / {
  say $/ ~ " is a valid email";
} else {
  say "This is not a valid email";
}

use Digest::MD5;
my $password = "password123";
my $hashed-password = Digest::MD5.new.md5_hex($password);

say $hashed-password;

say "a";
say "\x0061";
say "\c[LATIN SMALL LETTER A]";

say "☺";
say "\x263a";
say "\c[WHITE SMILING FACE]";

say "á";
say "\x00e1";
say "\x0061\x0301";
say "\c[LATIN SMALL LETTER A WITH ACUTE]";

say "á".NFC;
say "á".NFD;
say "á".uniname;

NFC:0x<00e1>
NFD:0x<0061 0301>
LATIN SMALL LETTER A WITH ACUTE

my $Δ = 1;
$Δ++;
say $Δ;