4 Aug
2008
4 Aug
'08
6:30 p.m.
Steve King wrote:
I wrote a Perl script ...
D'oh! That script shouldn't have had my employer's boilerplate copyright at the top. Here it is again, with the proper copyright notice. Please use this version.
--
Steve King
Sr. Software Engineer
Arbor Networks
+1 734 821 1461
www.arbornetworks.com http://www.arbornetworks.com/
#! /usr/bin/perl -w
################################################################################
##
## tmsvn.pl
##
## Copyright (c) 2008 Arbor Networks, Inc.
## All rights reserved. Proprietary and confidential.
##
## $Id: tmsvn.pl 40 2008-02-07 18:25:45Z sking $
##
################################################################################
use strict;
use File::Spec::Functions qw( :ALL );
use IO::File;
my $VERBOSE = 0;
my $DRYRUN = 0;
################################################################################
##
## main
##
################################################################################
{
my $root = shift(@ARGV) || '.';
my @paths = shell('svn','ls','-R',$root);
my $tree = {};
foreach my $path (@paths) {
next if ($path =~ m-/$-);
my ($vol,$dirs,$file) = splitpath($path);
my @dirs = splitdir(canonpath($dirs));
my $ref = $tree;
foreach my $d (@dirs) {
$ref->{$d} = {} unless($ref->{$d});
$ref = $ref->{$d};
}
$ref->{$file} = $path;
}
my $xml = parseTree($tree);
my ($vol, $dir, undef) = splitpath(canonpath(rel2abs($root)),1);
my @dirs = splitdir($dir);
my $projfile = pop(@dirs) . '.tmproj';
my $projpath = catpath($vol,$dir,$projfile);
my $fh = IO::File->new($projpath, 'w') || die;
print $fh <<EOF;
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
<plist version="1.0">
<dict>
<key>windowFrame</key>
<string>{{204, 4}, {647, 874}}</string>
<key>documents</key>
<array>
$xml
</array>
</dict>
</plist>
EOF
close($fh);
exec('open', $projpath);
}
################################################################################
##
## parseTree
##
################################################################################
sub parseTree
{
my $tree = shift;
my $str = '';
my (@dirs, @files);
foreach my $k (keys %{$tree}) {
if (ref($tree->{$k})) {
push(@dirs, $k);
}
else {
push(@files, $k);
}
}
foreach my $k (sort @dirs) {
$str .= <<EOF;
<dict>
<key>name</key>
<string>$k</string>
<key>children</key>
<array>
EOF
$str .= parseTree($tree->{$k});
$str .= <<EOF;
</array>
</dict>
EOF
}
foreach my $k (sort @files) {
next if ($k =~ /.(gz|tgz|zip|pdf|pcap)$/i);
$str .= <<EOF;
<dict>
<key>filename</key>
<string>$tree->{$k}</string>
</dict>
EOF
}
return $str;
}
################################################################################
##
## shell
##
################################################################################
sub shell
{
my @cmd = @_;
my $cmd = join(' ',@cmd);
my (@output);
print "$cmd\n" if ($VERBOSE);
if (! $DRYRUN) {
my $fh = IO::File->new($cmd . '|');
@output = $fh->getlines();
chomp(@output);
$fh->close();
}
return @output;
}