blib/lib/Linux/Perl/Constants.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 8 | 8 | 100.0 |
branch | 1 | 2 | 50.0 |
condition | 2 | 3 | 66.6 |
subroutine | 1 | 1 | 100.0 |
pod | 0 | 1 | 0.0 |
total | 12 | 15 | 80.0 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package Linux::Perl::Constants; | ||||||
2 | |||||||
3 | our $ARCHITECTURE; | ||||||
4 | |||||||
5 | sub get_architecture_name { | ||||||
6 | 21 | 66 | 21 | 0 | 781 | return $ARCHITECTURE ||= do { | |
7 | 9 | 54 | require Config; | ||||
8 | 9 | 174 | Config->import(); | ||||
9 | |||||||
10 | 9 | 105 | my $name = $Config{'archname'}; | ||||
11 | 9 | 33 | my $dash_at = index($name, '-'); | ||||
12 | 9 | 50 | 33 | if ($dash_at != -1) { | |||
13 | 9 | 18 | substr($name, $dash_at) = q<>; | ||||
14 | } | ||||||
15 | |||||||
16 | 9 | 48 | $name; | ||||
17 | }; | ||||||
18 | } | ||||||
19 | |||||||
20 | 1; |