File Coverage

blib/lib/Catalyst/Plugin/XMLRPC/DispatchType/XMLRPC.pm
Criterion Covered Total %
statement 18 27 66.7
branch 4 6 66.7
condition 2 2 100.0
subroutine 4 6 66.7
pod 3 3 100.0
total 31 44 70.5


line stmt bran cond sub pod time code
1             package Catalyst::Plugin::XMLRPC::DispatchType::XMLRPC;
2              
3 1     1   15 use strict;
  1         10  
  1         16  
4 1     1   17 use base qw/Catalyst::DispatchType/;
  1         10  
  1         15  
5 1     1   16 use Text::SimpleTable;
  1         10  
  1         51  
6              
7             =head1 NAME
8            
9             Catalyst::Plugin::XMLRPC::DispatchType::XMLRPC - XMLRPC DispatchType
10            
11             =head1 SYNOPSIS
12            
13             See L<Catalyst::Plugin::XMLRPC>.
14            
15             =head1 DESCRIPTION
16            
17             =head1 METHODS
18            
19             =head2 $self->list($c)
20            
21             Debug output for XMLRPC dispatch points
22            
23             =cut
24              
25             sub list {
26 0     0 1 0     my ( $self, $c ) = @_;
27 0         0     my $methods = Text::SimpleTable->new( [ 36, 'Method' ], [ 37, 'Private' ] );
28 0         0     for my $method ( sort keys %{ $self->{methods} } ) {
  0         0  
29 0         0         my $action = $self->{methods}->{$method};
30 0         0         $methods->row( "$method", "/$action" );
31                 }
32 0         0     $c->log->debug( "Loaded XMLRPC Methods:\n" . $methods->draw )
33 0 0       0       if ( keys %{ $self->{methods} } );
34             }
35              
36             =head2 $self->match($c)
37            
38             Do nothing
39            
40             =cut
41              
42 0     0 1 0 sub match { return 0 }
43              
44             =head2 $self->register( $c, $action )
45            
46             Call register_path for every path attribute in the given $action.
47            
48             =cut
49              
50             sub register {
51 14     14 1 131     my ( $self, $c, $action ) = @_;
52              
53 14 100       107     my @register = @{ $action->attributes->{XMLRPC} || [] };
  14         167  
54              
55 14         275     for my $method (@register) {
56 2   100     25         $method ||= "$action";
57 2         25         $method =~ s#/#.#g;
58 2         26         $self->{methods}{$method} = $action;
59                 }
60              
61 14 100       195     return 1 if @register;
62 12         145     return 0;
63             }
64              
65             =head1 AUTHOR
66            
67             Sebastian Riedel, C<sri@cpan.org>
68            
69             =head1 COPYRIGHT
70            
71             This program is free software, you can redistribute it and/or modify it under
72             the same terms as Perl itself.
73            
74             =cut
75              
76             1;
77