2 # WannaBuild.pm: library for wanna-build and sbuild
3 # Copyright (C) 2005 Ryan Murray <rmurray@debian.org>
5 # This program is free software; you can redistribute it and/or
6 # modify it under the terms of the GNU General Public License as
7 # published by the Free Software Foundation; either version 2 of the
8 # License, or (at your option) any later version.
10 # This program is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 # General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
30 @WannaBuild::ISA = qw(Exporter);
31 @WannaBuild::EXPORT = qw(version_less version_lesseq version_eq
32 version_compare binNMU_version parse_date isin);
34 $WannaBuild::opt_correct_version_cmp = 0;
40 return version_compare( $v1, "<<", $v2 );
47 return version_compare( $v1, "<=", $v2 );
54 return version_compare( $v1, "=", $v2 );
62 if ($WannaBuild::opt_correct_version_cmp) {
63 system "dpkg", "--compare-versions", $v1, $rel, $v2;
67 if ($rel eq "=" || $rel eq "==") {
70 elsif ($rel eq "<<") {
71 return do_version_cmp( $v1, $v2 );
73 elsif ($rel eq "<=" || $rel eq "<") {
74 return $v1 eq $v2 || do_version_cmp( $v1, $v2 );
76 elsif ($rel eq ">=" || $rel eq ">") {
77 return !do_version_cmp( $v1, $v2 );
79 elsif ($rel eq ">>") {
80 return $v1 ne $v2 && !do_version_cmp( $v1, $v2 );
83 warn "version_compare called with bad relation '$rel'\n";
90 my($versa, $versb) = @_;
91 my($epocha,$upstra,$reva);
92 my($epochb,$upstrb,$revb);
95 ($epocha,$upstra,$reva) = split_version($versa);
96 ($epochb,$upstrb,$revb) = split_version($versb);
99 return 1 if $epocha < $epochb;
100 return 0 if $epocha > $epochb;
102 # compare upstream versions
103 $r = version_cmp_single( $upstra, $upstrb );
104 return $r < 0 if $r != 0;
106 # compare Debian revisions
107 $r = version_cmp_single( $reva, $revb );
116 /[a-z]/i and return ord;
121 sub version_cmp_single {
122 my($versa, $versb) = @_;
123 my($a,$b,$lena,$lenb,$va,$vb,$i);
126 # compare non-numeric parts
127 $versa =~ /^([^\d]*)(.*)/; $a = $1; $versa = $2;
128 $versb =~ /^([^\d]*)(.*)/; $b = $1; $versb = $2;
131 for( $i = 0; $i < $lena || $i < $lenb; ++$i ) {
132 $va = $i < $lena ? order(substr( $a, $i, 1 )) : 0;
133 $vb = $i < $lenb ? order(substr( $b, $i, 1 )) : 0;
134 return $va - $vb if $va != $vb;
136 # compare numeric parts
137 $versa =~ /^(\d*)(.*)/; $a = $1; $a ||= 0; $versa = $2;
138 $versb =~ /^(\d*)(.*)/; $b = $1; $b ||= 0; $versb = $2;
139 return $a - $b if $a != $b;
140 return 0 if !$versa && !$versb;
142 return +1 if order(substr( $versb, 0, 1 ) ) < 0;
146 return -1 if order(substr( $versa, 0, 1 ) ) < 0;
154 my($epoch,$revision) = (0,"");
156 if ($vers =~ /^(\d+):(.*)/) {
161 if ($vers =~ /(.*)-([^-]+)$/) {
166 return( $epoch, $vers, $revision );
171 my $binNMUver = shift;
173 return "$v+b$binNMUver";
177 my %monname = ('jan', 0, 'feb', 1, 'mar', 2, 'apr', 3, 'may', 4, 'jun', 5,
178 'jul', 6, 'aug', 7, 'sep', 8, 'oct', 9, 'nov', 10, 'dec', 11 );
185 if ($text =~ /^(\d{4}) (\w{3}) (\d+) (\d{2}):(\d{2}):(\d{2})$/) {
186 my ($year, $mon, $day, $hour, $min, $sec) = ($1, $2, $3, $4, $5, $6);
188 die "Invalid month name $mon" if !exists $monname{$mon};
189 $mon = $monname{$mon};
190 return timegm($sec, $min, $hour, $day, $mon, $year);
191 } elsif ($text =~ /^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})(?:\.\d+)?$/) {
192 my ($year, $mon, $day, $hour, $min, $sec) = ($1, $2-1, $3, $4, $5, $6);
193 return timegm($sec, $min, $hour, $day, $mon, $year);
195 die "Cannot parse date: $text\n";
204 return grep( $_ eq $val, @_ );
207 #sub get_distributions {
210 # my $q = 'SELECT distribution, public, auto_dep_wait FROM distributions';
211 # my $rows = $dbh->selectall_hashref($q, 'distribution');
212 # foreach my $name (keys %$rows) {
213 # $distributions{$name} = {};
214 # $distributions{$name}->{'noadw'} = 1 if ($rows->{$name}->{'auto_dep_wait'});
215 # $distributions{$name}->{'hidden'} = 1 if ($rows->{$name}->{'public'});
218 # return %distributions;