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