Use of reserved word "our" is deprecated at Z:/perl583/lib/Socket.pm
 line 3.
Use of reserved word "our" is deprecated at Z:/perl583/lib/warnings/
register.pm line 3.
Can't modify subroutine entry in scalar assignment at Z:/perl583/lib
/warnings/register.pm line 3, near "'1.00';"
BEGIN failed--compilation aborted at Z:/perl583/lib/Socket.pm line 1
79.
BEGIN failed--compilation aborted at N:/wntapp/perl/perl583/lib/Net/FTP.pm line
17.
BEGIN failed--compilation aborted at prj/ftpdialog.pm line 18.
BEGIN failed--compilation aborted at prj/cwidgets.pm line 18.
BEGIN failed--compilation aborted at D:\mona\mona.pl line 16.

#!/usr/bin/perl -w
# ################################################
# cwidget.pm #                             perl 5
# ############
# 
# MoniQuE - Administration 
#
# cFile-Klasse                   
#
#
# ################################################
# don't use strict;

use lib "Z:/perl583/lib";
use warnings;
use Tk;
use Tk::DialogBox;
use Tk::HList;
use Net::FTP;

package prj::ftpdialog;

sub new
{
        my     $this         = shift;
        my     $thisref     = ref($this) || $this;
        my     $self;
            $self->{'parent'}        = $_[0];
            $self->{"ftpuser"}         = "qstest";
            $self->{"ftppass"}         = "qs-test";
            $self->{"ftpserver"}     = "monique";
            $self->{"remoteroot"}    = $_[1];
            $self->{"localroot"}    = $_[2];
            $self->{"locallist"}    = undef;
            $self->{"remotelist"}    = undef;

        bless ($self, $thisref);
        return $self;
}

sub Show
{
    my     $self = shift;
        
    my     $dialog    = $self->{'parent'}->DialogBox     (
               -title   =>  "FTP-Transfer",
               -default_button   =>    "Exit",
               -buttons  => ['Exit'],              
   );
    #    positioning frames              
               
    my     $dheadl = $dialog->add    ('Frame')->pack(-side=>'left');
    my     $dheadr = $dialog->add    ('Frame')->pack(-side=>'right');
    my     $dheadc = $dialog->add    ('Frame')->pack(-side=>'bottom');

     #    Create Heads  
         $dheadl->Label(    -text             =>     "Lokales Laufwerk", 
               
         )->pack(-side =>'top', -fill=>'y');

         $dheadr->Label(    -text             =>     "Entferntes Laufwerk", 
               
         )->pack(-side =>'top', -fill=>'y');
    #    Create local view
        my     $locallist = $dheadl->Scrolled( 
               
               
              'HList', 
              -header             =>     1, 
              -columns             =>     3, 
              -width =>    50,
              -command  => sub{localclick();},
               
               
          )->pack(-side =>'bottom', -anchor => 'w');

            $locallist->header('create', 0, -text => 'Dateiname');
            $locallist->header('create', 1, -text => 'Datum');
            $locallist->header('create', 2, -text => 'OGA');


            $locallist->columnWidth (1, -char => 20);
            $locallist->columnWidth (2, -char => 5);
             $self->{'locallist'} = $locallist;
             
             &reloadlocaldir($self);
    
    #    Create remote view
        my     $remotelist = $dheadr->Scrolled( 
              'HList', 
              -header             =>     1, 
              -columns             =>     3, 
              -width =>    50,
              -command            =>    sub{remoteclick();},
          )->pack(-side =>'bottom', -anchor => 'e');

            $remotelist->header('create', 0, -text => 'Dateiname');
            $remotelist->header('create', 1, -text => 'Datum');
            $remotelist->header('create', 2, -text => 'OGA');


            $remotelist->columnWidth (1, -char => 20);
            $remotelist->columnWidth (2, -char => 5);
             $self->{'remotelist'} = $remotelist;

             &reloadremotedir($self);
    
    #     create Button List
        $dialog->Show();
    return;
}

#    reload directory content
sub reloadlocaldir
{
    my $self = $_[0];
print "opening $self->{'localroot'}\n";
     opendir(DIR,$self->{'localroot'}) or die $!;
     $self->{'locallist'}->delete("all");

     while(my $file = readdir(DIR)){
       my $path = $self->{'localroot'}.'/'.$file;
       my ($date,$permissions) = (stat($path))[8,2];
       my      @sdate = localtime($date);
            $date = sprintf ("%02i.%02i.%04i %02i:%02i:%02i", $sdate[3], $sdate[4], $sdate[5] + 1900, $sdate[2], $sdate[1], $sdate[0]);
            $permissions = sprintf("%4o",$permissions & 07777);
            $self->{'locallist'}->add($i);
            if (-d $path)
            {
               
 $file .= "/";
            }
       my $l = 0;
       for($file,$date,$permissions){
         $self->{'locallist'}->itemCreate($i,$l,-text => $_);
         $l++;
       }
       $i++;
     }
     
     closedir (DIR);
    
}

#    reload directory content
sub reloadremotedir
{
    my $self = $_[0];
    
     opendir(DIR,$self->{'remoteroot'}) or die $!;
     
     $self->{'remotelist'}->delete("all");
     while(my $file = readdir(DIR)){
       my $path = $self->{'remoteroot'}.'/'.$file;
       my ($date,$permissions) = (stat($path))[8,2];
       my      @sdate = localtime($date);
            $date = sprintf ("%02i.%02i.%04i %02i:%02i:%02i", $sdate[3], $sdate[4], $sdate[5] + 1900, $sdate[2], $sdate[1], $sdate[0]);
            $permissions = sprintf("%4o",$permissions & 07777);
            $$self->{'remotelist'}->add($i);
            if (-d $path)
            {
               
 $file .= "/";
            }
       my $l = 0;
       for($file,$date,$permissions){
         $self->{'remotelist'}->itemCreate($i,$l,-text => $_);
         $l++;
       }
       $i++;
     }
     
     closedir (DIR);
    
}

sub localclick
{
    my $self = shift;
}

sub remoteclick
{
    my $self = shift;
}

return 1;

#!/usr/bin/perl -w
# ################################################
# Mona.pl #                                perl 5
# #########
# 
# MoniQuE - Administration 
#
# Tool zur Steuerung von MoniQuE
#
#
# ################################################

use Tk;
use strict;

use prj::cwidgets;
use prj::login;

my $cwindow = prj::cwidgets->new();

MainLoop;
print "quitting...\n";

my $dialog = prj::ftpdialog->new(...);
     $dialog->show();