> pp -o GWC.exe -Mattributes GWC.pl
>
It worked!!
> If this works, we still need to figure out why attributes.pm wasn't detected.
> Can you post your script?
It is a large script, but sure if no body minds:
PS the attribute error is on line 11.
#!/usr/bin/perl
use strict;
use warnings;
use Tk;
use Net::SFTP::Foreign;
use threads;
use threads::shared;
use Tk::Dialog;
use Tk::LabFrame;
my $user:shared = 'uas';
my $server:shared = 'updraft.unl.edu';
my $wayrmt:shared = '/home/uas/Scripts/WP';
my $waylcl:shared = 'C:\Documents and Settings\deadpickle\Desktop
\GRRUVI';
my $lat = 0.0;
my $long = 0.0;
my $val = 0;
my $progress: shared = 0;
my $go:shared = 0;
my $die:shared = 0;
my $all:shared = 0;
my $curtime:shared = 0;
my @latlong;
share(@latlong);
my $gone:shared = 0;
my $thr1 = threads->new(\&create);
my $thr2 = threads->new(\&sftp);
#Mainwindow
my $mw = MainWindow->new();
$mw->protocol('WM_DELETE_WINDOW' => sub { &default_save });
$mw->configure(-title => 'GWC: GRRUVI Waypoint Creator');
$mw->geometry('+400+300');
#Menubar
my $mbar = $mw -> Menu();
$mw -> configure(-menu => $mbar);
my $file = $mbar -> cascade(-label=>"File", -underline=>0, -tearoff =>
0);
my $ctrl = $mbar -> cascade(-label=>"Control", -underline=>0, -tearoff
=> 0);
$file -> command(-label =>"Save Config", -underline => 0, -command =>
[\&save, "Save"], -accelerator => 'Ctrl-S');
$file -> command(-label =>"Load Config", -underline => 0, -command =>
[\&load, "Load"], -accelerator => 'Ctrl-L');
$file -> separator;
$file -> command(-label =>"Quit", -underline => 0, -command =>
[\&default_save, "Quit"], -accelerator => 'Ctrl-Q');
$ctrl -> command(-label =>"Add Point", -underline => 0, -command =>
[\&add, "Add Point"], -accelerator => 'Ctrl-A');
$ctrl -> command(-label =>"Remove Point", -underline => 0, -command =>
[\&remove, "Remove Point"], -accelerator => 'Ctrl-R');
$ctrl -> separator;
$ctrl -> command(-label =>"Move Point Up", -underline => 0, -command
=> [\&moveup, "Move Point Up"], -accelerator => 'Ctrl-U');
$ctrl -> command(-label =>"Move Point Down", -underline => 0, -command
=> [\&movedown, "Move Point Down"], -accelerator => 'Ctrl-D');
$ctrl -> separator;
$ctrl -> command(-label =>"Compile", -underline => 0, -command =>
[\&compile, "Compile"], -accelerator => 'Ctrl-C');
$mbar -> command(-label =>"About", -underline => 0, -command =>
[\&about, "About"]);
#Login
my $login = $mw->LabFrame(-label => "Login", -labelside =>
'acrosstop', -width => 110, -height => 50, -fg => 'blue')->pack(-side
=> 'top', -fill => 'x', -pady => 3);
my $usrlbl = $login->Label(-text => 'Username')->pack(-side =>
'left');
my $usreny = $login->Entry(-width=> 10, -textvariable => \$user)-
>pack(-side => 'left', -pady => 3);
my $svrlbl = $login->Label(-text => 'Server')->pack(-side => 'left');
my $svreny = $login->Entry(-width=> 15, -textvariable => \$server)-
>pack(-side => 'left', -pady => 3);
#Waypoint Geometry
my $wayfile = $mw->LabFrame(-label => "Waypoint Generator", -labelside
=> 'acrosstop', -width => 110, -height => 50, -fg => 'blue')->pack(-
side => 'top', -fill => 'x', -pady => 3);
my $way1 = $wayfile->Frame(-relief => 'groove')->pack(-side => 'top', -
fill => 'x');
my $way2 = $wayfile->Frame(-relief => 'groove')->pack(-side => 'top', -
fill => 'x');
my $way3 = $wayfile->Frame(-relief => 'groove')->pack(-side => 'top', -
fill => 'x');
my $way4 = $wayfile->Frame(-relief => 'groove')->pack(-side => 'top', -
fill => 'x');
my $way5 = $way4->Frame(-relief => 'groove')->pack(-side => 'top', -
fill => 'x');
my $way6 = $way4->Frame(-relief => 'groove')->pack(-side => 'top', -
fill => 'x');
my $way7 = $wayfile->Frame(-relief => 'groove')->pack(-side => 'top', -
fill => 'x');
#Waypoint Data
my $latlbl = $way3->Label(-text => 'Lat')->pack(-side => 'left', -
anchor => 'w');
my $lateny = $way3->Entry(-width=> 6, -textvariable => \$lat)->pack(-
side => 'left', -pady => 3 , -anchor=> 'w');
my $longlbl = $way3->Label(-text => 'Long')->pack(-side => 'left', -
anchor => 'w');
my $longeny = $way3->Entry(-width=> 6, -textvariable => \$long)->pack(-
side => 'left', -pady => 3 , -anchor=> 'w');
my $waylcllbl = $way1->Label(-text => 'Local')->pack(-side => 'left', -
anchor => 'e');
my $waylcleny = $way1->Entry(-width=> 37, -textvariable => \$waylcl)-
>pack(-side => 'left', -pady => 3, -anchor => 'e');
my $wayrmtlbl = $way2->Label(-text => 'Remote')->pack(-side => 'left',
-anchor => 'e');
my $wayrmteny = $way2->Entry(-width=> 35, -textvariable => \$wayrmt)-
>pack(-side => 'left', -pady => 3, -anchor => 'e');
#Waypoint Buttons
my $add = $way5->Button(-text => 'add', -bg => 'gray', -command =>
\&add)->pack(-side => 'left', -padx => 3, -pady => 3, -anchor => 's');
my $remove = $way5->Button(-text => 'remove', -bg => 'gray', -command
=> \&remove)->pack(-side => 'left', -padx => 3, -pady => 3, -anchor =>
's');
my $up = $way6->Button(-text => 'move up', -bg => 'gray', -command =>
\&moveup)->pack(-side => 'left', -pady => 3, -padx => 3, -anchor =>
's');
my $down = $way6->Button(-text => 'move down', -bg => 'gray', -command
=> \&movedown)->pack(-side => 'left', -pady => 3 , -padx => 3, -anchor
=> 's');
#waypoint listbox
my $waybox = $way7->Scrolled('Listbox', -scrollbars=> 'osoe', -
width=>20, -bg=>'white', -height=>3, -relief=>'groove', -
selectmode=>'single')->pack(-pady=> 3, -side=> 'left', -anchor=>'ne');
#Compile Button
my $compbtn = $way7->Button(-text => 'Compile', -command => \&compile)-
>pack(-side => 'bottom', -padx => 3, -pady => 3, -anchor => 'e');
#SFTP Geometry
my $sftpfile = $mw->LabFrame(-label => "Status", -labelside =>
'acrosstop', -width => 110, -height => 50, -fg => 'blue')->pack(-side
=> 'top', -fill => 'x', -pady => 3);
my $sftp1 = $sftpfile->Frame(-relief => 'groove')->pack(-side =>
'top', -fill => 'x');
my $sftp2 = $sftpfile->Frame(-relief => 'groove')->pack(-side =>
'top', -fill => 'x');
my $sftp3 = $sftpfile->Frame(-relief => 'groove')->pack(-side =>
'top', -fill => 'x');
#SFTP status
my $box = $sftp3->Listbox(-bg=>'white', -width => 42, -height => 1, -
relief => 'groove')->pack(-side => "left", -fill=>'x');
#timer to display messages
my $load = 1;
my $timer = $mw->repeat(100,\&msg);
my $timer2 = $mw->repeat(100, \&default_load);
#shortcuts
$mw->bind('<Control-Key-s>', sub{&save});
$mw->bind('<Control-Key-l>', sub{&load});
$mw->bind('<Control-Key-q>', sub{&default_save});
$mw->bind('<Control-Key-c>', sub{&compile});
$mw->bind('<Control-Key-a>', sub{&add});
$mw->bind('<Control-Key-r>', sub{&remove});
$mw->bind('<Control-Key-u>', sub{&moveup});
$mw->bind('<Control-Key-d>', sub{&movedown});
MainLoop;
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#save default message box
sub default_save {
my $msg = $mw->messageBox( -title=> 'Save File?', -message=>
"Save to default.gr?", -icon=> 'question', -type=> 'YesNoCancel', -
default=> 'Yes');
#my $ans = $msg->Show;
if ($msg eq 'Yes') {
open DEFAULT, '>', "default.gr" or die "Cannot open
'default.gr' $!";
print DEFAULT "$user\n$server\n$wayrmt\n$waylcl";
close DEFAULT;
clean_exit();
}
if ($msg eq 'No') {
clean_exit();
}
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#default.gr load on startup
sub default_load {
if ($load == 1) {
$load = 0;
my $file = "default.gr";
if (defined $file) {
open LOAD , '<', "$file" or die "Cannot open
'default.gr $!";
my @default = <LOAD>;
chomp @default;
$user = $default[0];
$server = $default[1];
$wayrmt = $default[2];
$waylcl = $default[3];
close LOAD;
}
}
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub about{
my $whatisthis = $mw->Dialog(-text => "GRRUVI Waypoint Creator
\nVersion 0.5\nAuthor: Jamie Lahowetz\n\nGenerates a file that is used
to create the waypoints displayed on GRLevel3", -default_button =>
'Close', -buttons => ['Close']);
my $choice = $whatisthis->Show;
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#Save Config
sub save{
my $types = [['GWC Config Files', ['.gr']], ['Text Files', ['.txt',
'.text']], ['All Files', ['*']]];
my $sfile = $mw->getSaveFile(-defaultextension=> '.gr', -title=>
'Save GWC Config File', -filetypes => $types);
if ($sfile ne ""){
open OUT, '>', "$sfile" or die "Cannot Save $sfile,
$!";
print OUT "$user\n";
print OUT "$server\n";
print OUT "$waylcl\n";
print OUT "$wayrmt\n";
close OUT;
}
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#Load Config
sub load{
my $types = [['GWC Config Files', ['.gr']], ['Text Files', ['.txt',
'.text']], ['All Files', [ '*']]];
my $lfile = $mw->getOpenFile(-title=>'Open GWC Config File', -
filetypes =>$types);
if(defined $lfile){
open IN, '<', "$lfile" or die "Cannot Open $lfile, $!";
my @tfile = <IN>;
chomp @tfile;
$user = $tfile[0];
$server = $tfile[1];
$waylcl = $tfile[2];
$wayrmt = $tfile[3];
close IN;
}
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#Waypoint button routines
sub add{
$waybox->insert('end',"$lat $long");
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub remove{
my $sel = $waybox->curselection();
$waybox->delete($sel);
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub moveup{
my $sel = $waybox->curselection();
my $point = $waybox->get($sel);
$waybox->delete($sel);
my $num = $waybox->index($sel);
my $new = $num-1;
$waybox->insert($new,$point);
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub movedown{
my $sel = $waybox->curselection();
my $point = $waybox->get($sel);
$waybox->delete($sel);
my $num = $waybox->index($sel);
my $new = $num+1;
$waybox->insert($new,$point);
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#Messages
sub msg{
$val = $progress;
if($val == 1){
$box->insert('end', "Connected: $user @ $server");
$box->see('end');
$progress = 0;
}
if( $val == 2){
$box->insert('end', "Connecting: Asking for Password...");
$box->see('end');
$progress = 0;
}
if( $val == 3){
$box->insert('end', "Transfer Done");
$box->see('end');
$progress = 0;
}
if( $val == 4){
$box->insert('end', "Creating File: waytemp...");
$box->see('end');
$progress = 0;
}
if( $val == 5){
$box->insert('end', "File Created");
$box->see('end');
$progress = 0;
}
if( $val == 6){
$box->insert('end', "Uploading: waytemp");
$box->see('end');
$progress = 0;
}
if($val == 7){
$box->insert('end', "Disconnected from Server!! $!");
$box->see('end');
$progress = 0;
}
if($val == 8){
$box->insert('end', "Could Not Connect to Server!! $!");
$box->see('end');
$progress = 0;
}
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#Run create waypoint
sub compile {
$all = $waybox->index('end');
for(my $num = 1;$num <= $all;$num++){
my $new = $num-1;
my $sel = $waybox->get($new);
chomp ($sel);
push(@latlong, $sel);
$go = 1;
}
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#Create Waypoint file
sub create{
$|++;
while(1){
if($die == 1){ goto END };
if ( $gone == 1 ){
$progress = 4;
if($progress == 4){ for(;;){ if( $progress ==
0){last}}}
open TEMP, '>', "$waylcl\\waytemp" or die
"cannot open 'waytemp' $!";
#get lat and long and put in file
for( my $num = 1; $num <= $all; $num++){
open TEMP, '>>', "$waylcl\\waytemp" or
die "cannot open 'waytemp' $!";
print TEMP "NEW\n";
my $new = $num-1;
if( defined $latlong[$new]){
my @points = split(" ",
$latlong[$new]);
my $lat = $points[0];
my $long = $points[1];
if( defined $lat){
print TEMP "$lat $long
\n";
}
}
}
@latlong = ();
close TEMP;
$progress = 5;
if( $progress == 5){ for(;;){ if( $progress ==
0){last}}}
if($die == 1){ goto DNE };
$gone = 0;
}else{ sleep 1}
}
END:
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#SFTP Transfer
sub sftp{
$|++;
while(1){
if($die == 1){ goto END };
if ( $go == 1 ){
$progress = 2;
if( $progress == 2){ for(;;){ if( $progress ==
0){last}}}
my $seconds = 120;
my %args = (host=>$server, user=>$user,
timeout=>$seconds);
my $sftp = Net::SFTP::Foreign->new(%args);
if ($sftp->error){
$progress =8;
if( $progress == 8){ for(;;){if($progress ==
0){last}} goto line;}
}
$progress = 1;
if( $progress == 1){ for(;;){ if( $progress ==
0){last}}}
$gone = 1;
if( $gone == 1){
for(;;){ if( $gone == 0){last}}
}
$sftp->put("$waylcl\\waytemp", "$wayrmt/
waytemp");
if ($sftp->error){
$progress =7;
if( $progress == 7){ for(;;)
{if($progress == 0){last}} goto line;}
}
$progress = 6;
if( $progress == 6){ for(;;){ if( $progress ==
0){last}}}
$progress = 3;
if( $progress == 3){ for(;;){ if( $progress ==
0){last}}}
line:
if($die == 1){ goto END };
undef $sftp; #close current sftp
$go = 0; #turn off self before returning
$progress = 0;
}else { sleep 1 } # sleep if $go == 0
}
END:
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#Clean Exit
sub clean_exit{
$timer->cancel;
$timer2->cancel;
my @running_threads = threads->list;
if (scalar(@running_threads) < 1){exit}
else{
$die = 1;
$thr1->join;
$thr2->join;
exit;
}
}
