Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

data64's scratchpad

by data64 (Chaplain)
on Jun 03, 2004 at 16:35 UTC ( [id://360258]=scratchpad: print w/replies, xml ) Need Help??
Public ScratchpadDownload, Select Code To D/L

Below are two complementary utility I would like to post to the Code Catacombs eventually. There are two minor issues that need to be resolved before that.

Overview

This utilities are intended for WinNT/Win2K platform. They provide a means of taking a snapshot of all the current environment variables and then restore them at some point. This is done by storing the values of all the environment variables in an xml file.

This has an added benifit of being able to use your favourite editor to edit/modify the values in the variables and not having to deal with the pesky little box windows provides to edit these variables.

The issues

issue#1

The restore utility will read the file that you select and display the values of these variables. On my PC (win2k, activestate perl 5.6.1 629) the values of the first few variables do not show up. The utility will set the values of those variables correctly, it just refuses to display them.

issue#2

Clicking on the browse button does display the file select dialog, but it is does not get focus and most of the time is hidden by the main window. Is there any way to get the dialog to be "activated" and get focus.

The Backup Utility

#!perl.exe

use diagnostics;
#use Env;
use English;
use strict;
use vars qw( %env_vars %var_select $filename );
use warnings;

use File::Basename;
use IO::Handle;
use IO::File;
use Tk;
use XML::Writer;
use TK::FileDialog;
use Win32::AdminMisc;

=head1 NAME

SaveWin32EnvVars - Script for setting the environment variables in Win
+32

=head1 SYNOPSIS
    SaveWin32EnvVars


=head1 DESCRIPTION

This script will save the environment variables on win32 platforms to 
an XML file.
It should work on Win 2K and WinNT 4.0. It has not been tested on Win 
+9X and
Win ME platforms. The script brings up a screen that lets you select t
+he 
variables
to save.

=head1 MODULES USED

Win32::AdminMisc
File::Basename
IO::Handle
IO::File
Tk
TK::FileDialog
XML::Writer

=cut


    my $DEBUG = 1;   # set to 0 to turn off debugging
    my $OVERWRITE = 2; # 0 - do not overwrite, 1 - overwrite, 2 - prom
+pt
    my( $var, $def, $response, $old_value, $proceed );
    my @sys_env_vars = ( "ComSpec", "Number_of_Processors", "OS",
             "PROCESSOR_ARCHITECTURE", "PROCESSOR_IDENTIFIER",
             "PROCESSOR_LEVEL", "PROCESSOR_REVISION",
             "Template", "windir", "Os2Lib" );


    #turn on autoflush (required so that the print gets to the screen 
+before 
    #the read)

    STDOUT->autoflush( 1 );

    Win32::AdminMisc::GetEnvVar( \%env_vars, ENV_SYSTEM );


    SetupScreen();

   # print %env_vars;

    #confirm before proceeding
#    print( "SetWin32EnvVars.pl\n" );
#    print( "Following environment variables will be defined " );
#    print( ", existing settings will be overwritten" ) if( $OVERWRITE
+ == 1 );
#    print( ".\n" );
#
 print( "\nDone ... \n");
exit 0;




sub SetupScreen {
    my( $mw, $f, $t, $var, $l_var, $l_def, $c, $e, $bSave,$bBrowse, 
         $bSelect, $bDeselect,  $l, $fd );

    $mw = MainWindow->new();
    $mw->title( "Save System Environment Variables" );

    $filename = "env_vars.xml";
    $fd =$mw->FileDialog( -Create => 1, -Title => "Select Output File"
+, 
              -FPat => "*.xml",
              -SelDir => 0, -Horiz => 1, -Grab => 0,
              -Path => ".", -File => $filename );

    $f = $mw->Frame()->pack( -expand => 1, -fill => 'x' );
    $l = $f->Label( -text => "File Name: " ) -> grid(
             $e = $f->Entry( -textvariable => \$filename),
             $bBrowse = $f->Button( -text => "Browse",
                -command => sub {
                    my $old_fname = $filename;
                    $filename = $fd->Show();
                    if( !defined( $filename ) ) {
                    $filename = $old_fname;
                    }} ),
             $bSelect = $f->Button( -text => "Select All",
                        -command => \&SelectAll ),
             $bDeselect = $f->Button( -text => "Deselect All ",
                        -command => \&DeselectAll ),
             $bSave = $f->Button( -text => "Save",
                -command => [ \&SaveEnvVars, $filename ] )
            );
    $t = $mw->Scrolled( "Text",
            -wrap => 'none',
                -scrollbars => 'osoe'
              ) -> pack( -expand => 1, -fill => 'both' );


    SelectAll();
    foreach $var ( sort keys %env_vars ) {

    $c = $t->Checkbutton( -variable => \$var_select{ $var }, 
                    -cursor => 'arrow' );
    $t->windowCreate( 'end', -window => $c );
    $t->insert( 'end', "  " );

    $l_var = $t->Label( -relief => 'sunken',
                -width => 35,
                -text => $var
              );
    $t->windowCreate('end', -window => $l_var );
    $t->insert( 'end', "  " );

    $l_def = $t->Scrolled( "Label",
               -relief => 'sunken',
               -width => 50,
               -text => $env_vars{$var},
               -anchor => 'w',
               -justify => 'left'
               , -wraplength => 300
             );
    $t->windowCreate('end', -window => $l_def );
    $t->insert( 'end', "\n" );
    }

    $t->configure( -state => 'disabled' );
    $mw->configure( -height => 20, -width => 150 );
    MainLoop;
}

sub SelectAll {
    foreach $var ( sort keys %env_vars ) {
    if( scalar( grep( /\b$var\b/i, @sys_env_vars ) ) < 1 ) {
        $var_select{ $var } = 1;
    } else {
        $var_select{ $var } = 0;
    }
    }
}


sub DeselectAll {
    foreach $var ( sort keys %env_vars ) {
        $var_select{ $var } = 0;
    }
}

sub SaveEnvVars {
    #my $filename = shift;
    #my $filename = "env_vars.xml";
    my $output = IO::File->new( ">$filename" );
    my $writer = XML::Writer->new( OUTPUT => $output, DATAMODE => 1, 
                      NEWLINES => 1 );
    my( $var );

    $writer->startTag( "env_def" );
    foreach $var (sort keys %env_vars ) {
    if( $var_select{ $var } == 1 ) {
        $writer->dataElement( "var", "$env_vars{ $var }", "name" => $v
+ar );
    }
    }
    $writer->endTag( "env_def" );
    $writer->end();
    $output->close();
    exit;
}

[download]

The Restore Utility

#!perl.exe

use diagnostics;
#use Env;
use English;
use strict;
use vars qw( %env_vars %var_select $filename );
use warnings;

use File::Basename;
use IO::Handle;
use IO::File;
use Tk;
use TK::FileDialog;
use XML::Parser;
use Win32::AdminMisc;

=head1 NAME
RestoreWin32EnvVars - Script for restoring the environment variables i
+n Win32

=head1 SYNOPSIS
    RestoreWin32EnvVars filename


=head1 DESCRIPTION

This script will restore the environment variables on win32 platforms 
+from 
an XML file.
It should work on Win 2K and WinNT 4.0. It has not been tested on Win 
+9X and
Win ME platforms. The script brings up a screen that lets you select t
+he 
variables
to restore.

=head1 MODULES USED

Win32::AdminMisc
File::Basename
IO::Handle
IO::File
Tk
TK::FileDialog
XML::Writer
=cut


    my $DEBUG = 0;   # set to 0 to turn off debugging, 1 - to turn on 
+debugging
    my $OVERWRITE = 2; # 0 - do not overwrite, 1 - overwrite, 2 - prom
+pt
    my( $def, $response, $old_value, $proceed );


    #turn on autoflush (required so that the print gets to the screen 
    #before the read)

    STDOUT->autoflush( 1 );

    #Win32::AdminMisc::GetEnvVar( \%env_vars, ENV_SYSTEM );

    SetupScreen();

   # print %env_vars;

    #confirm before proceeding
#
 print( "\nDone ... \n");
exit 0;



sub SetEnvVars {
 my $var;
 foreach $var ( sort keys %env_vars ) {
        if( $var_select{ $var } == 1 ) {
        print( "setting $var to $env_vars{$var}    ...\n");
         Win32::AdminMisc::SetEnvVar( $var, $env_vars{$var}, ENV_SYSTE
+M );
     }
    }

    exit;
}


my( $mw, $f, $t, $var, $l_var, $l_def, $c, $e, $bLoad, $bApply, 
     $bBrowse, $bSelect, $bDeselect, $l, $fd );
my @sys_env_vars = ( "ComSpec", "Number_of_Processors", "OS",
              "PROCESSOR_ARCHITECTURE", "PROCESSOR_IDENTIFIER",
              "PROCESSOR_LEVEL", "PROCESSOR_REVISION",
              "Template", "windir", "Os2Lib" );

sub SetupScreen {

    $mw = MainWindow->new();
    $mw->title( "System Environment Variables" );

    $filename = "env_vars.xml";
    $fd =$mw->FileDialog( -Create => 0, -Title => "Files", -FPat => '*
+.xml',
            -SelDir => 0,
            -Horiz => 1, -Grab => 0, -Path => ".", 
            -File => $filename );

    $f = $mw->Frame()->pack( -expand => 1, -fill => 'x' );
    $l = $f->Label( -text => "File Name: " ) -> grid(
             $e = $f->Entry( -textvariable => \$filename),
             $bBrowse = $f->Button( -text => "Browse",
                -command => sub {
                    my $old_fname = $filename;
                    $filename = $fd->Show();
                    if( !defined( $filename ) ) {
                    $filename = $old_fname;
                    }} ),
             $bLoad = $f->Button( -text => "Load",
                      -command => \&ReadEnvVars  ),
             $bSelect = $f->Button( -text => "Select All",
                      -command => \&SelectAll ),
             $bDeselect = $f->Button( -text => "Deselect All",
                      -command => \&DeselectAll ),
             $bApply = $f->Button( -text => "Apply",
                       -command => \&SetEnvVars )
            );
    $t = $mw->Scrolled( "Text",
            -wrap => 'none',
                -scrollbars => 'osoe'
              ) -> pack( -expand => 1, -fill => 'both' );


    $t->configure( -state => 'disabled' );
    $mw->configure( -height => 20, -width => 150 );
    MainLoop;
}


sub SelectAll {
    foreach $var ( sort keys %env_vars ) {
     if( scalar( grep( /\b$var\b/i, @sys_env_vars ) ) < 1 ) {
         $var_select{ $var } = 1;
     } else {
         $var_select{ $var } = 0;
     }
     }
}

sub DeselectAll {
    foreach $var ( sort keys %env_vars ) {
         $var_select{ $var } = 0;
     }
}

sub ReadEnvVars {
    my $p = XML::Parser->new( Style => 'Stream' );

    $p->parsefile( $filename );

#    print "\n   %env_vars    \n";
    SelectAll();

    $t->configure( -state => 'normal' );
    foreach $var ( sort keys %env_vars ) {

     print "displaying $var => $env_vars{ $var } \n" if $DEBUG;

     $c = $t->Checkbutton( -variable => \$var_select{ $var }, 
                     -cursor => 'arrow' );
     $t->windowCreate( 'end', -window => $c );
     $t->insert( 'end', "  " );

    $l_var = $t->Label( -relief => 'sunken',
                -width => 35,
                -text => $var
              );
    $t->windowCreate('end', -window => $l_var );
    $t->insert( 'end', "  " );

    $l_def = $t->Scrolled( "Label",
               -relief => 'sunken',
#               -width => 250,
               -text => "$env_vars{$var}",
               -anchor => 'w',
               -justify => 'left'
               , -wraplength => 300
             );
    $t->windowCreate('end', -window => $l_def );
    $t->insert( 'end', "\n" );
    #sleep( 1 );
    }
    $t->configure( -state => 'disabled' );


}


my( $var_name, $var_def, @tag_stack );

sub StartTag {
    my( $p, $tag ) = @_;

    push @tag_stack, $tag;
    $var_def = "";

#    print "Found tag $tag \n";
    if( $tag eq "var" ) {
    $var_name = $_{name};
#    print "Found var name: $var_name \n";
    }
}

sub EndTag {
    my $tag = pop @tag_stack;
    if( $tag eq "var" ) {
    print "Inserting $var_name => $var_def \n" if $DEBUG;
    $env_vars{ $var_name } = $var_def;
    }
}

sub Text {
    $var_def .= $_;
}

[download]
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others admiring the Monastery: (8)
As of 2024-10-10 19:27 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    The PerlMonks site front end has:





    Results (45 votes). Check out past polls.
    Notices?
    • erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.