File Coverage

blib/lib/Parse/Win32Registry/WinNT/Entry.pm
Criterion Covered Total %
statement 55 64 85.9
branch 21 32 65.6
condition 0 3 0.0
subroutine 10 11 90.9
pod 0 3 0.0
total 86 113 76.1


line stmt bran cond sub pod time code
1             package Parse::Win32Registry::WinNT::Entry;
2              
3 13     13   95 use strict;
  13         61  
  13         388  
4 13     13   76 use warnings;
  13         25  
  13         358  
5              
6 13     13   76 use base qw(Parse::Win32Registry::Entry);
  13         24  
  13         1163  
7              
8 13     13   83 use Carp;
  13         25  
  13         759  
9 13     13   87 use Parse::Win32Registry::Base qw(:all);
  13         40  
  13         2856  
10 13     13   116 use Parse::Win32Registry::WinNT::Key;
  13         28  
  13         341  
11 13     13   116 use Parse::Win32Registry::WinNT::Value;
  13         28  
  13         398  
12 13     13   76 use Parse::Win32Registry::WinNT::Security;
  13         26  
  13         7566  
13              
14             sub new {
15 70     70 0 124 my $class = shift;
16 70         101 my $regfile = shift;
17 70         114 my $offset = shift;
18              
19 70 50       166 croak 'Missing registry file' if !defined $regfile;
20 70 50       122 croak 'Missing offset' if !defined $offset;
21              
22 70         198 my $fh = $regfile->get_filehandle;
23              
24 70         534 sysseek($fh, $offset, 0);
25 70         624 my $bytes_read = sysread($fh, my $entry_header, 8);
26 70 50       247 if ($bytes_read != 8) {
27 0         0 return;
28             }
29              
30 70         339 my ($length,
31             $tag) = unpack('Va2', $entry_header);
32              
33 70         127 my $allocated = 0;
34 70 100       189 if ($length > 0x7fffffff) {
35 60         84 $allocated = 1;
36 60         126 $length = (0xffffffff - $length) + 1;
37             }
38              
39 70 100       430 $tag = '' if $tag !~ /(nk|vk|lh|lf|li|ri|sk)/;
40              
41 70 100       236 if ($tag eq 'nk') {
    100          
    100          
42 24 50       118 if (my $key = Parse::Win32Registry::WinNT::Key->new($regfile,
43             $offset))
44             {
45 24         105 $key->regenerate_path;
46 24         108 return $key;
47             }
48             }
49             elsif ($tag eq 'vk') {
50 10 50       66 if (my $value = Parse::Win32Registry::WinNT::Value->new($regfile,
51             $offset))
52             {
53 10         45 return $value;
54             }
55             }
56             elsif ($tag eq 'sk') {
57 2 50       23 if (my $value = Parse::Win32Registry::WinNT::Security->new($regfile,
58             $offset))
59             {
60 2         10 return $value;
61             }
62             }
63              
64 34         72 my $self = {};
65             $self->{_regfile} = $regfile,
66             $self->{_offset} = $offset,
67             $self->{_length} = $length,
68             $self->{_tag} = $tag,
69 34         157 $self->{_allocated} = $allocated,
70             bless $self, $class;
71              
72 34         161 return $self;
73             }
74              
75             sub as_string {
76 34     34 0 76 my $self = shift;
77              
78 34         76 my $tag = $self->{_tag};
79 34 50       220 if ($tag eq 'nk') {
    50          
    50          
    100          
80 0         0 return '(key entry)';
81             }
82             elsif ($tag eq 'vk') {
83 0         0 return '(value entry)';
84             }
85             elsif ($tag eq 'sk') {
86 0         0 return '(security entry)';
87             }
88             elsif ($tag =~ /(lh|lf|li|ri)/) {
89 10         49 return '(subkey list entry)';
90             }
91 24         92 return '(unidentified entry)';
92             }
93              
94             sub parse_info {
95 0     0 0   my $self = shift;
96              
97 0           my $tag = $self->{_tag};
98 0 0 0       $tag = defined($tag) && $tag ne ''
99             ? $tag . ' '
100             : '.. ';
101             my $info = sprintf '0x%x %slen=0x%x alloc=%d',
102             $self->{_offset},
103             $tag,
104             $self->{_length},
105 0           $self->{_allocated};
106 0           return $info;
107             }
108              
109             1;