Parse-Win32Registry

 view release on metacpan or  search on metacpan

bin/gtkregcompare.pl  view on Meta::CPAN

#!/usr/bin/perl
use strict;
use warnings;

use Glib ':constants';
use Gtk2 -init;

my $window_width = 600;
my $window_height = 400;

use File::Basename;
use File::Spec;
use Parse::Win32Registry 0.51 qw( make_multiple_subtree_iterator
                                  make_multiple_subkey_iterator
                                  make_multiple_value_iterator
                                  compare_multiple_keys
                                  compare_multiple_values
                                  hexdump );

binmode(STDOUT, ':utf8');

my $script_name = basename $0;

### REGISTRY FILE STORE

use constant {
    REGCOL_FILENAME => 0,
    REGCOL_EMBEDDED_FILENAME => 1,
    REGCOL_TIMESTAMP => 2,
    REGCOL_DIRECTORY => 3,
    REGCOL_REGISTRY => 4,
};

my $registry_store = Gtk2::ListStore->new(
    'Glib::String', 'Glib::String', 'Glib::String', 'Glib::String',
    'Glib::Scalar',
);

### TREE STORE

use constant {
    TREECOL_NAME => 0,
    TREECOL_CHANGES => 1,
    TREECOL_KEYS => 2,
    TREECOL_VALUES => 3,
    TREECOL_ICON => 4,
};

my $tree_store = Gtk2::TreeStore->new(
    'Glib::String', 'Glib::Scalar', 'Glib::Scalar', 'Glib::Scalar',
    'Glib::String',
);

my $tree_view = Gtk2::TreeView->new($tree_store);

my $icon_cell = Gtk2::CellRendererPixbuf->new;
my $name_cell = Gtk2::CellRendererText->new;
my $tree_column0 = Gtk2::TreeViewColumn->new;
$tree_column0->set_title('Name');
$tree_column0->pack_start($icon_cell, FALSE);
$tree_column0->pack_start($name_cell, TRUE);
$tree_column0->set_attributes($icon_cell,
    'stock-id', TREECOL_ICON);
$tree_column0->set_attributes($name_cell,
    'text', TREECOL_NAME);
$tree_view->append_column($tree_column0);
$tree_column0->set_resizable(TRUE);

$tree_view->set_rules_hint(TRUE);

# row-expanded when row is expanded (e.g. after user clicks on arrow)
$tree_view->signal_connect('row-expanded' => \&expand_row);
$tree_view->signal_connect('row-collapsed' => \&collapse_row);
# row-activated when user double clicks on row
$tree_view->signal_connect('row-activated' => \&activate_row);

my $tree_selection = $tree_view->get_selection;
$tree_selection->set_mode('browse');
$tree_selection->signal_connect('changed' => \&tree_item_selected);

my $scrolled_tree_view = Gtk2::ScrolledWindow->new;
$scrolled_tree_view->set_policy('automatic', 'automatic');
$scrolled_tree_view->set_shadow_type('in');
$scrolled_tree_view->add($tree_view);

### LIST STORE

