Subversion Repositories Vertical

#!/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; } ;

      } ;

  };

 };