melo / scripts

My personal script stash

This URL has Read+Write access

scripts / bin / prj
100755 154 lines (111 sloc) 2.502 kb
raw blame history 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154

#!/usr/bin/env perl
 
use strict;
use warnings;
use Cwd;
use File::Spec::Functions qw( splitdir catdir catfile );
use JSON;
use Getopt::Long;
 
 
my %cfg;
my $ok = GetOptions(
  \%cfg,
  "help",
  "verbose+",
  "quiet",
  "dryrun|n"
);
usage() unless $ok;
usage() if $cfg{help};
 
$cfg{root} ||= find_project_root();
$cfg{verbose} ||= 0;
$cfg{quiet} ||= 0;
 
dispatch_command(\%cfg, @ARGV);
 
 
sub dispatch_command {
  my ($cfg, $cmd, @args) = @_;
  
  if (!defined($cmd)) {
    usage();
    return;
  }
  
  load_cfg($cfg);
 
  if ($cmd eq 'deploy') {
    deploy($cfg, @args);
  }
  else {
    usage("Command '$cmd' not understood");
  }
  
  return
}
 
 
##########
# Commands
 
sub deploy {
  my ($cfg, $env) = @_;
  my $pcfg = $cfg->{project};
  
  usage('Deploy requires an environment as parameter')
      unless defined $env;
 
  usage("Environment '$env' not found in rules.prj")
      unless exists $pcfg->{environments}{$env};
  debug("Using environment '$env'");
      
  my $ecfg = $pcfg->{environments}{$env};
  
  my $rsync = $pcfg->{commands}{rsync} || 'rsync -a';
  debug("Rsync command to use: $rsync");
  
  $rsync .= ' -v' if $cfg->{verbose} || $pcfg->{verbose};
  $rsync .= ' -n' if $cfg->{dryrun};
  $rsync .= " $cfg->{root}/";
  $rsync .= " $ecfg->{user}\@$ecfg->{host}:$ecfg->{path}";
  debug("Final rsync command: $rsync");
  
  system($rsync);
  
  return;
}
 
#######
# Usage
 
sub usage {
  my ($msg) = @_;
  
  print STDERR <<EOU;
Usage: prj COMMAND ARGS
 
The current list of COMMANDs is:
 
    deploy    deploys current version to an environment
 
EOU
 
  print STDERR "ERROR: $msg\n" if $msg;
  exit(1);
}
 
 
########
# Logger
 
sub debug {
  return if $cfg{quiet};
  return unless $cfg{verbose} > 1;
  
  my $msg = join(' ', @_);
  print STDERR "[DEBUG]: $msg\n";
  return;
}
 
 
#######
# Utils
 
sub load_cfg {
  my ($cfg) = @_;
  my $root = $cfg->{root};
  my $prj_cfg;
  
  if (open(my $fh, '<', catfile($root, 'rules.prj'))) {
    local $/;
    $prj_cfg = decode_json(<$fh>);
    close($fh);
  }
  else {
    die "Could not open 'rules.prj' file in $root: $!\n";
  }
  
  $cfg->{project} = $prj_cfg;
}
 
sub find_project_root {
	my $project_root;
 
	my @cwd = splitdir(getcwd());
	do {
		my $cwd = catdir(@cwd);
 
		if (-e catfile($cwd, 'rules.prj')) {
			$project_root = $cwd;
		}
		elsif ($cwd eq $ENV{HOME} || scalar(@cwd) == 1) {
			die "Could not find project root (was looking for rules.prj)\n";
		}
		else {
			pop @cwd;
		}
	} while (!$project_root);
 
	return $project_root;
}