#!/usr/local/bin/perl 
use Tk;
my $mw = MainWindow->new;
$mw->Button(  -text=>"Hello" , -command=>sub{exit}  )->grid;
$box1 = $mw->Listbox(  -x=>1, -y=>10,-width=>10, -selectmode=>'single' ,-height=>0)->grid;
$scr1 = $mw->Scrollbar( -x=>2, -y=>10, -command=>sub{exit})->grid;
#$box1->configure(-command=>sub{exit});
$box1->insert('end',"dd","eee","ff");
$box1->insert('end',"ii","jj","kk");
MainLoop;


exit(0);
$home = $ENV{"HOME"};
$host = `hostname`;
chomp $host;
$directory = `pwd`;              
chomp $directory;
#
# discover the pager tool in use 
$pager = $ENV{"PAGER"};


 
if (length($pager)== 0 || !-e $pager ) {
  $pager = `which cat`;
  };



# determine install files that need to be copied
# tool repository
$releases = "/user/mjames/altera_breadboarding/releases";

#where the help file is 
$helpfile = "$releases/makeversion.txt";
#where the extended help file is 
$helpfile_long = "$releases/makeversion_long.txt";



#file to edit for version
$versionf  = "version.h";
$versiont  = "version.h.tmp";

# workout command line options 
#is this a query of releases 
# COde 0 : query (L option) versions
# code 1 : install
# code 2 : release
# code 3 : help (short)
# code 4 : show trial install
# code 5 : help (full)

$oper = 3;
$relnamegiven = 0;
$relname = "Default";
for($idx=0;$idx <= $#ARGV;$idx++) {
  $item = $ARGV[$idx];
  if (length($item)>0) {
    if( $item =~ /^-Release/ ) { 
      print("Release\n");
      $oper = 2;

      if (length( $item)>8) {
        $relname = substr $item,8;
        $relnamegiven = 1;
        };
      };
    if( $item =~ /^-[iI]/ ) { 
      print("Install\n");
      $oper = 1;
      if (length($ARGV[0])>2) {
        $relname = substr $item,2;
        $relnamegiven = 1;
        }; 
      };
    if( $item =~ /^-[tT]/ ) { 
      print("Trial Install\n");
      $oper = 4;
      if (length($ARGV[0])>2) {
        $relname = substr $item,2;
        $relnamegiven = 1;
        }; 
      };
    if( $item =~ /^-[lL]/ ) { 
      print("List releases \n");
      $oper = 0;
      };
    if( $item =~ /^-[hH]/ ) { 
      print("Extended Help \n");
      $oper = 5;
      };
    if( $item =~ /^-[uU]/ ) { 
      print("UnInstall\n");
      $oper = 6;
      if (length($ARGV[0])>2) {
        $relname = substr $item,2;
        $relnamegiven = 1;
        }; 
      };
    };
  };




if ( ($oper == 3 || $oper == 5) && -e "$helpfile") {
#printout of revision number to a suitable pager 
    open (IN,"<$helpfile");
    open (PAGER, "|$pager");
    while (<IN>) {
      print PAGER ;
      };
    close IN;
    if ( $oper == 5 && -e "$helpfile_long") {
      open (IN,"<$helpfile_long");
      while (<IN>) {
        print PAGER ;
        };
      };
    close (PAGER);
    exit;
    };




#make a date etc from it
$tim =`date`;
chomp $tim;
#extract the time field from the date 
# Skip 4 read 6 skip 14 read rest chars
$tim =~ s/^.{4}(.{6}).{14}(.*)$/$1 $2/;

$tim =~ s/:/_/g;
$tim =~ s/ /_/g;

#use release name override for code release
if( $oper == 2 && -e $versionf && -e "makefile") {
  if(!$relnamegiven ) { $relname = "$tim"; };
    
# write a new version file 
  if ( -e $versiont ) {
    unlink( $versiont );
    };
# Need to have a copy of version.h in this directory and a makefile
# with the correct rules in it : make_tail for example 
  if (open (IN,"<$versionf") && open (OUT,">$versiont") ) {
    while ( <IN> )  {
     if ( /^#define RELDATE/ ) { 
       printf (OUT "\#define RELDATE \"Release $relname\"\n");
       } 
     else {
       printf(OUT "$_" ) ;
       };
     };
   close (IN);
   close (OUT);
   rename $versiont,$versionf;
   print("/usr/bin/make rel_tail RELDATE=\"$relname\"\n");
   system("/usr/bin/make rel_tail RELDATE=\"$relname\"");
  } 
# create a new version to attach to any of the files that will be built

#this is the release directory where all files and links are to be
# installed.
  $release_dir = "$releases/$relname";

# Remove any files that are in the directory

  # Make the directory anyway
  mkdir $release_dir,0777;
  if (! -f "$release_dir/release.ini") {
    symlink "$releases/packages.ini","$release_dir/release.ini";
    };
  $packagefile = "$releases/packages.ini";
  }
#when creating a release use the parent   
  
  
else {
#not Releasing just querying or installing
  $release_dir = "$releases/$relname";
  $packagefile = "$release_dir/release.ini";
  }



