A tool for updating checked out SVN repos on remote servers

svndist.pl

#!/usr/bin/env perl

##################################################################
# svndist.pl 1.0
# 
# Copyright (C) 2008 Phil Christensen
##################################################################

use strict;
use warnings;

use Options;
use File::HomeDir;
use File::Spec;
use Data::Dumper;

my $home = File::HomeDir->my_home;
my $prefs_dir = File::Spec->join($home, '.svndist');

sub load_prefs{
	my $prefs = {};
	
	unless(-e $prefs_dir){
		return $prefs;
	}
	
	opendir(PREFS_DIR, $prefs_dir);
	foreach my $config (readdir(PREFS_DIR)){
		if($config =~ m/\.{1,2}/){
			next;
		}
		my $config_path = File::Spec->join($prefs_dir, $config);
		open(CONFIG, $config_path);
		my @data = <CONFIG>;
		my $data = join('', @data);
		close(CONFIG); 
		
		no strict;
		my $result = eval($data);
		use strict;
		
		if(defined($result)){
			$prefs->{$config} = $result;
		}
	}
	closedir(PREFS_DIR);
	return $prefs;
}

sub save_prefs{
	my $prefs = shift;
	
	unless(-e $prefs_dir){
		mkdir($prefs_dir);
	}
	
	foreach my $config (keys %{$prefs}){
		my $config_path = File::Spec->join($prefs_dir, $config);
		
		my $d = Data::Dumper->new([$prefs->{$config}]);
		$d->Indent(0)->Purity(1)->Useqq(1);
		
		open(CONFIG, ">$config_path");
		print CONFIG $d->Dump();
		close(CONFIG);
	}
}

sub get_options {
	my $prefs = shift;
	my $options = new Options(params => [
										  ['host', 'h', '', 'Host where Subversion directory is located.'],
										  ['directory', 'd', '', 'The name(s) of the Subversion directory to update.'],
										  ['user', 'u', '', 'The SSH user.'],
										  ['postupdate', 'p', '', 'A command to run on the server after update.'],
										  ['config', 'c', '', 'The svndist configuration to use/save.'],
										],
								flags =>[
										  ['help', '?', 'Display this usage guide.'],
										  ['dont-postupdate', 'P', "Don't run the postupdate command."],
										]);
}

sub main {
	my $prefs = load_prefs();
	my $options = get_options($prefs);
	$options->get_options();
	
	my $selected_config = $options->get_result('config');
	my @config_names;
	if($selected_config eq '' && $options->{'unrecognized'}){
		@config_names = @ARGV;
	}
	else{
		@config_names = ($selected_config);
	}
	
	if($options->get_result('help')){
		$options->print_usage();
		exit(-1);
	}
	
	foreach my $config_name (@config_names){
		my $config;
		if(exists($prefs->{$config_name})){
			$config = $prefs->{$config_name};
		}
		else{
			my @hosts = $options->get_result('host');
			my @directories = $options->get_result('directory');
			
			unless($#hosts){
				print STDERR "Missing required option 'host'";
				$options->print_usage();
				exit(-1);
			}
			unless($#directories){
				print STDERR "Missing required option 'directory'";
				$options->print_usage();
				exit(-1);
			}
			
			$config = { 'host' => \@hosts,
						'directory' => \@directories,
						'user' => $options->get_result('user'),
						'postupdate' => $options->get_result('postupdate'),
					};
		}
		
		my $directory_list = join(' ', @{$config->{'directory'}});
		
		foreach my $host (@{$config->{'host'}}){
			my $host_line;
			if($config->{'user'}){
				$host_line = $config->{'user'} . '@' . $host;
			}
			else{
				$host_line = $host;
			}
			
			my $command = "ssh -t $host_line \"svn update $directory_list";
			if($config->{'postupdate'} && !$config->{'dont-postupdate'}){
				$command .= '; ';
				$command .= $config->{'postupdate'};
			}
			$command .= "\"";
			
			if($config_name){
				foreach my $key (keys %{$config}){
					foreach my $item (@{$options->{'flags'}}){
						if($key eq $item->[0]){
							delete $config->{$key};
						}
					}
				}
				
				$prefs->{$config_name} = $config;
				save_prefs($prefs);
			}
			
			#print "$command\n";
			
			my $returnval = system($command);
			if($returnval){
				exit($returnval);
			}
		}
	}
}

main();