File Coverage

lib/Catalyst/Plugin/Server/XMLRPC/DispatchType/XMLRPCRegex.pm
Criterion Covered Total %
statement 24 35 68.6
branch 5 10 50.0
condition n/a
subroutine 4 5 80.0
pod 2 2 100.0
total 35 52 67.3


line stmt bran cond sub pod time code
1             package Catalyst::Plugin::Server::XMLRPC::DispatchType::XMLRPCRegex;
2              
3 6     6   110 use strict;
  6         91  
  6         98  
4 6     6   90 use base qw/Catalyst::DispatchType::Regex/;
  6         55  
  6         86  
5 6     6   94 use Text::SimpleTable;
  6         58  
  6         95  
6              
7             =head1 NAME
8            
9             Catalyst::Plugin::Server::XMLRPC::DispatchType::XMLRPCRegex - XMLRPCRegex DispatchType
10            
11             =head1 SYNOPSIS
12            
13             See L<Catalyst>.
14            
15             =head1 DESCRIPTION
16            
17             =head1 METHODS
18            
19             =head2 $self->list($c)
20            
21             Generates a nice debug-table containing the XMLRPCRegex methods.
22            
23             =cut
24              
25             sub list {
26 0     0 1 0     my ( $self, $c ) = @_;
27 0         0     my $re = Text::SimpleTable->new( [ 36, 'XMLRPCRegex' ], [ 37, 'Private' ] );
28 0         0     for my $regex ( @{ $self->{compiled} } ) {
  0         0  
29 0         0         my $action = $regex->{action};
30 0         0         $re->row( $regex->{path}, "/$action" );
31                 }
32 0         0     $c->log->debug( "Loaded XMLRPCRegex actions:\n" . $re->draw )
33 0 0       0       if ( @{ $self->{compiled} } );
34             }
35              
36             =head2 $self->register( $c, $action )
37            
38             Registers the XMLRPCPath actions into the dispatcher
39            
40             =cut
41              
42             sub register {
43 191     191 1 1816     my ( $self, $c, $action ) = @_;
44 191         2010     my $attrs = $action->attributes;
45 382 100       5527     my @register = map { @{ $_ || [] } } @{$attrs}{
  382         6829  
  191         2265  
46 191         1845                                             'XMLRPCRegex',
47                                                         'XMLRPCRegexp'
48                                                     };
49 191         1857     foreach
50 382 50       5182       my $r ( map { @{ $_ || [] } } @{$attrs}{
  382         7865  
  191         2380  
51                                                     'XMLRPCLocalRegex',
52                                                     'XMLRPCLocalRegexp'
53                                                 }
54                         )
55                 {
56 0 0       0         unless ( $r =~ s/^\^// ) { $r = "(?:.*?)$r"; }
  0         0  
57 0         0         push( @register, '^' . $action->namespace . '/' . $r );
58                 }
59              
60 191         3574     foreach my $r (@register) {
61 11         311         $self->register_path( $c, $r, $action );
62 11         261         $self->register_regex( $c, $r, $action );
63                 }
64 191 100       2211     return 1 if @register;
65 180         2214     return 0;
66             }
67              
68              
69              
70             =head1 AUTHOR
71            
72             Michiel Ootjers C<michiel@cpan.org>
73             Jos Boumans, C<kane@cpan.org>
74            
75             =head1 COPYRIGHT
76            
77             This program is free software, you can redistribute it and/or modify it under
78             the same terms as Perl itself.
79            
80             =cut
81              
82             1;
83