svnvers.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:57 2010 from svnvers.pl 2007/11/26 1.4 KB.

#!/perl -w
# NAME: svnvers.pl
# AIM: Check a directory, and output the current SVN version number ...
# 26/11/2007 - geoff mclane - http://geoffair.net/mperl
use strict;
use warnings;
my $pgmname = $0;
if ($pgmname =~ /\w{1}:\\.*/) {
   my @tmpsp = split(/\\/,$pgmname);
   $pgmname = $tmpsp[-1];
}
my $in_dir = '';   # "C:\\FGCVS\\xmlrpc-c\\";
$in_dir = $ARGV[0];
if (defined $in_dir && length($in_dir)) {
   $in_dir .= "\\" if (substr($in_dir, length($in_dir) - 1, 1) ne "\\");
   my $vers = check_svn_vers($in_dir);
   prt( "Done $in_dir, " );
   if ($vers eq 'Unknown') {
      prt( "NO SVN version found ...\n" );
   } else {
      prt( "found SVN Version $vers.\n" );
   }
} else {
   prt( "Must give an input directory ...\n" );
}
exit(0);
sub check_svn_vers {
   my ($idir) = shift;
   my $vers = 'Unknown';
   if (opendir( DIR, $idir)) {
      my @dir_cont = readdir(DIR);
      close DIR;
      foreach my $dir (@dir_cont) {
         if ($dir eq '.svn') {
            my $nd = $idir. $dir . "\\entries";
            if (open INF, "<$nd") {
               my @lines = <INF>;
               close INF;
               my $next = 0;
               foreach my $line (@lines) {
                  chomp $line;
                  if ($next) {
                     $vers = $line;
                     last;
                  } elsif ($line eq 'dir') {
                     $next = 1;
                  }
               }
            }
            last;
         }
      }
   } else {
      prt( "ERROR: Unable to open directory [$idir] ... $! ... \n" );
   }
   return $vers;
}
sub prt {
   my ($msg) = shift;
   print $msg;
}
# eof - svnvers.pl

index -|- top