blib/lib/Cache/Memcached/Fast/CGI.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 15 | 46 | 32.6 |
branch | n/a | ||
condition | 0 | 3 | 0.0 |
subroutine | 5 | 12 | 41.6 |
pod | 3 | 7 | 42.8 |
total | 23 | 68 | 33.8 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package Cache::Memcached::Fast::CGI; | ||||||
2 | |||||||
3 | 1 | 1 | 30578 | use warnings; | |||
1 | 2 | ||||||
1 | 44 | ||||||
4 | 1 | 1 | 7 | use strict; | |||
1 | 3 | ||||||
1 | 56 | ||||||
5 | |||||||
6 | =head1 NAME | ||||||
7 | |||||||
8 | Cache::Memcached::Fast::CGI - Capture the STDOUT for Memcached in a pure cgi program! | ||||||
9 | |||||||
10 | =head1 VERSION | ||||||
11 | |||||||
12 | Version 0.06 | ||||||
13 | |||||||
14 | =cut | ||||||
15 | |||||||
16 | our $VERSION = '0.06'; | ||||||
17 | |||||||
18 | 1 | 1 | 1364 | use Cache::Memcached::Fast; | |||
1 | 7982 | ||||||
1 | 32 | ||||||
19 | 1 | 1 | 1020 | use IO::Capture::Stdout; | |||
1 | 3977 | ||||||
1 | 29 | ||||||
20 | |||||||
21 | 1 | 1 | 8 | use Exporter; | |||
1 | 3 | ||||||
1 | 466 | ||||||
22 | our @ISA = qw(Exporter); | ||||||
23 | our @EXPORT = qw(setup get add start end auto_end); | ||||||
24 | our @EXPORT_ok = qw(); | ||||||
25 | |||||||
26 | sub new { | ||||||
27 | 0 | 0 | 0 | my $class = shift; | |||
28 | 0 | 0 | $class = ref $class || $class; | ||||
29 | 0 | my $self ={}; | |||||
30 | 0 | bless $self,$class; | |||||
31 | |||||||
32 | 0 | $self->{'cmf'} = Cache::Memcached::Fast->new(@_); | |||||
33 | 0 | $self->{'ics'} = new IO::Capture::Stdout; | |||||
34 | |||||||
35 | 0 | return $self; | |||||
36 | } | ||||||
37 | |||||||
38 | sub setup { | ||||||
39 | 0 | 0 | 0 | my $self = shift; | |||
40 | 0 | my %set = @_; | |||||
41 | 0 | while(my($k,$v) = each %set){ | |||||
42 | 0 | $self -> {$k} = $v; | |||||
43 | } | ||||||
44 | } | ||||||
45 | |||||||
46 | sub get { | ||||||
47 | 0 | 0 | 0 | my $self = shift; | |||
48 | 0 | my $key = shift; | |||||
49 | 0 | my $value = $self->{'cmf'}->get($key); | |||||
50 | 0 | return $value; | |||||
51 | } | ||||||
52 | |||||||
53 | sub add { | ||||||
54 | 0 | 0 | 1 | my $self = shift; | |||
55 | 0 | $self->{'cmf'}->add(@_); | |||||
56 | 0 | return 1; | |||||
57 | } | ||||||
58 | |||||||
59 | sub start { | ||||||
60 | 0 | 0 | 0 | my $self = shift; | |||
61 | 0 | $self->{'ics'} -> start(); | |||||
62 | } | ||||||
63 | |||||||
64 | sub end { | ||||||
65 | 0 | 0 | 1 | my $self = shift; | |||
66 | 0 | $self->{'ics'} -> stop(); | |||||
67 | 0 | my $re = join '',$self->{'ics'}->read(); | |||||
68 | 0 | return $re; | |||||
69 | } | ||||||
70 | |||||||
71 | sub auto_end { | ||||||
72 | 0 | 0 | 1 | my $self = shift; | |||
73 | 0 | my $key = shift; | |||||
74 | 0 | my $time = shift; | |||||
75 | 0 | $self->{'ics'} -> stop(); | |||||
76 | 0 | my $re = join '',$self->{'ics'}->read(); | |||||
77 | 0 | $self->{'cmf'}->add($key,$re,$time); | |||||
78 | 0 | print $re; | |||||
79 | } | ||||||
80 | |||||||
81 | |||||||
82 | =head1 SYNOPSIS | ||||||
83 | |||||||
84 | use Cache::Memcached::Fast::CGI; | ||||||
85 | |||||||
86 | my $cmfc = Cache::Memcached::Fast::CGI->new({ | ||||||
87 | servers => ['localhost:11211'], | ||||||
88 | connect_timeout => 0.3 | ||||||
89 | ## ... | ||||||
90 | }); | ||||||
91 | |||||||
92 | my $key = $ENV{'SCRIPT_FILENAME'}.'?'.$ENV{'QUERY_STRING'}; | ||||||
93 | |||||||
94 | ## Retrieve values | ||||||
95 | my $value = $cmfc->get($key); | ||||||
96 | print $value and exit if $value; | ||||||
97 | |||||||
98 | ## Start capture | ||||||
99 | $cmfc->start(); | ||||||
100 | |||||||
101 | print "Content-type: text/html;charset=utf-8\n\n"; | ||||||
102 | print ""; | ||||||
103 | print "hello world -- 1 "; |
||||||
104 | ## ... | ||||||
105 | print "hello world -- 2 "; |
||||||
106 | print ""; | ||||||
107 | |||||||
108 | ## Automatic end of the capture | ||||||
109 | $cmfc->auto_end($key); | ||||||
110 | |||||||
111 | exit; | ||||||
112 | |||||||
113 | |||||||
114 | =head1 SUBROUTINES/METHODS | ||||||
115 | |||||||
116 | =head2 add | ||||||
117 | |||||||
118 | # Add the key and valuse into memcahced | ||||||
119 | $cmfc->add($key,$value,$time); | ||||||
120 | |||||||
121 | =head2 end | ||||||
122 | |||||||
123 | ## End capture | ||||||
124 | my $captured = $cmfc->end(); | ||||||
125 | |||||||
126 | =head3 auto_end | ||||||
127 | |||||||
128 | ## Automatic end of the capture | ||||||
129 | $cmfc->auto_end($key,$time); | ||||||
130 | |||||||
131 | =head1 AUTHOR | ||||||
132 | |||||||
133 | =HITSU, C<< |
||||||
134 | |||||||
135 | =head1 BUGS | ||||||
136 | |||||||
137 | Please report any bugs or feature requests to C |
||||||
138 | the web interface at L |
||||||
139 | automatically be notified of progress on your bug as I make changes. | ||||||
140 | |||||||
141 | |||||||
142 | |||||||
143 | |||||||
144 | =head1 SUPPORT | ||||||
145 | |||||||
146 | You can find documentation for this module with the perldoc command. | ||||||
147 | |||||||
148 | perldoc Cache::Memcached::Fast::CGI | ||||||
149 | |||||||
150 | |||||||
151 | You can also look for information at: | ||||||
152 | |||||||
153 | =over 4 | ||||||
154 | |||||||
155 | =item * RT: CPAN's request tracker | ||||||
156 | |||||||
157 | L |
||||||
158 | |||||||
159 | =item * AnnoCPAN: Annotated CPAN documentation | ||||||
160 | |||||||
161 | L |
||||||
162 | |||||||
163 | =item * CPAN Ratings | ||||||
164 | |||||||
165 | L |
||||||
166 | |||||||
167 | =item * Search CPAN | ||||||
168 | |||||||
169 | L |
||||||
170 | |||||||
171 | =back | ||||||
172 | |||||||
173 | |||||||
174 | =head1 ACKNOWLEDGEMENTS | ||||||
175 | |||||||
176 | |||||||
177 | =head1 LICENSE AND COPYRIGHT | ||||||
178 | |||||||
179 | Copyright 2010 =Hitsu Bunnu. | ||||||
180 | |||||||
181 | This program is free software; you can redistribute it and/or modify it | ||||||
182 | under the terms of either: the GNU General Public License as published | ||||||
183 | by the Free Software Foundation; or the Artistic License. | ||||||
184 | |||||||
185 | See http://dev.perl.org/licenses/ for more information. | ||||||
186 | |||||||
187 | |||||||
188 | =cut | ||||||
189 | |||||||
190 | 1; |