View | Details | Raw Unified | Return to bug 21876
Collapse All | Expand All

(-)a/debian/build-git-snapshot (-54 / +102 lines)
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
- 

Return to bug 21876