File Coverage

blib/lib/BenchmarkAnything/Storage/Frontend/Lib.pm
Criterion Covered Total %
statement 118 337 35.0
branch 33 178 18.5
condition 5 27 18.5
subroutine 23 38 60.5
pod 15 15 100.0
total 194 595 32.6


line stmt bran cond sub pod time code
1 2     2   1335 use 5.008;
  2         11  
2 2     2   10 use strict;
  2         4  
  2         42  
3 2     2   10 use warnings;
  2         4  
  2         108  
4             package BenchmarkAnything::Storage::Frontend::Lib;
5             # git description: v0.022-4-g0771090
6              
7             our $AUTHORITY = 'cpan:SCHWIGON';
8             # ABSTRACT: Basic functions to access a BenchmarkAnything store
9             $BenchmarkAnything::Storage::Frontend::Lib::VERSION = '0.023';
10 2     2   12 use Scalar::Util 'reftype';
  2         4  
  2         288  
11              
12              
13             sub new
14             {
15 4     4 1 2933 my $class = shift;
16 4         46 my $self = bless { @_ }, $class;
17 4         1111 require BenchmarkAnything::Config;
18 4 50       944 $self->{config} = BenchmarkAnything::Config->new(cfgfile => $self->{cfgfile}) unless $self->{noconfig};
19 4 50       23991 $self->connect unless $self->{noconnect};
20 4         23 return $self;
21             }
22              
23             sub _format_flat_inner_scalar
24             {
25 0     0   0 my ($self, $result, $opt) = @_;
26              
27 2     2   14 no warnings 'uninitialized';
  2         5  
  2         211  
28              
29 0         0 return "$result";
30             }
31              
32             sub _format_flat_inner_array
33             {
34 0     0   0 my ($self, $result, $opt) = @_;
35              
36 2     2   14 no warnings 'uninitialized';
  2         4  
  2         298  
37              
38             return
39             join($opt->{separator},
40             map {
41             # only SCALARS allowed (where reftype returns undef)
42 0 0       0 die "benchmarkanything: unsupported innermost nesting (".reftype($_).") for 'flat' output.\n" if defined reftype($_);
  0         0  
43 0         0 "".$_
44             } @$result);
45             }
46              
47             sub _format_flat_inner_hash
48             {
49 0     0   0 my ($self, $result, $opt) = @_;
50              
51 2     2   15 no warnings 'uninitialized';
  2         4  
  2         303  
52              
53             return
54             join($opt->{separator},
55 0         0 map { my $v = $result->{$_};
  0         0  
56             # only SCALARS allowed (where reftype returns undef)
57 0 0       0 die "benchmarkanything: unsupported innermost nesting (".reftype($v).") for 'flat' output.\n" if defined reftype($v);
58 0         0 "$_=".$v
59             } keys %$result);
60             }
61              
62             sub _format_flat_outer
63             {
64 0     0   0 my ($self, $result, $opt) = @_;
65              
66 2     2   14 no warnings 'uninitialized';
  2         6  
  2         1806  
67              
68 0         0 my $output = "";
69 0 0       0 die "benchmarkanything: can not flatten data structure (undef) - try other output format.\n" unless defined $result;
70              
71 0 0       0 my $A = ""; my $B = ""; if ($opt->{fb}) { $A = "["; $B = "]" }
  0         0  
  0         0  
  0         0  
  0         0  
72 0         0 my $fi = $opt->{fi};
73              
74 0 0       0 if (!defined reftype $result) { # SCALAR
    0          
    0          
75 0         0 $output .= $result."\n"; # stringify
76             }
77             elsif (reftype $result eq 'ARRAY') {
78 0         0 for (my $i=0; $i<@$result; $i++) {
79 0         0 my $entry = $result->[$i];
80 0 0       0 my $prefix = $fi ? "$i:" : "";
81 0 0       0 if (!defined reftype $entry) { # SCALAR
    0          
    0          
82 0         0 $output .= $prefix.$A.$self->_format_flat_inner_scalar($entry, $opt)."$B\n";
83             }
84             elsif (reftype $entry eq 'ARRAY') {
85 0         0 $output .= $prefix.$A.$self->_format_flat_inner_array($entry, $opt)."$B\n";
86             }
87             elsif (reftype $entry eq 'HASH') {
88 0         0 $output .= $prefix.$A.$self->_format_flat_inner_hash($entry, $opt)."$B\n";
89             }
90             else {
91 0         0 die "benchmarkanything: can not flatten data structure (".reftype($entry).").\n";
92             }
93             }
94             }
95             elsif (reftype $result eq 'HASH') {
96 0         0 my @keys = keys %$result;
97 0         0 foreach my $key (@keys) {
98 0         0 my $entry = $result->{$key};
99 0 0       0 if (!defined reftype $entry) { # SCALAR
    0          
    0          
100 0         0 $output .= "$key:".$self->_format_flat_inner_scalar($entry, $opt)."\n";
101             }
102             elsif (reftype $entry eq 'ARRAY') {
103 0         0 $output .= "$key:".$self->_format_flat_inner_array($entry, $opt)."\n";
104             }
105             elsif (reftype $entry eq 'HASH') {
106 0         0 $output .= "$key:".$self->_format_flat_inner_hash($entry, $opt)."\n";
107             }
108             else {
109 0         0 die "benchmarkanything: can not flatten data structure (".reftype($entry).").\n";
110             }
111             }
112             }
113             else {
114 0         0 die "benchmarkanything: can not flatten data structure (".reftype($result).") - try other output format.\n";
115             }
116              
117 0         0 return $output;
118             }
119              
120             sub _format_flat
121             {
122 0     0   0 my ($self, $result, $opt) = @_;
123              
124             # ensure array container
125             # for consistent output in 'getpoint' and 'search'
126 0 0       0 my $resultlist = reftype($result) eq 'ARRAY' ? $result : [$result];
127              
128 0         0 my $output = "";
129 0 0       0 $opt->{separator} = ";" unless defined $opt->{separator};
130 0         0 $output .= $self->_format_flat_outer($resultlist, $opt);
131 0         0 return $output;
132             }
133              
134              
135             sub _output_format
136             {
137 0     0   0 my ($self, $data, $opt) = @_;
138              
139 0         0 my $output = "";
140 0   0     0 my $outtype = $opt->{outtype} || 'json';
141              
142 0 0       0 if ($outtype eq "yaml")
    0          
    0          
    0          
    0          
    0          
143             {
144 0         0 require YAML::Any;
145 0         0 $output .= YAML::Any::Dump($data);
146             }
147             elsif ($outtype eq "json")
148             {
149 0         0 eval "use JSON -convert_blessed_universally";
150 0         0 my $json = JSON->new->allow_nonref->pretty->allow_blessed->convert_blessed;
151 0         0 $output .= $json->encode($data);
152             }
153             elsif ($outtype eq "ini") {
154 0         0 require Config::INI::Serializer;
155 0         0 my $ini = Config::INI::Serializer->new;
156 0         0 $output .= $ini->serialize($data);
157             }
158             elsif ($outtype eq "dumper")
159             {
160 0         0 require Data::Dumper;
161 0         0 $output .= Data::Dumper::Dumper($data);
162             }
163             elsif ($outtype eq "xml")
164             {
165 0         0 require XML::Simple;
166 0         0 my $xs = new XML::Simple;
167 0         0 $output .= $xs->XMLout($data, AttrIndent => 1, KeepRoot => 1);
168             }
169             elsif ($outtype eq "flat") {
170 0         0 $output .= $self->_format_flat( $data, $opt );
171             }
172             else
173             {
174 0         0 die "benchmarkanything-storage: unrecognized output format: $outtype.";
175             }
176 0         0 return $output;
177             }
178              
179              
180             sub connect
181             {
182 5     5 1 20 my ($self) = @_;
183              
184 5         19 my $backend = $self->{config}{benchmarkanything}{backend};
185 5 50       23 if ($backend eq 'local')
    0          
186             {
187 5         3050 require DBI;
188 5         36236 require BenchmarkAnything::Storage::Backend::SQL;
189 2     2   18 no warnings 'once'; # avoid 'Name "DBI::errstr" used only once'
  2         4  
  2         1181  
190              
191             # connect
192 5 50       12002 print "Connect db...\n" if $self->{debug};
193 5         21 my $dsn = $self->{config}{benchmarkanything}{storage}{backend}{sql}{dsn};
194 5         17 my $user = $self->{config}{benchmarkanything}{storage}{backend}{sql}{user};
195 5         15 my $password = $self->{config}{benchmarkanything}{storage}{backend}{sql}{password};
196 5 50       51 my $dbh = DBI->connect($dsn, $user, $password, {'RaiseError' => 1, 'mysql_auto_reconnect' => 1})
197             or die "benchmarkanything: can not connect: ".$DBI::errstr;
198              
199             # external search engine
200 5   50     25701 my $searchengine = $self->{config}{benchmarkanything}{searchengine} || {};
201              
202             # remember
203 5         18 $self->{dbh} = $dbh;
204             $self->{backend} = BenchmarkAnything::Storage::Backend::SQL->new({dbh => $dbh,
205             dbh_config => $self->{config}{benchmarkanything}{storage}{backend}{sql},
206             debug => $self->{config}{benchmarkanything}{debug},
207             force => $self->{force},
208             verbose => $self->{config}{benchmarkanything}{verbose},
209 5 50       81 (keys %$searchengine ? (searchengine => $searchengine) : ()),
210             });
211             }
212             elsif ($backend eq 'http')
213             {
214 0         0 my $ua = $self->_get_user_agent;
215 0         0 my $url = $self->_get_base_url."/api/v1/hello";
216 0 0 0     0 die "benchmarkanything: can't connect to result storage ($url)\n" if (!$ua->get($url)->res->code or $ua->get($url)->res->code != 200);
217             }
218              
219 5         172446 return $self;
220             }
221              
222              
223             sub disconnect
224             {
225 0     0 1 0 my ($self) = @_;
226              
227 0         0 my $backend = $self->{config}{benchmarkanything}{backend};
228 0 0       0 if ($backend eq 'local')
229             {
230 0 0       0 if ($self->{dbh}) {
231 0 0       0 $self->{dbh}->commit unless $self->{dbh}{AutoCommit};
232 0         0 undef $self->{dbh}; # setting dbh to undef does better cleanup than disconnect();
233             }
234             }
235 0         0 return $self;
236             }
237              
238              
239             sub _are_you_sure
240             {
241 7     7   22 my ($self) = @_;
242              
243             # DSN
244 7         44 my $dsn = $self->{config}{benchmarkanything}{storage}{backend}{sql}{dsn};
245              
246             # option --really
247 7 50       33 if ($self->{really})
248             {
249 7 50       37 if ($self->{really} eq $dsn)
250             {
251 7         34 return 1;
252             }
253             else
254             {
255 0         0 print STDERR "DSN does not match - asking interactive.\n";
256             }
257             }
258              
259             # ask on stdin
260 0         0 print "REALLY DROP AND RE-CREATE DATABASE TABLES [$dsn] (y/N): ";
261 0         0 read STDIN, my $answer, 1;
262 0 0 0     0 return 1 if $answer && $answer =~ /^y(es)?$/i;
263              
264             # default: NO
265 0         0 return 0;
266             }
267              
268              
269             sub createdb
270             {
271 7     7 1 70914 my ($self) = @_;
272              
273 7 50       38 if ($self->_are_you_sure)
274             {
275 2     2   18 no warnings 'once'; # avoid 'Name "DBI::errstr" used only once'
  2         4  
  2         124  
276              
277 7         71 require DBI;
278 7         35 require File::Slurper;
279 7         553 require File::ShareDir;
280 2     2   1012 use DBIx::MultiStatementDo;
  2         1290985  
  2         5715  
281              
282 7         7936 my $batch = DBIx::MultiStatementDo->new(dbh => $self->{dbh});
283              
284             # get schema SQL according to driver
285 7         631 my $dsn = $self->{config}{benchmarkanything}{storage}{backend}{sql}{dsn};
286 7 50       63 my ($scheme, $driver, $attr_string, $attr_hash, $driver_dsn) = DBI->parse_dsn($dsn)
287             or die "benchmarkanything: can not parse DBI DSN '$dsn'";
288 7         232 my ($dbname) = $driver_dsn =~ m/database=(\w+)/g;
289 7         51 my $sql_file = File::ShareDir::dist_file('BenchmarkAnything-Storage-Backend-SQL', "create-schema.$driver");
290 7         2649 my $sql = File::Slurper::read_text($sql_file);
291 7 50       1121 $sql =~ s/^use `testrundb`;/use `$dbname`;/m if $dbname; # replace BenchmarkAnything::Storage::Backend::SQL's default
292              
293             # execute schema SQL
294 7         55 my @results = $batch->do($sql);
295 7 50       1433959 if (not @results)
296             {
297 0         0 die "benchmarkanything: error while creating BenchmarkAnything DB: ".$batch->dbh->errstr;
298             }
299              
300             }
301              
302 7         277 return;
303             }
304              
305              
306             sub _default_additional_keys
307             {
308 1     1   2494 my ($self) = @_;
309              
310 1         5 my $backend = $self->{config}{benchmarkanything}{backend};
311 1 50       7 if ($backend eq 'local')
312             {
313 1         8 return { $self->{backend}->default_columns };
314             }
315             else
316             {
317             # Hardcoded from BenchmarkAnything::Storage::Backend::SQL::Query::common,
318             # as it is a backend-special and internal thing anyway.
319             return {
320 0         0 'NAME' => 'b.bench',
321             'UNIT' => 'bu.bench_unit',
322             'VALUE' => 'bv.bench_value',
323             'VALUE_ID' => 'bv.bench_value_id',
324             'CREATED' => 'bv.created_at',
325             };
326             }
327             }
328              
329              
330              
331             sub _get_benchmark_operators
332             {
333 1     1   20 my ($self) = @_;
334              
335 1         7 my $backend = $self->{config}{benchmarkanything}{backend};
336 1 50       5 if ($backend eq 'local')
337             {
338 1         8 return [ $self->{backend}->benchmark_operators ];
339             }
340             else
341             {
342             # Hardcoded from BenchmarkAnything::Storage::Backend::SQL::Query::common,
343             # as it is a backend-special and internal thing anyway.
344 0         0 return [ '=', '!=', 'like', 'not_like', 'is_empty', '<', '>', '<=', '>=' ];
345             }
346             }
347              
348              
349              
350             sub _get_additional_key_id
351             {
352 3     3   543 my ($self, $key_name) = @_;
353              
354 3         12 my $backend = $self->{config}{benchmarkanything}{backend};
355 3 50       13 if ($backend eq 'local')
356             {
357 3         17 return $self->{backend}->_get_additional_key_id($key_name);
358             }
359             else
360             {
361 0         0 die "benchmarkanything: no backend '$backend' allowed here, available backends are: 'local'.\n";
362             }
363             }
364              
365              
366              
367             sub init_workdir
368             {
369 0     0 1 0 my ($self) = @_;
370              
371 0         0 require File::Basename;
372 0         0 require File::ShareDir;
373 0         0 require File::HomeDir;
374 0         0 require File::Slurper;
375              
376 0         0 my $home_ba = File::HomeDir->my_home."/.benchmarkanything";
377 0         0 my $command = File::Basename::basename($0);
378              
379 0 0       0 if (-d $home_ba)
380             {
381 0 0       0 print "Workdir '$home_ba' already exists - skipping.\n" if $self->{verbose};
382             }
383             else
384             {
385 0         0 require File::Path;
386 0         0 File::Path::make_path($home_ba);
387             }
388              
389 0         0 foreach my $basename (qw(client.cfg server.cfg default.cfg README))
390             {
391 0         0 my $source_file = File::ShareDir::dist_file('BenchmarkAnything-Storage-Frontend-Lib', "config/$basename");
392 0         0 my $dest_file = "$home_ba/$basename";
393              
394 0 0       0 if (! -e $dest_file)
395             {
396 0         0 my $content = File::Slurper::read_text($source_file);
397              
398             # poor man's templating
399 0         0 $content =~ s{\[%\s*CLIENTCFG\s*%\]}{$home_ba/client.cfg}g;
400 0         0 $content =~ s{\[%\s*SERVERCFG\s*%\]}{$home_ba/server.cfg}g;
401 0         0 $content =~ s{\[%\s*LOCALCFG\s*%\]}{$home_ba/default.cfg}g;
402 0         0 $content =~ s{\[%\s*CFG\s*%\]}{$dest_file}g;
403 0         0 $content =~ s{\[%\s*HOME\s*%\]}{$home_ba}g;
404              
405 0 0       0 print "Create configfile: $dest_file...\n" if $self->{verbose};
406 0 0       0 open my $CFGFILE, ">", $dest_file or die "Could not create $dest_file.\n";
407 0         0 print $CFGFILE $content;
408 0         0 close $CFGFILE;
409             }
410             else
411             {
412 0 0       0 print "Config '$dest_file' already exists - skipping.\n" if $self->{verbose};
413             }
414             }
415              
416 0         0 my $dbfile = "$home_ba/benchmarkanything.sqlite";
417 0         0 my $we_created_db = 0;
418 0 0       0 if (! -e $dbfile)
419             {
420 0 0       0 print "Create storage: $dbfile...\n" if $self->{verbose};
421 0         0 __PACKAGE__->new(cfgfile => "$home_ba/default.cfg",
422             really => "dbi:SQLite:$dbfile",
423             )->createdb;
424 0         0 $we_created_db = 1;
425             }
426             else
427             {
428 0 0       0 print "Storage '$dbfile' already exists - skipping.\n" if $self->{verbose};
429             }
430              
431 0 0       0 if ($self->{verbose})
432             {
433 0         0 print "\n";
434 0         0 print "By default it will use this config: $home_ba/default.cfg\n";
435 0         0 print "If you want another one, set it in your ~/.bash_profile:\n";
436 0         0 print " export BENCHMARKANYTHING_CONFIGFILE=$home_ba/client.cfg\n";
437              
438 0 0       0 unless ($we_created_db)
439             {
440 0         0 print "\n";
441 0         0 print "Initialize a new database (it asks for confirmation) with:\n";
442 0         0 print " $command createdb\n";
443 0         0 print "\nReady.\n";
444             }
445             else
446             {
447 0         0 print "\n";
448 0         0 print "Create sample values like this:\n";
449 0         0 print qq( echo '{"BenchmarkAnythingData":[{"NAME":"benchmarkanything.hello.world", "VALUE":17.2}]}' | $command add\n);
450 0         0 print "\n";
451 0         0 print "List metric names:\n";
452 0         0 print qq( $command listnames\n);
453 0         0 print "\n";
454 0         0 print "Query sample values:\n";
455 0         0 print qq( echo '{"select":["NAME","VALUE"],"where":[["=","NAME","benchmarkanything.hello.world"]]}' | $command search\n);
456 0         0 print "\n";
457             }
458             }
459              
460 0         0 return;
461             }
462              
463              
464             sub add
465             {
466 8     8 1 2470 my ($self, $data) = @_;
467              
468             # --- validate ---
469 8 50       46 if (not $data)
470             {
471 0         0 die "benchmarkanything: no input data provided.\n";
472             }
473              
474 8 50       52 if (not $self->{skipvalidation}) {
475 8         703 require BenchmarkAnything::Schema;
476 8 50       485 print "Verify schema...\n" if $self->{verbose};
477 8 50       52 if (not my $result = BenchmarkAnything::Schema::valid_json_schema($data))
478             {
479 0         0 die "benchmarkanything: add: invalid input: ".join("; ", $result->errors)."\n";
480             }
481             }
482              
483             # --- add to storage ---
484              
485 8         164351 my $backend = $self->{config}{benchmarkanything}{backend};
486 8 50       45 if ($backend eq 'local')
    0          
487             {
488 8         21 my $success;
489 8 50       34 if ($self->{queuemode})
490             {
491             # only queue for later processing
492 0 0 0     0 print "Enqueue data [backend:local]...\n" if $self->{verbose} or $self->{debug};
493 0         0 $success = $self->{backend}->enqueue_multi_benchmark($data->{BenchmarkAnythingData});
494             }
495             else
496             {
497 8 50 33     68 print "Add data [backend:local]...\n" if $self->{verbose} or $self->{debug};
498             # preserve order, otherwise add_multi_benchmark() would reorder to optimize insert
499 8         28 foreach my $chunk (@{$data->{BenchmarkAnythingData}})
  8         33  
500             {
501 58 50       3544262 print "." if $self->{debug};
502 58         475 $success = $self->{backend}->add_multi_benchmark([$chunk]);
503             }
504             }
505 8 50       231366 if (not $success)
506             {
507 0         0 die "benchmarkanything: error while adding data: ".$@;
508             }
509 8 50 33     109 print "Done.\n" if $self->{verbose} or $self->{debug};
510             }
511             elsif ($backend eq 'http')
512             {
513 0         0 require BenchmarkAnything::Reporter;
514             $self->{config} = BenchmarkAnything::Reporter->new(config => $self->{config},
515             verbose => $self->{verbose},
516             debug => $self->{debug},
517 0         0 );
518             }
519             else
520             {
521 0         0 die "benchmarkanything: no backend '$backend', available backends are: 'http', 'local'.\n";
522             }
523              
524 8         40 return $self;
525             }
526              
527             sub _get_user_agent
528             {
529 0     0   0 require Mojo::UserAgent;
530 0         0 return Mojo::UserAgent->new;
531             }
532              
533             sub _get_base_url
534             {
535 0     0   0 shift->{config}{benchmarkanything}{backends}{http}{base_url};
536             }
537              
538              
539             sub search
540             {
541 5     5 1 25950 my ($self, $query, $value_id) = @_;
542              
543             # --- validate ---
544 5 50 66     32 if (not $query and not $value_id)
545             {
546 0         0 die "benchmarkanything: no query or value_id provided.\n";
547             }
548              
549 5         24 my $backend = $self->{config}{benchmarkanything}{backend};
550 5 50       21 if ($backend eq 'local')
    0          
551             {
552             # single values
553 5 100       23 return $self->{backend}->get_single_benchmark_point($value_id) if $value_id;
554 4         26 return $self->{backend}->search_array($query);
555             }
556             elsif ($backend eq 'http')
557             {
558 0         0 my $ua = $self->_get_user_agent;
559 0         0 my $url = $self->_get_base_url."/api/v1/search";
560 0         0 my $res;
561 0 0       0 if ($value_id) {
562 0         0 $url .= "/$value_id";
563 0         0 $res = $ua->get($url)->res;
564             } else {
565 0         0 $res = $ua->post($url => json => $query)->res;
566             }
567              
568 0 0       0 die "benchmarkanything: ".$res->error->{message}." ($url)\n" if $res->error;
569              
570 0         0 return $res->json;
571             }
572             else
573             {
574 0         0 die "benchmarkanything: no backend '$backend', available backends are: 'http', 'local'.\n";
575             }
576             }
577              
578              
579             sub listnames
580             {
581 3     3 1 12096 my ($self, $pattern) = @_;
582              
583 3         12 my $backend = $self->{config}{benchmarkanything}{backend};
584 3 50       14 if ($backend eq 'local')
    0          
585             {
586 3 100       25 return $self->{backend}->list_benchmark_names(defined($pattern) ? ($pattern) : ());
587             }
588             elsif ($backend eq 'http')
589             {
590 0         0 my $ua = $self->_get_user_agent;
591 0         0 my $url = $self->_get_base_url."/api/v1/listnames";
592              
593 0         0 my $res = $ua->get($url)->res;
594 0 0       0 die "benchmarkanything: ".$res->error->{message}." ($url)\n" if $res->error;
595              
596 0         0 my $result = $res->json;
597              
598             # output
599 0         0 return $result;
600             }
601             else
602             {
603 0         0 die "benchmarkanything: no backend '$backend', available backends are: 'http', 'local'.\n";
604             }
605             }
606              
607              
608             sub listkeys
609             {
610 0     0 1 0 my ($self, $pattern) = @_;
611              
612 0         0 my $backend = $self->{config}{benchmarkanything}{backend};
613 0 0       0 if ($backend eq 'local')
    0          
614             {
615 0 0       0 return $self->{backend}->list_additional_keys(defined($pattern) ? ($pattern) : ());
616             }
617             elsif ($backend eq 'http')
618             {
619 0         0 my $ua = $self->_get_user_agent;
620 0         0 my $url = $self->_get_base_url."/api/v1/listkeys";
621              
622 0         0 my $res = $ua->get($url)->res;
623 0 0       0 die "benchmarkanything: ".$res->error->{message}." ($url)\n" if $res->error;
624              
625 0         0 my $result = $res->json;
626              
627             # output
628 0         0 return $result;
629             }
630             else
631             {
632 0         0 die "benchmarkanything: no backend '$backend', available backends are: 'http', 'local'.\n";
633             }
634             }
635              
636              
637             sub stats
638             {
639 1     1 1 27 my ($self) = @_;
640              
641 1         7 my $backend = $self->{config}{benchmarkanything}{backend};
642 1 50       6 if ($backend eq 'local')
    0          
643             {
644 1         10 return $self->{backend}->get_stats;
645             }
646             elsif ($backend eq 'http')
647             {
648 0         0 my $ua = $self->_get_user_agent;
649 0         0 my $url = $self->_get_base_url."/api/v1/stats";
650              
651 0         0 my $res = $ua->get($url)->res;
652 0 0       0 die "benchmarkanything: ".$res->error->{message}." ($url)\n" if $res->error;
653              
654 0         0 my $result = $res->json;
655              
656             # output
657 0         0 return $result;
658             }
659             else
660             {
661 0         0 die "benchmarkanything: no backend '$backend', available backends are: 'http', 'local'.\n";
662             }
663             }
664              
665              
666             sub gc
667             {
668 0     0 1 0 my ($self) = @_;
669              
670 0         0 my $backend = $self->{config}{benchmarkanything}{backend};
671 0 0       0 if ($backend eq 'local')
672             {
673 0         0 $self->{backend}->gc;
674             }
675             }
676              
677              
678             sub process_raw_result_queue
679             {
680 0     0 1 0 my ($self, $count) = @_;
681              
682 0         0 require LockFile::Simple;
683              
684 0         0 my $lock;
685 0         0 my $lockmgr = LockFile::Simple->make(-stale => 1, -autoclean => 1);
686              
687 0 0       0 return unless $lock = $lockmgr->trylock('/tmp/process_raw_result_queue');
688              
689 0   0     0 $count ||= 10;
690              
691 0         0 my $backend = $self->{config}{benchmarkanything}{backend};
692 0 0       0 if ($backend eq 'local')
693             {
694 0         0 my @dequeued_raw_bench_bundle_ids;
695 0   0     0 do {
696 0         0 @dequeued_raw_bench_bundle_ids = $self->{backend}->process_queued_multi_benchmark($count);
697             #print STDERR "Processed bench_bundles: ".join(",", @dequeued_raw_bench_bundle_ids)."\n" if $self->{verbose};
698 0         0 $count = $count - @dequeued_raw_bench_bundle_ids;
699             } until ($count < 1 or not @dequeued_raw_bench_bundle_ids);
700             }
701             else
702             {
703 0         0 $lock->release;
704 0         0 die "benchmarkanything: only backend 'local' allowed in 'process_raw_result_queue'.\n";
705             }
706              
707 0         0 $lock->release;
708 0         0 return;
709             }
710              
711              
712             sub init_search_engine
713             {
714 0     0 1 0 my ($self, $force) = @_;
715              
716 0         0 my $backend = $self->{config}{benchmarkanything}{backend};
717 0 0       0 if ($backend eq 'local')
718             {
719 0         0 $self->{backend}->init_search_engine($force);
720             }
721             else
722             {
723 0         0 die "benchmarkanything: only backend 'local' allowed in 'init_search_engine'.\n";
724             }
725 0         0 return;
726             }
727              
728              
729             sub sync_search_engine
730             {
731 0     0 1 0 my ($self, $force, $start, $count) = @_;
732              
733 0         0 my $backend = $self->{config}{benchmarkanything}{backend};
734 0 0       0 if ($backend eq 'local')
735             {
736 0         0 $self->{backend}->sync_search_engine($force, $start, $count);
737             }
738             else
739             {
740 0         0 die "benchmarkanything: only backend 'local' allowed in 'sync_search_engine'.\n";
741             }
742 0         0 return;
743             }
744              
745              
746              
747             sub getpoint
748             {
749 1     1 1 25 my ($self, $value_id) = @_;
750              
751 1         8 return $self->search(undef, $value_id);
752 0 0         die "benchmarkanything: please provide a benchmark value_id'\n" unless $value_id;
753             }
754              
755             1;
756              
757             __END__
758              
759             =pod
760              
761             =encoding UTF-8
762              
763             =head1 NAME
764              
765             BenchmarkAnything::Storage::Frontend::Lib - Basic functions to access a BenchmarkAnything store
766              
767             =head2 new
768              
769             Instantiate a new object.
770              
771             =over 4
772              
773             =item * cfgfile
774              
775             Path to config file. If not provided it uses env variable
776             C<BENCHMARKANYTHING_CONFIGFILE> or C<$home/.benchmarkanything.cfg>.
777              
778             =item * noconfig
779              
780             If set to 1, do not initialize configuration.
781              
782             =item * noconnect
783              
784             If set to 1, do not automatically connect to backend store.
785              
786             =item * really
787              
788             Used for critical functions like createdb. Provide a true value or, in
789             case of L</createdb>, the DSN of the database that you are about to
790             (re-)create.
791              
792             =item * skipvalidation
793              
794             Disables schema validation checking, e.g., when you know your data is
795             correct and want to save execution time, ususally for C<add()>.
796              
797             =item * verbose
798              
799             Print out progress messages.
800              
801             =item * debug
802              
803             Pass through debug option to used modules, like
804             L<BenchmarkAnything::Storage::Backend::SQL|BenchmarkAnything::Storage::Backend::SQL>.
805              
806             =item * separator
807              
808             Used for output format I<flat>. Sub entry separator (default=;).
809              
810             =item * fb
811              
812             Used for output format I<flat>. If set it generates [brackets] around
813             outer arrays (default=0).
814              
815             =item * fi
816              
817             Used for output format I<flat>. If set it prefixes outer array lines
818             with index.
819              
820             =back
821              
822             =head2 _output_format
823              
824             This function converts a data structure into requested output format.
825              
826             =head3 Output formats
827              
828             The following B<output formats> are allowed:
829              
830             yaml - YAML::Any
831             json - JSON (default)
832             xml - XML::Simple
833             ini - Config::INI::Serializer
834             dumper - Data::Dumper (including the leading $VAR1 variable assignment)
835             flat - pragmatic flat output for typical unixish cmdline usage
836              
837             =head3 The 'flat' output format
838              
839             The C<flat> output format is meant to support typical unixish command
840             line uses. It is not a strong serialization format but works well for
841             simple values nested max 2 levels.
842              
843             Output looks like this:
844              
845             =head4 Plain values
846              
847             Affe
848             Tiger
849             Birne
850              
851             =head4 Outer hashes
852              
853             One outer key per line, key at the beginning of line with a colon
854             (C<:>), inner values separated by semicolon C<;>:
855              
856             =head4 inner scalars:
857              
858             coolness:big
859             size:average
860             Eric:The flat one from the 90s
861              
862             =head4 inner hashes:
863              
864             Tuples of C<key=value> separated by semicolon C<;>:
865              
866             Affe:coolness=big;size=average
867             Zomtec:coolness=bit anachronistic;size=average
868              
869             =head4 inner arrays:
870              
871             Values separated by semicolon C<;>:
872              
873             Birne:bissel;hinterher;manchmal
874              
875             =head4 Outer arrays
876              
877             One entry per line, entries separated by semicolon C<;>:
878              
879             =head4 Outer arrays / inner scalars:
880              
881             single report string
882             foo
883             bar
884             baz
885              
886             =head4 Outer arrays / inner hashes:
887              
888             Tuples of C<key=value> separated by semicolon C<;>:
889              
890             Affe=amazing moves in the jungle;Zomtec=slow talking speed;Birne=unexpected in many respects
891              
892             =head4 Outer arrays / inner arrays:
893              
894             Entries separated by semicolon C<;>:
895              
896             line A-1;line A-2;line A-3;line A-4;line A-5
897             line B-1;line B-2;line B-3;line B-4
898             line C-1;line C-2;line C-3
899              
900             =head4 Additional markup for arrays:
901              
902             --fb ... use [brackets] around outer arrays
903             --fi ... prefix outer array lines with index
904             --separator=; ... use given separator between array entries (defaults to ";")
905              
906             Such additional markup lets outer arrays look like this:
907              
908             0:[line A-1;line A-2;line A-3;line A-4;line A-5]
909             1:[line B-1;line B-2;line B-3;line B-4]
910             2:[line C-1;line C-2;line C-3]
911             3:[Affe=amazing moves in the jungle;Zomtec=slow talking speed;Birne=unexpected in many respects]
912             4:[single report string]
913              
914             =head2 connect
915              
916             Connects to the database according to the DB handle from config.
917              
918             Returns the object to allow chained method calls.
919              
920             =head2 disconnect
921              
922             Commits and disconnects the current DB handle from the database.
923              
924             Returns the object to allow chained method calls.
925              
926             =head2 _are_you_sure
927              
928             Internal method.
929              
930             Find out if you are really sure. Usually used in L</createdb>. You
931             need to have provided an option C<really> which matches the DSN of the
932             database that your are about to (re-)create.
933              
934             If the DSN does not match it asks interactively on STDIN - have this
935             in mind on non-interactive backend programs, like a web application.
936              
937             =head2 createdb
938              
939             Initializes the DB, as configured by C<backend> and C<dsn>. On
940             the backend this means executing the DROP TABLE and CREATE TABLE
941             statements that come with
942             L<BenchmarkAnything::Storage::Backend::SQL|BenchmarkAnything::Storage::Backend::SQL>. Because that is a severe
943             operation it verifies an "are you sure" test, by comparing the
944             parameter C<really> against the DSN from the config, or if that
945             doesn't match, asking interactively on STDIN.
946              
947             =head2 _default_additional_keys
948              
949             Internal method. Specific to SQL backend.
950              
951             Return default columns that are part of each BenchmarkAnything data point.
952              
953             =head2 _get_benchmark_operators
954              
955             Internal method. Specific to SQL backend.
956              
957             Return the allowed operators of the BenchmarkAnything query API.
958              
959             =head2 _get_additional_key_id
960              
961             Internal method. Specific to SQL backend.
962              
963             Returns id of the additional key.
964              
965             =head2 init_workdir
966              
967             Initializes a work directory C<~/.benchmarkanything/> with config
968             files, which should work by default and can be tweaked by the user.
969              
970             =head2 add ($data)
971              
972             Adds all data points of a BenchmarkAnything structure to the backend
973             store.
974              
975             =head2 search ($query)
976              
977             Execute a search query against the backend store, currently
978             L<BenchmarkAnything::Storage::Backend::SQL|BenchmarkAnything::Storage::Backend::SQL>, and returns the list of found
979             data points, as configured by the search query.
980              
981             =head2 listnames ($pattern)
982              
983             Returns an array ref with all metric NAMEs. Optionally allows to
984             restrict the search by a SQL LIKE search pattern, allowing C<%> as
985             wildcard.
986              
987             =head2 listkeys ($pattern)
988              
989             Returns an array ref with all additional key names that are used for
990             metrics. Optionally allows to restrict the search by a SQL LIKE search
991             pattern, allowing C<%> as wildcard.
992              
993             =head2 stats
994              
995             Returns a hash with info about the storage, like how many data points,
996             how many metrics, how many additional keys, are stored.
997              
998             =head2 gc()
999              
1000             Run garbage collector. This cleans up potential garbage that might
1001             have piled up, in particular qeued raw results that are already
1002             processed but still in the storage.
1003              
1004             Initially the garbage collection is made for the queing functionality
1005             (see L</process_raw_result_queue> until we are confident it is
1006             waterproof. However, generally there might be new code arriving in the
1007             future for which garbage collection might also make sense, so we
1008             provide this function as general entry point to do The Right Thing -
1009             whatever that is by that time.
1010              
1011             =head2 process_raw_result_queue($count)
1012              
1013             Works on the queued entries created by C<add> in I<queuemode=1>. It
1014             finishes as soon as there are no more unprocessed raw entries, or it
1015             processed C<$count> entries (default=10).
1016              
1017             =head2 init_search_engine($force)
1018              
1019             Initializes the configured search engine (Elasticsearch). If the index
1020             already exists it does nothing, except when you set C<$force> to a
1021             true value which deletes and re-creates the index. This is necessary
1022             for example to apply new type mappings.
1023              
1024             After a successful (re-)init you need to run C<sync_search_engine>.
1025              
1026             During (re-init) and sync you should disable querying by setting
1027              
1028             benchmarkanything.searchengine.elasticsearch.enable_query: 0
1029              
1030             =head3 Options
1031              
1032             =over 4
1033              
1034             =item force
1035              
1036             If set, an existing index is deleted before (re-)creating.
1037              
1038             =back
1039              
1040             =head2 sync_search_engine($force, $start, $count)
1041              
1042             Synchronizes entries from the ::SQL backend into the configured search
1043             engine (usually Elasticsearch). It starts at entry C<$start> and bulk
1044             indexes in blocks of C<$count>.
1045              
1046             =head3 Options
1047              
1048             =over 4
1049              
1050             =item force
1051              
1052             If set, all entries are (re-)indexed, not just the new ones.
1053              
1054             =back
1055              
1056             =head2 getpoint ($value_id)
1057              
1058             Returns a single benchmark point with B<all> its key/value pairs.
1059              
1060             =head1 AUTHOR
1061              
1062             Steffen Schwigon <ss5@renormalist.net>
1063              
1064             =head1 COPYRIGHT AND LICENSE
1065              
1066             This software is copyright (c) 2019 by Steffen Schwigon.
1067              
1068             This is free software; you can redistribute it and/or modify it under
1069             the same terms as the Perl 5 programming language system itself.
1070              
1071             =cut