#if we are querying release files we need to check all of the 
#directories in which we may find a release 
if ($oper==0) {
# startup a pager for any output
  open (PAGER, "|$pager");
  opendir (RELDIR,"$releases"); 
  $dir = readdir(RELDIR);
  while ($dir) {
    if( -e "$releases/$dir/release.ini" ) { 
      printf(PAGER "Release $dir is available\n\n");   
   
#printout of revision number
      if ( -e "$releases/$dir/readme.txt" ) {
        open (IN,"$releases/$dir/readme.txt");
        while (<IN>) { print PAGER "  ",$_; };
        };
      };
    $dir = readdir(RELDIR);
    }
  close (PAGER);
  }
    
else {

#sanity check on install
  if($oper == 1 || $oper==4 || $oper==6) {
    if (!$relnamegiven) {
      print "No release name given\n";
      exit (1);
      };
    if (!-e $packagefile ) {
      print "Cant use release $relname\n";
      exit(1);
      };
    };
    

#setup the mode under which the files will be linked/copied
$filemode = 0744;

# set how the file links will be made
$lnflags = "-s"; 

# we have now built the tools in this directory.
# read in the base description of the package
$fileflag = 0;
$oldflag = 0;
$forceflag = 0;


$resp=" ";
  
if (open (IN,"<$packagefile")) {

  LINE: while ( <IN> )  {
    chomp;
    if ( /#/ || length() < 2)    {  next LINE; }   ;
    if ( /\[sourcedir\]/ ){$oldflag = $fileflag;$fileflag = 1;  next LINE; } ;
    if ( /\[destdir\]/ )  {$oldflag   = $fileflag;$fileflag = 5;  next LINE; } ;
    if ( /\[messages\]/ ) {$fileflag  = 6;  next LINE; } ;
    if ( /\[files\]/ )    {$forceflag = 0; $fileflag = 2;  next LINE; } ;
    if ( /\[links\]/ )    {$forceflag = 0; $fileflag = 3;  next LINE; } ;
    if ( /\[mode\]/ )     {$oldflag   = $fileflag;$fileflag = 4;  next LINE; } ;
    if ( /\[overwrite\]/ ) {$forceflag=1;  next LINE; } ;
    if ( /\[query\]/ )     {$forceflag=0;  next LINE; } ;
#pickup the file copy source path
    if ($fileflag==1)   { 
      s/\~/$home/g; #expand special char
      $compile_dir  = $_ ; 
      $fileflag=$oldflag;  
      next LINE; } ;
#these are actual release building flags
    if ($fileflag==2 || $fileflag==3 )   {
      @file = split ' '; 
      $destname   = $file[0];
      $sourcename = $file[1];
# no source name given (only one name on the line)
# then source & dest are same name
      if ($#file<1) {  # last index is 0 =>less than 2 elements , is one ... 
        $sourcename = $destname;
        }; 
      

      if ($oper == 1 || $oper ==4 || $oper ==6) { #perfoming an installation from releases
        $newname = "$install_dir/$destname";
        $oldname = "$release_dir/$sourcename";
        $ok = 1;
        $exists = -e $newname;
        if ( $oper==1 && !$forceflag && $exists   ) { # check for overwrite permision
          if ($resp =~ /[aA]/ ) { $resp=" "; }; #if already said 'all' ignore
          while ( $resp =~ /[^YyNnAa]/ ) {
            print ("\n\aFound file $newname : overwrite ? \n(y/n/a) a=dont ask again:");
            $resp = getc;
           if ( $resp =~ /\n/ ) { $resp = getc; };
            };
          if ( $resp =~ /[nN]/ ) {$ok=0;};
          };
        
        if($ok && -e "$oldname") { #an installation linkage 
          if ( $oper== 1 ) {
            unlink  "$newname"; 
            symlink "$oldname","$newname";  
            printf("install %-15s to %s mode %o\n",$sourcename,$newname,$filemode);
            }
          elsif ($oper==6) { #an uninstall operation
            if($exists && $forceflag) { 
              unlink  "$newname"; 
              printf("uninstall %-15s\n",$newname);
              };
            }
          else {
            printf("install %-15s to %s mode %o\n",$sourcename,$newname,$filemode);
            }
          };
        };  
          
      if ($oper ==2) { #a release copy procedure is being performed
        $newname = "$release_dir/$destname";
        $oldname = "$compile_dir/$sourcename";

        if ( -d $release_dir) { unlink "$newname"; };
        if ($fileflag == 2) { #file copy on release
          system ("/usr/bin/cp $oldname $newname\n");
          }
        else { #file link
          system ("/usr/bin/ln $lnflags $oldname $newname\n");
          };
        chmod $filemode,"$newname";
        };
      next LINE;
      }
#pickup file access mode
    if ($fileflag==4)   {$filemode  = oct($_) ; $fileflag=$oldflag;  next LINE; } ;
#pickup the file installation destination path
    if ($fileflag==5)   { 
      s/\~/$home/g; #expand special char
      $install_dir  = $_ ; 
      $fileflag=$oldflag;  
      next LINE; } ;
#pickup user message
    if ($fileflag==6)   {print("$_\n") ;  next LINE; } ;

        
      } ;
    
  };
 };