File Coverage

lib/PSGI/Hector/Response/Base.pm
Criterion Covered Total %
statement 26 32 81.2
branch 1 2 50.0
condition n/a
subroutine 7 9 77.7
pod 2 4 50.0
total 36 47 76.6


line stmt bran cond sub pod time code
1             #response base object for plugins
2             package PSGI::Hector::Response::Base;
3              
4             =pod
5              
6             =head1 NAME
7              
8             Response Base - Base object for view plugins
9              
10             =head1 SYNOPSIS
11              
12             use myResponse;
13             my $response = myResponse->new($hector);
14            
15             package myResponse;
16             use parent ("PSGI::Hector::Response::Base");
17              
18             =head1 DESCRIPTION
19              
20             This object should not be used directly, a new class should be created which inherits this one instead.
21              
22             All response plugins should override at least the display() method and they all a sub class of L.
23              
24             The module L will load the specified response plugin on script startup.
25              
26             =head1 METHODS
27              
28             =cut
29              
30 5     5   4530 use strict;
  5         8  
  5         128  
31 5     5   20 use warnings;
  5         7  
  5         113  
32 5     5   20 use parent qw(HTTP::Response PSGI::Hector::Base);
  5         7  
  5         20  
33             #########################################################
34             sub new{
35 8     8 1 29 my($class, $hector) = @_;
36 8 50       27 if(!defined($hector)){
37 0         0 die("No hector object given");
38             }
39 8         40 my $self = $class->SUPER::new(200, "OK"); #we dont care about the code or msg as they get removed later
40 8         383 $self->{'_hector'} = $hector; #so we can access the hector object FIXME
41 8         12 $self->{'_displayedHeader'} = 0; #flag set on first output
42 8         11 bless $self, $class;
43 8         13 return $self;
44             }
45             #########################################################
46              
47             =pod
48              
49             =head2 setCacheable($seconds)
50              
51             $response->setCacheable($seconds)
52              
53             Sets the page to be cached for the specified amount of seconds.
54              
55             =cut
56              
57             #########################################################
58             sub setCacheable{
59 0     0 1 0 my($self, $seconds) = @_;
60 0         0 $self->header("Cache-Control" => "max-age=$seconds, public");
61 0         0 return 1;
62             }
63             #########################################################
64             sub getHector{
65 0     0 0 0 my $self = shift;
66 0         0 return $self->{'_hector'};
67             }
68             #########################################################
69             sub display{
70 2     2 0 2 my $self = shift;
71 2         2 my @headers;
72 2         10 foreach my $field ($self->header_field_names){
73 2         73 push(@headers, $field => $self->header($field));
74             }
75 2         74 return [$self->code(), \@headers, [$self->content()]];
76             }
77             #########################################################
78             # private methods
79             #########################################################
80             sub _setDisplayedHeader{
81 1     1   2 my $self = shift;
82 1         1 $self->{'_displayedHeader'} = 1;
83 1         2 return 1;
84             }
85             #########################################################
86             sub _getDisplayedHeader{
87 2     2   2 my $self = shift;
88 2         6 return $self->{'_displayedHeader'};
89             }
90             ###########################################################
91              
92             =pod
93              
94             =head1 Provided classes
95              
96             In this package there are some responses already available for use:
97              
98             =over 4
99              
100             =item Raw
101              
102             See L for details.
103              
104             =item TemplateToolkit
105              
106             See L for details.
107              
108             =back
109              
110             =head1 Notes
111              
112             =head1 Author
113              
114             MacGyveR
115              
116             Development questions, bug reports, and patches are welcome to the above address.
117              
118             =head1 See Also
119              
120             =head1 Copyright
121              
122             Copyright (c) 2017 MacGyveR. All rights reserved.
123              
124             This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
125              
126             =cut
127              
128             #########################################################
129             return 1;