view release on metacpan or  search on metacpan

bin/gtkregcompare.pl  view on Meta::CPAN

    foreach my $column (@columns) {
        $tree_view->remove_column($column);
    }
}

sub quit {
    $window->destroy;
}

sub about {
    Gtk2->show_about_dialog(undef,
        'program-name' => $script_name,
        'version' => $Parse::Win32Registry::VERSION,
        'copyright' => 'Copyright (c) 2008-2012 James Macfarlane',
        'comments' => 'GTK2 Registry Compare for the Parse::Win32Registry module',
    );
}

sub show_message {
    my $type = shift;
    my $message = shift;

    my $dialog = Gtk2::MessageDialog->new(
        $window,
        'destroy-with-parent',
        $type,
        'ok',
        $message,
    );
    $dialog->set_title(ucfirst $type);
    $dialog->run;
    $dialog->destroy;
}

sub get_location {
    my ($model, $iter) = $tree_selection->get_selected;
    if (defined $model && defined $iter) {
        my $keys = $model->get($iter, TREECOL_KEYS);
        my $values = $model->get($iter, TREECOL_VALUES);
        return ($keys, $values);
    }
    else {
        return ();
    }
}

sub copy_path {
    my ($keys, $values) = get_location;
    my $clip = '';
    if (defined $keys) {
        my $any_key = (grep { defined } @$keys)[0];

        if (defined $values) { # only values
            my $any_value = (grep { defined } @$values)[0];
            $clip = $any_key->get_path . ", " . $any_value->get_name;
        }
        else {
            $clip = $any_key->get_path;
        }
    }
    my $clipboard = Gtk2::Clipboard->get(Gtk2::Gdk->SELECTION_CLIPBOARD);
    $clipboard->set_text($clip);
}

sub find_matching_child_iter {
    my ($iter, $name, $icon) = @_;

    return if !defined $iter;

    my $child_iter = $tree_store->iter_nth_child($iter, 0);
    if (!defined $child_iter) {
        return;
    }

    # Make sure children are real
    if (!defined $tree_store->get($child_iter, 0)) {
        my $keys = $tree_store->get($iter, TREECOL_KEYS);
        add_children($keys, $tree_store, $iter);
        $tree_store->remove($child_iter); # remove dummy items
        $child_iter = $tree_store->iter_nth_child($iter, 0); # refetch items
    }

    while (defined $child_iter) {
        my $child_icon = $tree_store->get($child_iter, TREECOL_ICON);

        if ($icon eq 'gtk-directory') {
            my $child_keys = $tree_store->get($child_iter, TREECOL_KEYS);
            my $any_child_key = (grep { defined } @$child_keys)[0];
            if ($any_child_key->get_name eq $name) {
                return $child_iter; # match found
            }
        }
        else {
            my $child_values = $tree_store->get($child_iter, TREECOL_VALUES);
            if (defined $child_values) {
                my $any_child_value = (grep { defined } @$child_values)[0];
                if ($any_child_value->get_name eq $name) {
                    return $child_iter; # match found
                }
            }
        }

        $child_iter = $tree_store->iter_next($child_iter);
    }
    return; # no match found
}

sub go_to_subkey_and_value {
    my $subkey_path = shift;
    my $value_name = shift;

    my @path_components = index($subkey_path, "\\") == -1
                        ? ($subkey_path)
                        : split(/\\/, $subkey_path, -1);

    my $iter = $tree_store->get_iter_first;
    return if !defined $iter; # no registry loaded

    while (defined(my $subkey_name = shift @path_components)) {
        my $keys = $tree_store->get($iter, TREECOL_KEYS);
        if (@$keys == 0) {
            return;