Article 1127 of alt.sources:
Xref: feenix.metronet.com alt.sources:1127 comp.lang.perl:2865 comp.lang.tcl:2205
Path: feenix.metronet.com!news.utdallas.edu!tamsun.tamu.edu!cs.utexas.edu!zaphod.mps.ohio-state.edu!howland.reston.ans.net!newsserver.jvnc.net!gmd.de!dearn!barilvm!vms.huji.ac.il!wisipc.weizmann.ac.il!menora.weizmann.ac.il!
 dov
Newsgroups: alt.sources,comp.lang.perl,comp.lang.tcl
Subject: Accessing wish from perl
Message-ID: <1993May19.195046.14359@wisipc.weizmann.ac.il>
From: dov@menora.weizmann.ac.il (Dov Grobgeld)
Date: Wed, 19 May 1993 19:50:46 GMT
Sender: news@wisipc.weizmann.ac.il
Organization: Weizmann Institute of Science, Computation Center.
X-Newsreader: Tin 1.1 PL4
Lines: 183

Here is a library for accessing the tcl/tk wish script from within perl.
A short example script is included.

It is based on the perlwafe script by Gustaf Neumann in the wafe distribution.

---- Cut Here and unpack ----
#!/bin/sh
# This is a shell archive (shar 3.24)
# made 05/19/1993 19:36 UTC by dov@menora
# Source directory /u2/dov/tkprog
#
# existing files WILL be overwritten
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#   1564 -rw-r--r-- wish.pl
#   1956 -rwxr-xr-x pwsimple
#
if touch 2>&1 | fgrep '[-amc]' > /dev/null
 then TOUCH=touch
 else TOUCH=true
fi
# ============= wish.pl ==============
echo "x - extracting wish.pl (Text)"
sed 's/^X//' << 'SHAR_EOF' > wish.pl &&
X######################################################################
X#  wish.pl
X#
X#  Support for communicating with wish from a perl program.
X#
X#  This library provides a couple of subroutines for easy access
X#  of wish from within a perl program.
X#
X#  Commands are sent to wish through the 'wish' subroutine and
X#  are read from wish through the WISH file handle.
X#
X#  The user program only needs to run startWish in order to fork
X#  off a process that runs wish.
X#
X#  Credits:
X#     This library is based on Gustaf Neumann's perlwafe script.
X#
X#  Dov Grobgeld
X#  The Weizmann Institute of Science
X#  Rehovot, Israel
X#  19 May 1993
X######################################################################
X
X$wishbin = "/usr/local/bin/wish";
X
Xsub main'startWish {
X    die "socketpair unsuccessful: $!!\n"
X        unless socketpair(W0,WISH,1,1,0);
X
X    if ($pid=fork) {
X        select(WISH); $|=1;
X        select(STDOUT);
X        return $pid;
X    }
X    elsif (defined $pid) {
X        # The child process just duplicates W0 to STDIN and STDOUT
X        # executes wish and then quits.
X
X        open(STDOUT, ">&W0");
X        open(STDIN, ">&W0");
X        close(W0);
X        select(STDOUT); $| = 1;
X        exec "$wishbin --";
X        # || die "Couldn't execute $wishbin.\n";
X        exit;
X    } else {
X        die "fork error: $!\n";
X    }
X}
X&startWish;
X
Xsub wish {
X    local($_)=$_[0];
X    local($*)=1;
X    s/#.*//g;
X    s/^$//g;
X    print WISH $_;
X}
X
X# Create some TCL procedures
Xprint WISH 'proc echo {s} {puts stdout $s; flush stdout}',"\n";
X
X1; # Return 1
SHAR_EOF
$TOUCH -am 0519223593 wish.pl &&
chmod 0644 wish.pl ||
echo "restore of wish.pl failed"
set `wc -c wish.pl`;Wc_c=$1
if test "$Wc_c" != "1564"; then
	echo original size 1564, current size $Wc_c
fi
# ============= pwsimple ==============
echo "x - extracting pwsimple (Text)"
sed 's/^X//' << 'SHAR_EOF' > pwsimple &&
X#!/usr/local/bin/perl
X#####################################################################
X#  pwsimple - perlwish simple
X#
X#  A simple example of how to use the wish.pl library.
X#
X#  Dov Grobgeld
X#  The Weizmann Institute of Science
X#  Rehovot, Israel
X#  18 May 1993
X#####################################################################
X
Xrequire 'wish.pl';
X
X# $debug++; # Set to see all that comes back from wish
X
X#######################################################
X#  wish defaults are provides as perl variables
X#######################################################
X
X$def="-bg darkgreen";
X$buttonDef="-bg firebrick -activeb firebrick " .
X           "-fg white -activef white " .
X           "-font 10x20";
X
X&wish(<<End_of_wish);
X    #################################################################
X    #  This example creates two buttons with simple echo callbacks.
X    #################################################################
X
X    frame .f $def -relief raised -border 5
X    pack append . .f {top fill expand}
X
X    button .f.button-pressme $buttonDef \\
X      -text "Press me" \\
X      -command {echo "print:That's nice!" }
X    button .f.button-quit $buttonDef \\
X      -activeb orange \\
X      -text quit \\
X      -command { echo "cmd:quit" }
X    pack append .f .f.button-pressme {top fill pady 3 expand} \\
X                   .f.button-quit {top expand pady 20}
X
XEnd_of_wish
X
X###################################################################
X# Here is the main loop which receives and sends commands
X# to wish.
X###################################################################
Xwhile (<WISH>) {
X    chop;
X    print "Wish sais: <$_>\n" if $debug;
X    if (/^cmd:/) {
X        $_=$';
X        if (/quit/) {
X            print WISH "destroy .\n"; wait; # Wait for WISH to die
X            last;
X        }
X    }
X    elsif (/^print:/) {
X        print $',"\n";
X    }
X    else {
X        print "Wish error: $_\n";
X    }
X}
SHAR_EOF
$TOUCH -am 0518153093 pwsimple &&
chmod 0755 pwsimple ||
echo "restore of pwsimple failed"
set `wc -c pwsimple`;Wc_c=$1
if test "$Wc_c" != "1956"; then
	echo original size 1956, current size $Wc_c
fi
exit 0

--
                                                        ___   ___
                                                      /  o  \   o \
Dov Grobgeld                                         ( o  o  ) o   |
The Weizmann Institute of Science, Israel             \  o  /o  o /
"Where the tree of wisdom carries oranges"              | |   | |
                                                       _| |_ _| |_