Public bug reported:
I am attaching corrected code below this line:
#!/usr/bin/perl
use Tk;
use Env qw(HOME); #import user's home directory
$file = $ARGV[0] || "$HOME/.vnchosts";
my @machine_list;
if (open (HOSTS, $file))
{
@machine_list = <HOSTS>;
close (HOSTS);
foreach $key (@machine_list){
chomp($key); #kill the newlines...they screw up the connect
}
}
%machines = @machine_list; # build the hash...alias (key) is for the buttons
# address (value) is for the connection
sub about_box {
$mw->Dialog(-text =>"tkvnc is released\nunder the GPL\nCopyright 1999\nby
Marc [EMAIL PROTECTED] 0.6", -title =>'About tkvnc',
-default_button=>'OK', -buttons =>[qw/OK/])->Show;
}
# refresh host database after each additional machine is added or killed
sub update_host_file {
open (HOSTS, ">$file") or die ("Couldn't open $file file:$!\nNew host will
not be saved.\n");
@machine_list = %machines;
foreach $key (@machine_list) {
print HOSTS $key."\n";
}
close (HOSTS);
}
# refresh_buttons kills and redraws the main window after adding or deleting
# a host
sub refresh_buttons {
$mw -> withdraw;
$mw = MainWindow->new;
$mw->title("tkvnc 0.6");
$mbar = $mw->Frame(-width=>200, -height =>25, -relief=>'ridge',
-borderwidth=>2)->pack(
-fill=>'x',
-side=>'top');
$mw->Label(-text=>"Select machine to control:")->pack(-side=>'top',
-expand=>0, -fill=>'none');
$buttonframe = $mw->Frame->pack(-fill=>'both', -side=>'bottom');
$bt = $buttonframe->Scrolled("Text", width =>23, -scrollbars =>'oe')
->pack(-expand=>1, -fill=>'both');
$bt ->configure(-state =>'disabled'); # no typing allowed!
$mbar->Menubutton(-text => "File",
-menuitems => [[ 'command' => "Add host...",
-command => \&add_host],
[ 'command' => "Delete host...",
-command => \&kill_host],
[ 'command' => "Exit",
-command =>sub{exit}]])->pack(
-side => 'left',
-anchor => 'w'
);
$mbar->Menubutton(-text => "Help",
-menuitems => [ [ 'command' => "About tkvnc...",
-command => \&about_box]])->pack(
-side =>'left',
-anchor => 'w'
);
foreach $key (sort keys (%machines)){
$buttitem = $bt->Button(-text=>"$key", -width =>20, -height
=>1,-command=>[\&do_launch, $machines{$key}]);
$bt->windowCreate('end', -window => $buttitem);
$bt->insert('end',"\n");
}
}
# do_launch actually starts the vnc client. It needs to be named
# xvncviewer on your machine. Feel free to hack my code if your
# viewer is named differently
sub do_launch {
my ($hook_to) = @_;
print $hook_to;
system "xvncviewer -passwd $HOME/.vnc/passwd $hook_to:0 &";
}
# add_host: pop up a dialog with 2 entry fields, one for button label and one
# for the host name or IP
sub add_host {
$addbox = $mw ->Toplevel();
$addbox->title("Add Host");
$addbox->Button(-text => "OK",
-command => [sub { $addbox->withdraw;
$machines{$hostname}=$hostadd;
$buttitem
=$bt->Button(-text=>"$hostname", -width =>20, -height =>1,
-command=>[\&do_launch, $machines{$hostname}]);
$bt->windowCreate('end',
-window=>$buttitem);
$bt->insert('end',"\n");
update_host_file;
$hostname="";
$hostadd="";
}])->pack(
-side =>'bottom');
$addbox->Label(-text=>"Host name (for button)")->pack(
-side =>'top');
$addbox->Entry(-textvariable=> \$hostname)->pack(
-side =>'top');
$addbox->Label(-text=>"Host name or IP")->pack(
-side =>'top');
$addbox->Entry(-textvariable=> \$hostadd)->pack(
-side =>'top');
}
# now we use this one to get rid of pesky host machines that we no longer want
# or need
sub kill_host {
$killbox = $mw->Toplevel();
$killbox->title("Delete Host");
$killbox->Button(-text=>"Delete",
-command=>[ sub { $killbox ->withdraw;
if ($machines{$hostname}) {
delete $machines{$hostname};
update_host_file;
refresh_buttons;
}
$hostname="";
}])->pack(
-side=>'bottom');
$killbox->Label(-text=>"Host name to delete")->pack(
-side=>'top');
$killbox->Entry(-textvariable=> \$hostname)->pack(
-side=>'top');
}
# Here be the GUI stuff...the stuff not shoved in subroutines, anyway.
$mw = MainWindow->new;
refresh_buttons;
MainLoop;
** Affects: tkvnc (Ubuntu)
Importance: Undecided
Status: Unconfirmed
--
tkvnc for edgy is missing some dashes on options, making it fail.
https://launchpad.net/bugs/69177
--
ubuntu-bugs mailing list
[email protected]
https://lists.ubuntu.com/mailman/listinfo/ubuntu-bugs
