File Coverage

lib/Catalyst/Plugin/Server.pm
Criterion Covered Total %
statement 48 49 98.0
branch 3 6 50.0
condition 2 6 33.3
subroutine 15 15 100.0
pod 0 2 0.0
total 68 78 87.2


line stmt bran cond sub pod time code
1             ### plugin implementation
2             {   package Catalyst::Plugin::Server;
3              
4 7     7   112     use strict;
  7         130  
  7         118  
5 7     7   149     use warnings;
  7         80  
  7         209  
6 7     7   115     use base qw/Class::Data::Inheritable/;
  7         65  
  7         101  
7              
8                 our $VERSION = '0.24';
9              
10                 my $ReqClass = 'Catalyst::Plugin::Server::Request';
11              
12                 __PACKAGE__->mk_classdata('server');
13              
14                 sub setup_dispatcher {
15 6     6 0 60         my $class = shift;
16 6         169         $class->NEXT::setup_dispatcher(@_);
17              
18             ### Load Server class
19 6         89         $class->server(Catalyst::Plugin::Server::Backend->new($class));
20              
21             ### Load our custom request_class
22 6         156         $class->request_class( $ReqClass );
23                 }
24              
25                 sub prepare_action {
26 21     21 0 1668         my $c = shift;
27              
28             ### since we have a custom request class now, we have to
29             ### be sure no one changed it from underneath us!
30 21 50       271         unless( UNIVERSAL::isa( $c->req, $ReqClass ) ) {
31 0         0             $c->log->warn( "Request class no longer inherits from " .
32                                         "$ReqClass -- this may break things!" );
33                     }
34 21         1206         $c->NEXT::prepare_action( @_ );
35                 }
36             }
37              
38             ### plugin backend object
39             {   package Catalyst::Plugin::Server::Backend;
40              
41 7     7   117     use strict;
  7         66  
  7         135  
42 7     7   102     use warnings;
  7         62  
  7         92  
43 7     7   122     use base qw/Class::Accessor::Fast/;
  7         115  
  7         101  
44              
45                 sub new {
46 6     6   59         my $class = shift;
47 6         60         my $c = shift;
48 6         162         my $self = $class->SUPER::new( @_ );
49                 }
50              
51                 sub register_server {
52 6     6   66         my ($self, $name, $class) = @_;
53 6 50 33     143         return unless ($name && $class);
54              
55 6         138         $self->mk_accessors($name);
56 6         77         $self->$name($class);
57                 }
58             }
59              
60             ### the request class addition ###
61             {   package Catalyst::Plugin::Server::Request;
62              
63 7     7   110     use strict;
  7         64  
  7         91  
64 7     7   122     use warnings;
  7         66  
  7         89  
65 7     7   3032     use Data::Dumper;
  7         77  
  7         140  
66              
67 7     7   104     use base qw/Catalyst::Request Class::Accessor::Fast/;
  7         64  
  7         95  
68              
69                 *params = *parameters;
70              
71                 sub register_server {
72 21     21   1631         my ($self, $name, $class) = @_;
73 21 50 33     408         return unless ($name && $class);
74              
75 21         343         $self->mk_accessors($name);
76 21         1683         $self->$name($class);
77                 }
78             }
79              
80             1;
81              
82             __END__
83            
84             =head1 NAME
85            
86             Catalyst::Plugin::Server - Base Server plugin for RPC-able protocols
87            
88             =head1 SYNOPSIS
89            
90             use Catalyst qw/
91             Server
92             Server::XMLRPC
93             /;
94            
95             MyAPP->register_server('soap', $blessed_reference);
96            
97            
98             =head1 DESCRIPTION
99            
100             Base plugin for XMLRPC and our future SOAP server. For further information,
101             see one of the Server plugins
102            
103             =head1 SEE ALSO
104            
105             L<Catalyst::Plugin::Server::XMLRPC>, L<Catalyst::Manual>,
106             L<Catalyst::Request>, L<Catalyst::Response>, L<RPC::XML>,
107             C<bin/rpc_client>
108            
109             =head1 AUTHORS
110            
111             Jos Boumans (kane@cpan.org)
112            
113             Michiel Ootjers (michiel@cpan.org)
114            
115             =head1 BUG REPORTS
116            
117             Please submit all bugs regarding C<Catalyst::Plugin::Server> to
118             C<bug-catalyst-plugin-server@rt.cpan.org>
119            
120             =head1 LICENSE
121            
122             This library is free software, you can redistribute it and/or modify
123             it under the same terms as Perl itself.
124            
125             =cut
126