File Coverage

blib/lib/Lim/Component/Server.pm
Criterion Covered Total %
statement 42 56 75.0
branch 4 20 20.0
condition 1 6 16.6
subroutine 13 14 92.8
pod 5 5 100.0
total 65 101 64.3


line stmt bran cond sub pod time code
1             package Lim::Component::Server;
2              
3 3     3   25 use common::sense;
  3         8  
  3         32  
4 3     3   161 use Carp;
  3         6  
  3         260  
5              
6 3     3   21 use Log::Log4perl ();
  3         9  
  3         66  
7 3     3   19 use Scalar::Util qw(blessed);
  3         6  
  3         155  
8              
9 3     3   20 use Lim ();
  3         7  
  3         49  
10 3     3   19 use Lim::RPC ();
  3         8  
  3         139  
11 3     3   24 use Lim::Error ();
  3         5  
  3         1491  
12              
13             =encoding utf8
14              
15             =head1 NAME
16              
17             ...
18              
19             =head1 VERSION
20              
21             See L for version.
22              
23             =cut
24              
25             our $VERSION = $Lim::VERSION;
26              
27             =head1 SYNOPSIS
28              
29             ...
30              
31             =head1 SUBROUTINES/METHODS
32              
33             =head2 new
34              
35             =cut
36              
37             sub new {
38 2     2 1 8 my $this = shift;
39 2   33     20 my $class = ref($this) || $this;
40 2         25 my $self = {
41             logger => Log::Log4perl->get_logger
42             };
43 2         1205 bless $self, $class;
44              
45 2         5 eval {
46 2         18 $self->Init(@_);
47             };
48 2 50       9 if ($@) {
49 0 0       0 Lim::WARN and $self->{logger}->warn('Unable to initialize module '.$class.': '.$@);
50 0         0 return;
51             }
52            
53 2 50       15 Lim::OBJ_DEBUG and $self->{logger}->debug('new ', __PACKAGE__, ' ', $self);
54 2         1804 $self;
55             }
56              
57             sub DESTROY {
58 2     2   4237 my ($self) = @_;
59 2 50       13 Lim::OBJ_DEBUG and $self->{logger}->debug('destroy ', __PACKAGE__, ' ', $self);
60            
61 2         1213 $self->Destroy;
62             }
63              
64             =head2 Init
65              
66             =cut
67              
68 2     2 1 6 sub Init {
69             }
70              
71             =head2 Destroy
72              
73             =cut
74              
75 2     2 1 19 sub Destroy {
76             }
77              
78             =head2 Successful
79              
80             =cut
81              
82             sub Successful {
83 2     2 1 8 my ($self, $cb, $data) = @_;
84            
85 2         7 eval {
86 2         52 Lim::RPC::R($cb, $data);
87             };
88 2 50       19 if ($@) {
89 0 0         Lim::WARN and $self->{logger}->warn('data validation failed: ', $@);
90 0 0         Lim::DEBUG and eval {
91 3     3   1203 use Data::Dumper;
  3         7216  
  3         9027  
92 0           $self->{logger}->debug(Dumper($data));
93 0           $self->{logger}->debug(Dumper($cb->call_def->{out}));
94             };
95 0           Lim::RPC::R($cb, Lim::Error->new());
96             }
97             }
98              
99             =head2 Error
100              
101             =cut
102              
103             sub Error {
104 0     0 1   my ($self, $cb, $error, @rest) = @_;
105            
106 0 0 0       if (blessed($error) and $error->isa('Lim::Error')) {
    0          
107 0           Lim::RPC::R($cb, $error);
108             }
109             elsif (defined $error) {
110 0 0         if (scalar @rest) {
111 0           $error .= join('', @rest);
112             }
113 0           Lim::RPC::R($cb, Lim::Error->new(module => $self, message => $error));
114             }
115             else {
116 0           Lim::RPC::R($cb, Lim::Error->new(module => $self));
117             }
118             }
119              
120             =head1 AUTHOR
121              
122             Jerry Lundström, C<< >>
123              
124             =head1 BUGS
125              
126             Please report any bugs or feature requests to L.
127              
128             =head1 SUPPORT
129              
130             You can find documentation for this module with the perldoc command.
131              
132             perldoc Lim
133              
134             You can also look for information at:
135              
136             =over 4
137              
138             =item * Lim issue tracker (report bugs here)
139              
140             L
141              
142             =back
143              
144             =head1 ACKNOWLEDGEMENTS
145              
146             =head1 LICENSE AND COPYRIGHT
147              
148             Copyright 2012-2013 Jerry Lundström.
149              
150             This program is free software; you can redistribute it and/or modify it
151             under the terms of either: the GNU General Public License as published
152             by the Free Software Foundation; or the Artistic License.
153              
154             See http://dev.perl.org/licenses/ for more information.
155              
156              
157             =cut
158              
159             1; # End of Lim::RPC::Base