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