package Parse::Win32Registry::Key;
use strict;
use warnings;
use base qw(Parse::Win32Registry::Entry);
use Carp;
sub get_name {
my $self = shift;
# the root key of a windows 95 registry has no defined name
# but this should be set to '' when created
return $self->{_name};
}
sub get_path {
my $self = shift;
return $self->{_key_path};
}
sub _look_up_subkey {
my $self = shift;
my $subkey_name = shift;
croak 'Missing subkey name' if !defined $subkey_name;
foreach my $subkey ($self->get_list_of_subkeys) {
if (uc $subkey_name eq uc $subkey->{_name}) {
return $subkey;
}
}
return;
}
sub get_subkey {
my $self = shift;
my $subkey_path = shift;
# check for definedness in case key name is '' or '0'
croak "Usage: get_subkey('key name')" if !defined $subkey_path;
my $key = $self;
# Current path component separator is '\' to match that used in Windows.
# split returns nothing if it is given an empty string,
# and without a limit of -1 drops trailing empty fields.
# The following returns a list with a single zero-length string ("")
# for an empty string, as split(/\\/, $subkey_path, -1) returns (),
# an empty list.
my @path_components = index($subkey_path, "\\") == -1
? ($subkey_path)
: split(/\\/, $subkey_path, -1);
my %offsets_seen = ();
$offsets_seen{$key->get_offset} = undef;
foreach my $subkey_name (@path_components) {
if (my $subkey = $key->_look_up_subkey($subkey_name)) {
if (exists $offsets_seen{$subkey->get_offset}) {
return; # found loop
}
$key = $subkey;
$offsets_seen{$key->get_offset} = undef;
}
else { # subkey name not found, abort look up
return;
}
}
return $key;
}
sub get_value {
my $self = shift;
my $value_name = shift;
# check for definedness in case value name is '' or '0'
croak "Usage: get_value('value name')" if !defined $value_name;
foreach my $value ($self->get_list_of_values) {
if (uc $value_name eq uc $value->{_name}) {
return $value;
}
}
return undef;
}
sub print_summary {
my $self = shift;
print $self->as_string, "\n";
}
sub as_regedit_export {
my $self = shift;
return "[" . $self->{_key_path} . "]\n";
}
sub regenerate_path {
my $self = shift;
# ascend to the root
my $key = $self;
my @key_names = ($key->get_name);
my %offsets_seen = ();
while (!$key->is_root) {
$offsets_seen{$key->get_offset}++;
$key = $key->get_parent;
if (!defined $key) { # found an undefined parent key
unshift @key_names, '(Invalid Parent Key)';
last;
}
if (exists $offsets_seen{$key->get_offset}) { # found loop
unshift @key_names, '(Invalid Parent Key)';
last;
}
unshift @key_names, $key->get_name;
}
my $key_path = join('\\', @key_names);
$self->{_key_path} = $key_path;
return $key_path;
}
sub get_value_data {
my $self = shift;
my $value_name = shift;
croak "Usage: get_value_data('value name')" if !defined $value_name;
if (my $value = $self->get_value($value_name)) {
return $value->get_data;
}
return;
}
sub get_mru_list_of_values {
my $self = shift;
my @values = ();
if (my $mrulist = $self->get_value('MRUList')) {
foreach my $ch (split(//, $mrulist->get_data)) {
if (my $value = $self->get_value($ch)) {
push @values, $value;
}
}
}
elsif (my $mrulistex = $self->get_value('MRUListEx')) {
foreach my $item (unpack('V*', $mrulistex->get_data)) {
last if $item == 0xffffffff;
if (my $value = $self->get_value($item)) {
push @values, $value;
}
}
}
return @values;
}
sub get_list_of_subkeys {
my $self = shift;
my $subkey_iter = $self->get_subkey_iterator;
my @subkeys;
while (my $subkey = $subkey_iter->()) {
push @subkeys, $subkey;
}
return @subkeys;
}
sub get_list_of_values {
my $self = shift;
my $value_iter = $self->get_value_iterator;
my @values;
while (my $value = $value_iter->()) {
push @values, $value;
}
return @values;
}
sub get_subtree_iterator {
my $self = shift;
my @start_keys = ($self);
push my (@subkey_iters), Parse::Win32Registry::Iterator->new(sub {
return shift @start_keys;
});
my $value_iter;
my $key; # used to remember key while iterating values
return Parse::Win32Registry::Iterator->new(sub {
if (defined $value_iter && wantarray) {
my $value = $value_iter->();
if (defined $value) {
return ($key, $value);
}
# $value_iter finished, so fetch a new one
# from the (current) $subkey_iter[-1]
}
while (@subkey_iters > 0) {
$key = $subkey_iters[-1]->(); # depth-first
if (defined $key) {
push @subkey_iters, $key->get_subkey_iterator;
$value_iter = $key->get_value_iterator;
return $key;
}
pop @subkey_iters; # $subkey_iter finished, so remove it
}
return;
});
}
sub walk {
my $self = shift;
my $key_enter_func = shift;
my $value_func = shift;
my $key_leave_func = shift;
if (!defined $key_enter_func &&
!defined $value_func &&
!defined $key_leave_func) {
$key_enter_func = sub { print "+ ", $_[0]->get_path, "\n"; };
$value_func = sub { print " '", $_[0]->get_name, "'\n"; };
$key_leave_func = sub { print "- ", $_[0]->get_path, "\n"; };
}
$key_enter_func->($self) if ref $key_enter_func eq 'CODE';
foreach my $value ($self->get_list_of_values) {
$value_func->($value) if ref $value_func eq 'CODE';
}
foreach my $subkey ($self->get_list_of_subkeys) {
$subkey->walk($key_enter_func, $value_func, $key_leave_func);
}
$key_leave_func->($self) if ref $key_leave_func eq 'CODE';
}
1;