add perl version command pattern

README.md

@@ -11,7 +11,7 @@ Pattern | Description | C++ | Java | Python | PHP | Perl
 singleton | [DONE](./src/singleton/singleton.md) | [DONE](./src/singleton/cpp) | [DONE](./src/singleton/java) | [DONE](./src/singleton/python) | [DONE](./src/singleton/php) | [DONE](./src/singleton/perl)
 proxy | [DONE](./src/proxy/proxy.md) | [DONE](./src/proxy/cpp) | [DONE](./src/proxy/java) | [DONE](./src/proxy/python) | [DONE](./src/proxy/php) | [DONE](./src/proxy/perl)
 builder | [DONE](./src/builder/builder.md) | [DONE](./src/builder/cpp) | [DONE](./src/builder/java) | [DONE](./src/builder/python) | [DONE](./src/builder/php) | [DONE](./src/builder/perl)
-command | [DONE](./src/command/command.md) | [DONE](./src/command/cpp) | [DONE](./src/command/java) | [DONE](./src/command/python) | [DONE](./src/command/php)
+command | [DONE](./src/command/command.md) | [DONE](./src/command/cpp) | [DONE](./src/command/java) | [DONE](./src/command/python) | [DONE](./src/command/php) | [DONE](./src/command/perl)
 decorator | [DONE](./src/decorator/decorator.md) | [DONE](./src/decorator/cpp) | [DONE](./src/decorator/java) | [DONE](./src/decorator/python) | [DONE](./src/decorator/php) | [DONE](./src/decorator/perl)
 facade | [DONE](./src/facade/facade.md) | [DONE](./src/facade/cpp) | [DONE](./src/facade/java) | [DONE](./src/facade/python) | [DONE](./src/facade/php) | [DONE](./src/facade/perl)
 observer | [DONE](./src/observer/observer.md) | [DONE](./src/observer/cpp) | [DONE](./src/observer/java) | [DONE](./src/observer/python) | [DONE](./src/observer/php) | [DONE](./src/observer/perl)

src/command/perl/Command.pm

@@ -0,0 +1,13 @@
+package Command;
+
+sub new {
+	my ($class, $args) = @_;
+	my $self = {};
+	return bless $self, $class;
+}
+
+sub execute {
+	die "INTERFACE COMMAND CANNOT BE CALLED DIRECTLY\n";
+}
+
+1;

src/command/perl/Command/CopyCommand.pm

@@ -0,0 +1,19 @@
+package Command::CopyCommand;
+use parent Command;
+
+use strict;
+use warnings;
+
+sub new {
+	my ($class, $receiver) = @_;
+	my $self = $class->SUPER::new;
+	$self->{receiver} = $receiver;
+	return $self;
+}
+
+sub execute {
+	my $self = shift;
+	$self->{receiver}->copy;
+}
+
+1;

src/command/perl/Command/MacroCommand.pm

@@ -0,0 +1,20 @@
+package Command::MacroCommand;
+use parent Command;
+
+use strict;
+use warnings;
+
+sub new {
+	my ($class, $args) = @_;
+	return $class->SUPER::new($args);
+}
+
+sub add {
+	die "INTERFACE COMMAND CANNOT BE CALLED DIRECTLY\n";
+}
+
+sub remove {
+	die "INTERFACE COMMAND CANNOT BE CALLED DIRECTLY\n";
+}
+
+1;

src/command/perl/Command/MacroCommand/DemoMacroCommand.pm

@@ -0,0 +1,37 @@
+package Command::MacroCommand::DemoMacroCommand;
+use parent Command::MacroCommand;
+
+use strict;
+use warnings;
+
+sub new {
+	my ($class, $args) = @_;
+	my $self = $class->SUPER::new($args);
+	$self->{commands} = [];
+	return $self;
+}
+
+sub add {
+	my ($self, $command) = @_;
+	push $self->{commands}, $command;
+}
+
+sub remove {
+	my ($self, $command) = @_;
+	my $commands = $self->{commands};
+	my $i = 0;
+	for ($i = 0; $i < @$commands; ++$i) {
+		last if $command == $commands->[$i];
+	}
+	splice(@$commands, $i, 1) if $i != @$commands;
+}
+
+sub execute {
+	my $self = shift;
+	my $commands = $self->{commands};
+	foreach my $command (@$commands) {
+		$command->execute;
+	}
+}
+
+1;

src/command/perl/Command/PasteCommand.pm

@@ -0,0 +1,19 @@
+package Command::PasteCommand;
+use parent Command;
+
+use strict;
+use warnings;
+
+sub new {
+	my ($class, $receiver) = @_;
+	my $self = $class->SUPER::new;
+	$self->{receiver} = $receiver;
+	return $self;
+}
+
+sub execute {
+	my $self = shift;
+	$self->{receiver}->paste;
+}
+
+1;

src/command/perl/Invoker.pm

@@ -0,0 +1,19 @@
+package Invoker;
+
+use strict;
+use warnings;
+
+sub new {
+	my ($class, $command) = @_;
+	my $self = {
+		command => $command,
+	};
+	return bless $self, $class;
+}
+
+sub action {
+	my $self = shift;
+	$self->{command}->execute;
+}
+
+1;

src/command/perl/Receiver.pm

@@ -0,0 +1,30 @@
+package Receiver;
+
+use strict;
+use warnings;
+
+sub new {
+	my ($class, $args) = @_;
+	my $self = {
+		name => $args->{name},
+	};
+	return bless $self, $class;
+}
+
+sub name {
+	my ($self, $name) = @_;
+	$self->{name} = $name if defined $name;
+	return $self->{name};
+}
+
+sub copy {
+	my $self = shift;
+	print $self->name, " do copy action\n";
+}
+
+sub paste {
+	my $self = shift;
+	print $self->name, " do paste action\n";
+}
+
+1;

src/command/perl/test.pl

@@ -0,0 +1,24 @@
+#!/usr/bin/env perl
+# auther: oxnz
+# coding: utf-8
+
+use strict;
+use warnings;
+
+use Receiver;
+use Invoker;
+use Command::MacroCommand::DemoMacroCommand;
+use Command::PasteCommand;
+use Command::CopyCommand;
+
+my $receiver = Receiver->new({name => 'phppan'});
+my $pasteCmd = Command::PasteCommand->new($receiver);
+my $copyCmd = Command::CopyCommand->new($receiver);
+my $macroCmd = Command::MacroCommand::DemoMacroCommand->new;
+$macroCmd->add($copyCmd);
+$macroCmd->add($pasteCmd);
+my $invoker = Invoker->new($macroCmd);
+$invoker->action;
+$macroCmd->remove($copyCmd);
+$invoker = Invoker->new($macroCmd);
+$invoker->action;