1package Net::RabbitFoot::Cmd::Role::Command;
2
3use FindBin;
4use Net::RabbitFoot;
5
6use Moose::Role;
7requires qw(_run);
8
9has spec => (
10    isa => 'Str',
11    is  => 'rw',
12    default       => '',
13    metaclass     => 'MooseX::Getopt::Meta::Attribute',
14    cmd_aliases   => 's',
15    documentation => 'AMQP specification',
16);
17
18has host => (
19    isa => 'Str',
20    is  => 'rw',
21    default       => 'localhost',
22    metaclass     => 'MooseX::Getopt::Meta::Attribute',
23    cmd_aliases   => 'H',
24    documentation => 'host name or ip address',
25);
26
27has port => (
28    isa => 'Int',
29    is  => 'rw',
30    default       => 5672,
31    metaclass     => 'MooseX::Getopt::Meta::Attribute',
32    cmd_aliases   => 'P',
33    documentation => 'port number',
34);
35
36has user => (
37    isa => 'Str',
38    is  => 'rw',
39    default       => 'guest',
40    metaclass     => 'MooseX::Getopt::Meta::Attribute',
41    cmd_aliases   => 'u',
42    documentation => 'user name',
43);
44
45has pass => (
46    isa => 'Str',
47    is  => 'rw',
48    default       => 'guest',
49    metaclass     => 'MooseX::Getopt::Meta::Attribute',
50    cmd_aliases   => 'p',
51    documentation => 'password',
52);
53
54has vhost => (
55    isa => 'Str',
56    is  => 'rw',
57    default       => '/',
58    metaclass     => 'MooseX::Getopt::Meta::Attribute',
59    cmd_aliases   => 'v',
60    documentation => 'virtual host',
61);
62
63has verbose => (
64    isa => 'Bool',
65    is  => 'rw',
66    metaclass     => 'MooseX::Getopt::Meta::Attribute',
67    cmd_aliases   => 'V',
68    documentation => 'Verbose mode',
69);
70
71no Moose::Role;
72
73sub validate_args {
74    my ($self, $opt, $args) = @_;
75
76    for my $method ($self->meta->get_all_methods) {
77        next if $method->name !~ /^_validate_/;
78        eval {$method->execute($self);};
79        die $self->usage_error($@) if $@;
80    }
81}
82
83sub _validate_spec {
84    my ($self,) = @_;
85
86    die 'spec', "\n" if !-f $self->spec;
87}
88
89sub _validate_vhost {
90    my ($self,) = @_;
91
92    die 'vhost', "\n"
93        if    255 < length($self->vhost)
94           || $self->vhost !~ m{^[a-zA-Z0-9/\-_]+$};
95}
96
97sub _check_queue {
98    my ($self,) = @_;
99
100    die 'queue', "\n"
101        if    255 < length($self->queue)
102           || $self->queue !~ m{^[a-zA-Z0-9/\-_.:=+]+$};
103}
104
105sub _check_shortstr {
106    my ($self, $arg,) = @_;
107
108    die $arg, "\n"
109        if    255 < length($self->$arg)
110           || $self->$arg !~ m{^[a-zA-Z0-9-_.:]+$};
111}
112
113sub execute {
114    my $self = shift;
115    my ($opt, $args,) = @_;
116
117    my $rf_closed = AnyEvent->condvar;
118    my $rf = Net::RabbitFoot->new(
119        verbose => $self->verbose,
120    )->load_xml_spec(
121        $self->spec,
122    )->connect(
123        (map {$_ => $self->$_} qw(host port user pass vhost)),
124        timeout  => 5,
125        on_close => sub {
126            my $w; $w = AnyEvent->idle(cb => sub {
127                undef $w;
128                $self->_close(shift);
129                $rf_closed->send;
130            });
131        },
132    );
133
134    my $ch_closed = AnyEvent->condvar;
135    my $ch = $rf->open_channel(
136        on_close => sub {
137            my $w; $w = AnyEvent->idle(cb => sub {
138                undef $w;
139                $self->_close(shift);
140                $ch_closed->send;
141                $rf->close;
142            });
143        },
144    );
145
146    $self->_run($ch, @_,);
147
148    $ch->close;
149    $rf->close;
150    $ch_closed->recv;
151    $rf_closed->recv;
152    return;
153}
154
155sub _close {
156    my $self = shift;
157    my $method_frame = shift->method_frame;
158    print $method_frame->reply_code, ' ', $method_frame->reply_text, "\n";
159    return;
160}
161
1621;
163
164