File Coverage

blib/lib/Parse/Win32Registry/Key.pm

Criterion	Covered	Total	%
statement	105	133	78.9
branch	26	48	54.1
condition	4	9	44.4
subroutine	19	24	79.1
pod	0	13	0.0
total	154	227	67.8

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;