|
Lines 1-4
Link Here
|
| 1 |
#!/usr/bin/perl |
1 |
#!/usr/bin/perl |
| 2 |
|
2 |
|
| 3 |
# Copyright 2010 Catalyst IT Ltd. |
3 |
# Copyright 2010 Catalyst IT Ltd. |
| 4 |
# |
4 |
# |
|
Lines 23-98
Link Here
|
| 23 |
|
23 |
|
| 24 |
use Modern::Perl; |
24 |
use Modern::Perl; |
| 25 |
|
25 |
|
|
|
26 |
use Carp; |
| 27 |
use English qw( -no_match_vars ); |
| 28 |
use File::Basename qw/dirname/; |
| 29 |
use File::Spec qw/rel2abs/; |
| 26 |
use Getopt::Long; |
30 |
use Getopt::Long; |
| 27 |
use POSIX qw/strftime/; |
31 |
use POSIX qw/strftime/; |
| 28 |
|
32 |
|
|
|
33 |
our $VERSION = '1.1'; # Just to perlcritic -2 :) |
| 29 |
my $basetgz; |
34 |
my $basetgz; |
| 30 |
my $buildresult; |
35 |
my $buildresult; |
| 31 |
my $distribution='squeeze-dev'; |
36 |
my $distribution = 'jessie'; |
| 32 |
my $git_checks='all'; |
37 |
my $git_checks = 'all'; |
| 33 |
my $version='16.06~git'; |
38 |
my $version; |
| 34 |
my $auto_version=1; |
39 |
my $auto_version = 1; |
| 35 |
my $need_help; |
40 |
my $need_help; |
| 36 |
my $debug; |
41 |
my $debug; |
| 37 |
|
42 |
|
| 38 |
GetOptions( |
43 |
GetOptions( |
| 39 |
'basetgz|b=s' => \$basetgz, |
44 |
'basetgz|b=s' => \$basetgz, |
| 40 |
'buildresult|r=s' => \$buildresult, |
45 |
'buildresult|r=s' => \$buildresult, |
| 41 |
'distribution|D=s' => \$distribution, |
46 |
'distribution|D=s' => \$distribution, |
| 42 |
'git-checks|g=s' => \$git_checks, |
47 |
'git-checks|g=s' => \$git_checks, |
| 43 |
'version|v=s' => \$version, |
48 |
'version|v=s' => \$version, |
| 44 |
'autoversion!' => \$auto_version, |
49 |
'autoversion!' => \$auto_version, |
| 45 |
'help|h' => \$need_help, |
50 |
'help|h' => \$need_help, |
| 46 |
'debug|d' => \$debug, |
51 |
'debug|d' => \$debug, |
| 47 |
); |
52 |
); |
| 48 |
|
53 |
|
| 49 |
help_and_exit() if $need_help; |
54 |
if ($need_help) { |
|
|
55 |
help_and_exit(); |
| 56 |
} |
| 50 |
|
57 |
|
|
|
58 |
if ( $git_checks ne 'all' |
| 59 |
&& $git_checks ne 'modified' |
| 60 |
&& $git_checks ne 'none' ) |
| 61 |
{ |
| 62 |
help_and_exit( |
| 63 |
"$PROGRAM_NAME: --git-checks/-g must be one of 'all', 'modified', or 'none'" |
| 64 |
); |
| 65 |
} |
| 51 |
|
66 |
|
| 52 |
sub sys_command_output { |
67 |
sub sys_command_output { |
| 53 |
my ($command) = @_; |
68 |
my ($command) = @_; |
| 54 |
|
69 |
|
| 55 |
print "$command\n" if $debug; |
70 |
if ($debug) { |
| 56 |
my $command_output; |
71 |
print "$command\n"; |
| 57 |
open($command_output, "-|", "$command ") |
72 |
} |
| 58 |
or die qq{Cannot execute "$command": $!"}; |
73 |
open my $command_output, q{-|}, |
| 59 |
return map { chomp; $_ } <$command_output>; |
74 |
"$command " || croak qq{Cannot execute "$command": $OS_ERROR}; |
|
|
75 |
my @output = <$command_output>; |
| 76 |
chomp @output; |
| 77 |
close $command_output || croak 'Difficulty closing command handle'; |
| 78 |
if ($debug) { |
| 79 |
print "output: @output\n"; |
| 80 |
} |
| 81 |
return @output; |
| 60 |
} |
82 |
} |
| 61 |
|
83 |
|
| 62 |
sub sys_command_output_screen { |
84 |
sub sys_command_output_screen { |
| 63 |
my ($command) = @_; |
85 |
my ($command) = @_; |
| 64 |
|
86 |
|
| 65 |
print "$command\n" if $debug; |
87 |
if ($debug) { |
| 66 |
system($command) == 0 or die "Command '$command' returns an error ($?)\n"; |
88 |
print "$command\n"; |
|
|
89 |
} |
| 90 |
return system($command) == 0 |
| 91 |
|| croak "Command '$command' returns an error ($CHILD_ERROR)\n"; |
| 67 |
} |
92 |
} |
| 68 |
|
93 |
|
| 69 |
sub everything_is_committed { |
94 |
sub everything_is_committed { |
|
|
95 |
my ($check_type) = @_; |
| 96 |
my %filters; |
| 70 |
my $filter; |
97 |
my $filter; |
| 71 |
for ($git_checks) { |
98 |
$filters{'uncommitted'} = 'no'; |
| 72 |
$_ eq "none" |
99 |
$filters{'untracked'} = 'normal'; |
| 73 |
and return 1; |
100 |
$filter = $filters{$check_type}; |
| 74 |
|
|
|
| 75 |
$_ eq "modified" |
| 76 |
and $filter = "no", |
| 77 |
last; |
| 78 |
|
101 |
|
| 79 |
$_ eq "all" |
102 |
# No header, so wc -l generates a count of the changes. |
| 80 |
and $filter = "normal", |
103 |
my ($has_changes) = |
| 81 |
last; |
104 |
sys_command_output("git status --porcelain -u${filter} | wc -l"); |
| 82 |
|
105 |
|
| 83 |
help_and_exit("$0: --git-checks/-g must be one of 'all', 'modified', or 'none'"); |
106 |
if ($debug) { |
|
|
107 |
print "has changes: $has_changes\n"; |
| 84 |
} |
108 |
} |
| 85 |
my $has_changes = grep /^xxx/, sys_command_output("git status --porcelain -u${filter}"); |
|
|
| 86 |
|
| 87 |
return !$has_changes; |
109 |
return !$has_changes; |
| 88 |
} |
110 |
} |
| 89 |
|
111 |
|
| 90 |
sub help_and_exit { |
112 |
sub help_and_exit { |
| 91 |
my $msg = shift; |
113 |
my $msg = shift; |
| 92 |
if ($msg) { |
114 |
if ($msg) { |
| 93 |
print "$msg\n\n"; |
115 |
print "$msg\n\n"; |
| 94 |
} |
116 |
} |
| 95 |
print <<EOH; |
117 |
print <<'EOH'; |
| 96 |
This builds Koha deb packages, from a git snapshot. It's not suitable for |
118 |
This builds Koha deb packages, from a git snapshot. It's not suitable for |
| 97 |
making upstreamable verions, but handy for your own local packages. |
119 |
making upstreamable verions, but handy for your own local packages. |
| 98 |
|
120 |
|
|
Lines 119-156
EOH
Link Here
|
| 119 |
} |
141 |
} |
| 120 |
|
142 |
|
| 121 |
sub latest_sha1 { |
143 |
sub latest_sha1 { |
| 122 |
return sys_command_output("git rev-parse --short=8 HEAD"); |
144 |
return sys_command_output('git rev-parse --short=8 HEAD'); |
| 123 |
} |
145 |
} |
| 124 |
|
146 |
|
| 125 |
sub adjust_debian_changelog { |
147 |
sub adjust_debian_changelog { |
| 126 |
my ($newversion) = @_; |
148 |
my ($newversion) = @_; |
|
|
149 |
|
| 127 |
# debian revision |
150 |
# debian revision |
| 128 |
$newversion .= "-1"; |
151 |
$newversion .= '-1'; |
| 129 |
|
152 |
|
| 130 |
sys_command_output( qq{dch --force-distribution -D "$distribution" -v "$newversion" "Building git snapshot."} ); |
153 |
sys_command_output( |
| 131 |
sys_command_output( qq{dch -r "Building git snapshot."} ); |
154 |
qq{dch --force-distribution -D "$distribution" -v "$newversion" "Building git snapshot."} |
|
|
155 |
); |
| 156 |
sys_command_output(qq{dch -r "Building git snapshot."}); |
| 157 |
return; |
| 132 |
} |
158 |
} |
| 133 |
|
159 |
|
| 134 |
sub reset_debian_changelog { |
160 |
sub reset_debian_changelog { |
| 135 |
sys_command_output( qq{git checkout -- debian/changelog} ); |
161 |
sys_command_output('git checkout -- debian/changelog'); |
|
|
162 |
return; |
| 136 |
} |
163 |
} |
| 137 |
|
164 |
|
| 138 |
sub build_package { |
165 |
sub build_package { |
| 139 |
my ($newversion) = @_; |
166 |
my ($newversion) = @_; |
| 140 |
sys_command_output( qq{git archive --format=tar --prefix="koha-$newversion/" HEAD | gzip -9 > "../koha_$newversion.orig.tar.gz"} ); |
167 |
sys_command_output( |
| 141 |
|
168 |
qq{git archive --format=tar --prefix="koha-$newversion/" HEAD | gzip -9 > "../koha_$newversion.orig.tar.gz"} |
| 142 |
my $pdebuildopts = $buildresult ? "--buildresult $buildresult" : ""; |
169 |
); |
| 143 |
my $pdebuildbasetgz = $basetgz ? "-- --basetgz /var/cache/pbuilder/" . $basetgz . ".tgz" : ""; |
170 |
|
| 144 |
sys_command_output_screen( "pdebuild $pdebuildbasetgz $pdebuildopts" ); |
171 |
my $pdebuildopts = $buildresult ? "--buildresult $buildresult" : q{}; |
|
|
172 |
my $pdebuildbasetgz = |
| 173 |
$basetgz ? '-- --basetgz /var/cache/pbuilder/' . $basetgz . '.tgz' : q{}; |
| 174 |
sys_command_output_screen("pdebuild $pdebuildbasetgz $pdebuildopts"); |
| 175 |
return; |
| 145 |
} |
176 |
} |
| 146 |
|
177 |
|
| 147 |
everything_is_committed() or die "cannot build: uncommited changes"; |
178 |
# This logic doesn't require PERL5LIB set correctly. |
|
|
179 |
my $path_name = File::Spec->rel2abs($PROGRAM_NAME); |
| 148 |
|
180 |
|
| 149 |
my $newversion = $auto_version |
181 |
# Koha.pm is always up a directory from this script. |
| 150 |
? sprintf ('%s%s.%s', $version, strftime("+%Y%m%d%H%M%S", localtime), latest_sha1()) |
182 |
my $koha_file = dirname( dirname($path_name) ) . '/Koha.pm'; |
|
|
183 |
($version) = sys_command_output( |
| 184 |
qq{grep VERSION $koha_file | grep = | cut -f2 -d\\\" | cut -f1-2 -d.}); |
| 185 |
$version .= '~git'; # YY.MM~git |
| 186 |
|
| 187 |
if ( $git_checks ne 'none' ) { |
| 188 |
everything_is_committed('uncommitted') |
| 189 |
|| croak 'cannot build: uncommited changes'; |
| 190 |
} |
| 191 |
if ( $git_checks eq 'all' ) { |
| 192 |
everything_is_committed('untracked') |
| 193 |
|| croak 'cannot build: untracked changes'; |
| 194 |
} |
| 195 |
|
| 196 |
my $newversion = |
| 197 |
$auto_version |
| 198 |
? sprintf( '%s%s.%s', |
| 199 |
$version, strftime( '+%Y%m%d%H%M%S', localtime ), |
| 200 |
latest_sha1() ) |
| 151 |
: $version; |
201 |
: $version; |
| 152 |
|
202 |
|
| 153 |
adjust_debian_changelog( $newversion ); |
203 |
adjust_debian_changelog($newversion); |
| 154 |
build_package( $newversion ); |
204 |
build_package($newversion); |
| 155 |
reset_debian_changelog(); |
205 |
reset_debian_changelog(); |
| 156 |
|
|
|
| 157 |
- |