use constant {

bin/gtkregcompare.pl  view on Meta::CPAN

        <menu action='SearchMenu'>
            <menuitem action='Find'/>
            <menuitem action='FindNext'/>
            <separator/>
            <menuitem action='FindChange'/>
            <menuitem action='FindNextChange'/>
        </menu>
        <menu action='ViewMenu'>
            <menuitem action='ShowDetail'/>
            <separator/>
        </menu>
        <menu action='HelpMenu'>
            <menuitem action='About'/>
        </menu>
    </menubar>
    <accelerator action='FindNext2'/>
    <accelerator action='FindNextChange2'/>
</ui>
END_OF_UI

$uimanager->add_ui_from_string($ui_info);

my $menubar = $uimanager->get_widget('/MenuBar');

### STATUSBAR

my $statusbar = Gtk2::Statusbar->new;

### VBOX

my $main_vbox = Gtk2::VBox->new(FALSE, 0);
$main_vbox->pack_start($menubar, FALSE, FALSE, 0);
$main_vbox->pack_start($vpaned1, TRUE, TRUE, 0);
$main_vbox->pack_start($statusbar, FALSE, FALSE, 0);

### WINDOW

my $window = Gtk2::Window->new;
$window->set_default_size($window_width, $window_height);
$window->set_position('center');
$window->signal_connect(destroy => sub { Gtk2->main_quit });
$window->add($main_vbox);
$window->add_accel_group($uimanager->get_accel_group);
$window->set_title($script_name);
$window->show_all;

###############################################################################

sub build_open_files_dialog {
    my $registry_view = Gtk2::TreeView->new($registry_store);
    $registry_view->set_reorderable(TRUE);

    my $registry_column0 = Gtk2::TreeViewColumn->new_with_attributes(
        'Filename', Gtk2::CellRendererText->new,
        'text', REGCOL_FILENAME);
    $registry_view->append_column($registry_column0);
    $registry_column0->set_resizable(TRUE);

    my $registry_column1 = Gtk2::TreeViewColumn->new_with_attributes(
        'Embedded Filename', Gtk2::CellRendererText->new,
        'text', REGCOL_EMBEDDED_FILENAME);
    $registry_view->append_column($registry_column1);
    $registry_column1->set_resizable(TRUE);

    my $registry_column2 = Gtk2::TreeViewColumn->new_with_attributes(
        'Embedded Timestamp', Gtk2::CellRendererText->new,
        'text', REGCOL_TIMESTAMP);
    $registry_view->append_column($registry_column2);
    $registry_column2->set_resizable(TRUE);

    my $registry_column3 = Gtk2::TreeViewColumn->new_with_attributes(
        'Directory', Gtk2::CellRendererText->new,
        'text', REGCOL_DIRECTORY);
    $registry_view->append_column($registry_column3);
    $registry_column3->set_resizable(TRUE);

    my $scrolled_registry_view = Gtk2::ScrolledWindow->new;
    $scrolled_registry_view->set_policy('automatic', 'automatic');
    $scrolled_registry_view->set_shadow_type('in');
    $scrolled_registry_view->add($registry_view);

    my $selection = $registry_view->get_selection;
    $selection->set_mode('multiple');

    my $label = Gtk2::Label->new;
    $label->set_markup('<i>Drag files to reorder them</i>');

    my $dialog = Gtk2::Dialog->new('Select Registry Files', $window, 'modal',
        'gtk-clear' => 70,
        'gtk-add' => 60,
        'gtk-remove' => 50,
        'gtk-cancel' => 'cancel',
        'gtk-ok' => 'ok',
    );
    $dialog->set_size_request($window_width * 1, $window_height * 0.8);
    $dialog->vbox->pack_start($scrolled_registry_view, TRUE, TRUE, 0);
    $dialog->vbox->pack_start($label, FALSE, FALSE, 5);
    $dialog->set_default_response('ok');

    $dialog->signal_connect(delete_event => sub {
        $dialog->hide;
        return TRUE;
    });
    $dialog->signal_connect(response => sub {
        my ($dialog, $response) = @_;
        if ($response eq '70') {
            $registry_store->clear;
        }
        elsif ($response eq '60') {
            my @filenames = choose_files();
            foreach my $filename (@filenames) {
                my ($name, $path) = fileparse($filename);
                if (my $registry = Parse::Win32Registry->new($filename)) {
                    if (my $root_key = $registry->get_root_key) {
                        add_registry($registry);
                    }
                }
                else {
                    show_message('error', "'$name' is not a registry file.");
                }
            }

bin/gtkregcompare.pl  view on Meta::CPAN

                TREECOL_NAME, $key_name,
                #TREECOL_CHANGES, \@changes,
                TREECOL_KEYS, $subkeys,
                TREECOL_ICON, 'gtk-directory');
        }
        my $dummy = $model->append($iter); # placeholder for children
    }

    my $values_iter = make_multiple_value_iterator(@keys);

    while (defined(my $values = $values_iter->get_next)) {
        my @changes = compare_multiple_values(@$values);
        my $num_changes = grep { $_ } @changes;
        # insert a 'blank' change for missing values
        for (my $i = 0; $i < @changes; $i++) {
            if ($changes[$i] eq '' && !defined $values->[$i]) {
                $changes[$i] = ' ';
            }
        }

        my $any_value = (grep { defined } @$values)[0];
        my $value_name = $any_value->get_name;
        $value_name = "(Default)" if $value_name eq '';
        $value_name =~ s/\0/[NUL]/g;

        my $iter = $model->append($parent_iter);

        if ($num_changes > 0) {
            $model->set($iter,
                TREECOL_NAME, $value_name,
                TREECOL_CHANGES, \@changes,
                TREECOL_KEYS, $keys,
                TREECOL_VALUES, $values,
                TREECOL_ICON, 'gtk-file');
        }
        else {
            $model->set($iter,
                TREECOL_NAME, $value_name,
                #TREECOL_CHANGES, \@changes,
                TREECOL_KEYS, $keys,
                TREECOL_VALUES, $values,
                TREECOL_ICON, 'gtk-file');
        }
    }
}

sub add_registry {
    my $registry = shift;

    my $filename = $registry->get_filename;

    my $embedded_filename = $registry->get_embedded_filename;
    $embedded_filename = '' if !defined $embedded_filename;

    my $timestamp = $registry->get_timestamp;
    $timestamp = defined $timestamp ? $registry->get_timestamp_as_string : '';

    my $iter = $registry_store->append;
    $registry_store->set($iter,
        REGCOL_FILENAME, basename($filename),
        REGCOL_EMBEDDED_FILENAME, $embedded_filename,
        REGCOL_TIMESTAMP, $timestamp,
        REGCOL_DIRECTORY, dirname($filename),
        REGCOL_REGISTRY, $registry,
    );
}

sub choose_files {
    my $file_chooser = Gtk2::FileChooserDialog->new(
        'Select Registry File(s)',
        undef,
        'open',
        'gtk-cancel' => 'cancel',
        'gtk-ok' => 'ok',
    );
    $file_chooser->set_select_multiple(TRUE);
    if (defined $last_dir) {
        $file_chooser->set_current_folder($last_dir);
    }
    my @filenames = ();
    my $response = $file_chooser->run;
    if ($response eq 'ok') {
        @filenames = $file_chooser->get_filenames;
    }
    $last_dir = $file_chooser->get_current_folder;
    $file_chooser->destroy;
    return @filenames;
}

sub open_files {
    # refresh $registry_store with contents of @registries...
    $registry_store->clear;
    foreach my $registry (@registries) {
        add_registry($registry);
    }

    $open_files_dialog->show_all;
}

sub close_files {
    @root_keys = ();
    # @registries is not cleared to retain currently selected files

    $find_param = '';
    $find_iter = undef;
    $change_iter = undef;

    $tree_store->clear;
    $list_store->clear;
    $text_buffer->set_text('');
    $statusbar->pop(0);

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

sub quit {
    $window->destroy;



( run in 1.183 second using v1.01-cache-2.11-cpan-71847e10f99 )