/
TailLog.pm
321 lines (237 loc) · 8.46 KB
/
TailLog.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
use 5.006; # our
use strict;
use warnings;
package CPAN::Testers::TailLog;
our $VERSION = '0.001001';
our $DISTNAME = 'CPAN-Testers-TailLog';
# ABSTRACT: Extract recent test statuses from metabase log
# AUTHORITY
sub new {
my $buildargs = { ref $_[1] ? %{ $_[1] } : @_[ 1 .. $#_ ] };
my $class = ref $_[0] ? ref $_[0] : $_[0];
my $self = bless $buildargs, $class;
$self->_check_cache_file if exists $self->{cache_file};
$self->_check_url if exists $self->{url};
$self;
}
sub cache_file {
$_[0]->{cache_file} = $_[0]->_build_cache_file
unless exists $_[0]->{cache_file};
$_[0]->{cache_file};
}
sub get_all {
# If this fails, we just parse what we parsed last time
# Actually, not sure if mirror is atomic or not.
# Mirror is used here also to get automatic if-modified behaviour
$_[0]->_ua->mirror( $_[0]->url, $_[0]->cache_file );
# So if the connection goes away and HTTP::Tiny fubars,
# we just pretend things are fine for now.
# mostly, because deciding how to handle error cases hurt
# my tiny brain
require Path::Tiny;
my (@lines) =
Path::Tiny::path( $_[0]->cache_file )->lines_utf8( { chomp => 1 } );
# Skip prelude
shift @lines while @lines and $lines[0] !~ /\A\s*\[/;
[ map { $_[0]->_parse_line($_) } @lines ];
}
sub get_iter {
my $self = $_[0];
my $fetched = 0;
my $handle;
my $done;
return sub {
return undef if $done;
$fetched ||= do {
$self->_ua->mirror( $self->url, $self->cache_file );
1;
};
defined $handle or $handle = do {
require Path::Tiny;
$handle = Path::Tiny::path( $self->cache_file )->openr_utf8;
};
while ( my $line = <$handle> ) {
next if $line !~ /\A\s*\[/;
chomp $line;
return $self->_parse_line($line);
}
$done = 1;
return undef;
};
}
sub url {
$_[0]->{url} = $_[0]->_build_url unless exists $_[0]->{url};
$_[0]->{url};
}
# -- private ] --
sub _parse_line {
my %record;
@record{
qw( submitted reporter grade filename platform perl_version uuid accepted )
} = (
$_[1] =~ qr{
\A
\s*
\[ (.*? ) \] # submitted
\s*
\[ (.*? ) \] # reported
\s*
\[ (.*? ) \] # grade
\s*
\[ (.*?) \] # filename
\s*
\[ (.*?) \] # platform
\s*
\[ (.*?) \] # perl_version
\s*
\[ (.*?) \] # uuid
\s*
\[ (.*?) \] # accepted
}x
);
require CPAN::Testers::TailLog::Result;
CPAN::Testers::TailLog::Result->new( \%record );
}
sub _ua {
$_[0]->{_ua} = $_[0]->_build_ua unless exists $_[0]->{_ua};
$_[0]->{_ua};
}
# -- builders ] --
sub _build_cache_file {
require File::Temp;
my $temp = File::Temp->new(
TEMPLATE => $DISTNAME . '-XXXXX',
TMPDIR => 1,
SUFFIX => '.txt',
EXLOCK => 0,
);
$_[0]->{_tempfile} = $temp;
require Path::Tiny;
# Touching tempfiles required to get useful if-modified behaviour
Path::Tiny::path( $temp->filename )->touch( time - ( 7 * 24 * 60 * 60 ) );
$temp->filename;
}
sub _build_ua {
require HTTP::Tiny;
HTTP::Tiny->new( agent => ( $DISTNAME . '/' . $VERSION ), );
}
sub _build_url {
'http://metabase.cpantesters.org/tail/log.txt';
}
# -- checkers ] --
sub _check_cache_file {
require Path::Tiny;
my $path = Path::Tiny::path( $_[0]->{cache_file} );
my $dir = $path->parent;
die "cache_file: Directory for $path not accessible: $?"
unless -e $dir
and -d $dir
and -r $dir;
if ( not -e $path ) {
# Path doesn't exist, test creating it
# Hope touch dies if it can't be written
$path->touch( time - ( 7 * 24 * 60 * 60 ) );
}
return if -e $path and not -d $path and -w $path;
die "cache_file: $path exists but is unwriteable";
}
sub _check_url {
die "url: Missing protocol in $_[0]->{url}" if $_[0]->{url} !~ qr{://};
die "url: Unknown protocol in $_[0]->{url}"
if $_[0]->{url} !~ qr{\Ahttps?://};
}
1;
=head1 NAME
CPAN-Testers-TailLog - Extract recent test statuses from metabase log
=head1 SYNOPSIS
use CPAN::Testers::TailLog;
my $tailer = CPAN::Testers::TailLog->new();
my $results = $tailer->get_all();
for my $item ( @{ $results } ) {
printf "%s: %s\n", $item->grade, $item->filename;
}
=head1 DESCRIPTION
B<CPAN::Testers::TailLog> is a simple interface to the C<Metabase> C<tail.log>
located at C<http://metabase.cpantesters.org/tail/log.txt>
This module simply wraps the required HTTP Request mechanics, some persistent
caching glue for performance, and a trivial parsing layer to provide an object
oriented view of the log.
=head1 METHODS
=head2 new
Creates an object for fetching results.
my $tailer = CPAN::Testers::TailLog->new(
%options
);
=head3 new:cache_file
->new( cache_file => "/path/to/file" )
If not specified, defaults to a C<File::Temp> file.
This is good enough for in-memory persistence, so for code that is long lived
setting this is not really necessary.
However, if you want a regularly exiting process, like a cron job, you'll
probably want to set this to a writeable path.
This will ensure you save redundant bandwidth if you sync too quickly, as the
C<mtime> will be used for C<If-Modified-Since>.
Your C<get_all> calls will still look the same, but they'll be a little faster,
you'll eat a little less bandwidth, and stress the remote server a little less.
=head3 new:url
->new( url => "http://path/to/tail.log" )
If not specified, uses the default URL,
http://metabase.cpantesters.org/tail/log.txt
Its not likely you'll have a use for this, but it may turn out useful for
debugging, or maybe somebody out there as an equivalent private server with
this log.
=head2 cache_file
Accessor for configured cache file path
my $path = $tailer->cache_file
=head2 get_all
Fetches the most recent data possible as an C<ArrayRef> of
L<CPAN::Testers::TailLog::Result>
my $arrayref = $tailer->get_all();
Note that an arrayref will be returned regardless of what happens. It helps to
assume the result is just a dumb transfer.
Though keep in mind non-C<ArrayRef>s may be returned in error conditions
(Undecided).
Calling this multiple times will be efficient using C<If-Modified-Since>
headers where applicable.
Though even if nothing has changed, you'll get a full copy of the last state.
If you want an "only what's changed since last time we checked, see F<examples>
=head2 get_iter
Returns a lazy C<CodeRef> that returns one L<CPAN::Testers::TailLog::Result> at
a time.
my $iter = $tailer->get_iter();
while ( my $item = $iter->() ) {
printf "%s %s\n", $item->grade, $item->filename;
}
As with C<get_all>, present design is mostly "dumb state transfer", so all this
really serves is a possible programming convenience. However, optimisations may
be applied here in future so that C<< $iter->() >> pulls items off the wire as
they arrive, saving you some traffic if you terminate early.
Presently, an early termination only saves you a little disk IO, extra regex
parses and shaves a few object creations.
=head2 url
Accessor for configured log URL.
my $url = $tailer->url;
=head1 SEE ALSO
=over 4
=item * L<P5U::Command::cttail>
Some of the logic of this module shares similarity with the contents of that
module, however, that module is designed as a standalone application that
simply shows the current status with some filtration options.
It is not however designed for re-use.
My objective is different, and I want to write a daemon that periodically polls
for new records, and creates a local database ( Similar to what likely happens
inside C<fast-matrix.cpantesters.org> ) of reports for quick searching, and I
figure this sort of logic can also be useful for somebody who wants a
C<desktop-notification-on-failure> monitor.
Some of the logic was cribbed from this and reduced to be closer to verbatim.
=item * L<fast-matrix tail-log-to-json|https://github.com/eserte/cpan-testers-matrix/blob/master/bin/tail-log-to-json.pl>
C<CPAN::Testers::TailLog> contains similar logic to this script as well, again,
prioritizing for simplicity and re-use.
Any specific mangling with C<distinfo> is left to the consumer.
=back
=head1 AUTHOR
Kent Fredric <kentnl@cpan.org>
=head1 LICENSE
This software is copyright (c) 2016 by Kent Fredric.
This is free software; you can redistribute it and/or modify it under the same
terms as the Perl 5 programming language system itself.