File Coverage

blib/lib/Acme/CPANModulesUtil/Bencher.pm
Criterion Covered Total %
statement 11 60 18.3
branch 0 26 0.0
condition 0 6 0.0
subroutine 4 5 80.0
pod 1 1 100.0
total 16 98 16.3


line stmt bran cond sub pod time code
1             package Acme::CPANModulesUtil::Bencher;
2              
3 1     1   290662 use 5.010001;
  1         4  
4 1     1   4 use strict 'subs', 'vars';
  1         1  
  1         31  
5 1     1   3 use warnings;
  1         6  
  1         55  
6              
7 1     1   4 use Exporter qw(import);
  1         2  
  1         804  
8              
9             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
10             our $DATE = '2023-10-06'; # DATE
11             our $DIST = 'Acme-CPANModulesUtil-Bencher'; # DIST
12             our $VERSION = '0.006'; # VERSION
13              
14             our %SPEC;
15              
16             our @EXPORT_OK = qw(gen_bencher_scenario);
17              
18             $SPEC{gen_bencher_scenario} = {
19             v => 1.1,
20             summary => 'Generate/extract Bencher scenario from information in an Acme::CPANModules::* list',
21             description => <<'_',
22              
23             An ::* module can contain benchmark information, for
24             example in , each entry has the following
25             property:
26              
27             entries => [
28             ...
29             {
30             module => 'Text::ANSITable',
31             ...
32             bench_code => sub {
33             my ($table) = @_;
34             my $t = Text::ANSITable->new(
35             use_utf8 => 0,
36             use_box_chars => 0,
37             use_color => 0,
38             columns => $table->[0],
39             border_style => 'Default::single_ascii',
40             );
41             $t->add_row($table->[$_]) for 1..@$table-1;
42             $t->draw;
43             },
44              
45             # per-function participant
46             functions => {
47             'func1' => {
48             bench_code_template => 'Text::ANSITable::func1([])',
49             },
50             ...
51             },
52              
53             The list also contains information about the benchmark datasets:
54              
55             bench_datasets => [
56             {name=>'tiny (1x1)' , argv => [_make_table( 1, 1)],},
57             {name=>'small (3x5)' , argv => [_make_table( 3, 5)],},
58             {name=>'wide (30x5)' , argv => [_make_table(30, 5)],},
59             {name=>'long (3x300)' , argv => [_make_table( 3, 300)],},
60             {name=>'large (30x300)', argv => [_make_table(30, 300)],},
61             ],
62              
63             This routine extract those information and return a scenario
64             structure.
65              
66             _
67             args => {
68             cpanmodule => {
69             summary => 'Name of Acme::CPANModules::* module, without the prefix',
70             schema => 'perl::modname*',
71             req => 1,
72             pos => 0,
73             'x.completion' => ['perl_modname' => {ns_prefix=>'Acme::CPANModules'}],
74             },
75             },
76             };
77             sub gen_bencher_scenario {
78 0     0 1   my %args = @_;
79              
80 0           my $list;
81             my $mod;
82              
83 0 0         if ($args{_list}) {
84 0           $list = $args{_list};
85             } else {
86 0 0         $mod = $args{cpanmodule} or return [400, "Please specify cpanmodule"];
87 0 0         $mod = "Acme::CPANModules::$mod" unless $mod =~ /\AAcme::CPANModules::/;
88 0           (my $mod_pm = "$mod.pm") =~ s!::!/!g;
89 0           require $mod_pm;
90              
91 0           $list = ${"$mod\::LIST"};
  0            
92             }
93              
94             my $scenario = {
95             summary => $list->{summary},
96 0           participants => [],
97             };
98              
99 0 0         $scenario->{description} = "This scenario is generated from ".
100             ($mod ? "" : "an list").".";
101              
102 0           for (qw/datasets/) {
103 0 0         if ($list->{"bench_$_"}) {
104 0           $scenario->{$_} = $list->{"bench_$_"};
105             }
106             }
107              
108 0           for my $e (@{ $list->{entries} }) {
  0            
109 0           my @per_function_participants;
110              
111             # we currently don't handle entries with 'modules'
112 0 0         next unless $e->{module};
113              
114             # per-function participant
115 0 0         if ($e->{functions}) {
116 0           for my $fname (sort keys %{ $e->{functions} }) {
  0            
117 0           my $fspec = $e->{functions}{$fname};
118             my $p = {
119             module => $e->{module},
120 0           function => $fname,
121             };
122 0           my $has_bench_code;
123 0           for (qw/code code_template fcall_template/) {
124 0 0         if (defined $fspec->{"bench_$_"}) {
125 0           $p->{$_} = $fspec->{"bench_$_"};
126 0           $has_bench_code++;
127             }
128             }
129 0 0         next unless $has_bench_code;
130 0           for (qw/tags/) {
131 0 0         if (defined $fspec->{"bench_$_"}) {
132 0           $p->{$_} = $fspec->{"bench_$_"};
133             }
134             }
135 0           push @per_function_participants, $p;
136             }
137             }
138              
139             my $p = {
140             module => $e->{module},
141 0           };
142 0           my $has_bench_code;
143 0           for (qw/code code_template fcall_template/) {
144 0 0         if ($e->{"bench_$_"}) {
145 0           $has_bench_code++;
146 0           $p->{$_} = $e->{"bench_$_"};
147             }
148             }
149 0           for (qw/tags include_by_default/) {
150 0 0         if (exists $e->{"bench_$_"}) {
151 0           $p->{$_} = $e->{"bench_$_"};
152             }
153             }
154 0 0 0       if ($has_bench_code || (!@per_function_participants && !$scenario->{datasets})) {
      0        
155 0           push @{ $scenario->{participants} }, $p;
  0            
156             }
157 0           push @{ $scenario->{participants} }, @per_function_participants;
  0            
158             }
159              
160 0           [200, "OK", $scenario];
161             }
162              
163             1;
164             # ABSTRACT: Generate/extract Bencher scenario from information in an Acme::CPANModules::* list
165              
166             __END__