Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

executable file 263 lines (255 sloc) 7.174 kb
#!/usr/bin/perl
# Copyright (c) 2000 SuSE GmbH Nuernberg, Germany. All rights reserved.
#
# Author: Marcus Schaefer <ms@suse.de>, 2005
# Build script for kiwi RPM package(s)
#
# Syntax:
# -------
# doit -p | --prepare --local
#
# ---
#
use strict;
use Time::localtime;
use Time::Local;
use Getopt::Long;
use File::lchown qw( lutimes );
use POSIX qw( ENOENT );
use Env;
#=====================================
# Globals...
#-------------------------------------
my $Prepare;
my $LocalSource;
#----[ main ]-----------------#
sub main {
#-----------------------------------------------
# main routine to prepare for all the
# package and version stuff
#
my $result = GetOptions(
"prepare|p" => \$Prepare,
"local|L" => \$LocalSource,
"help|h" => \&usage,
"<>" => \&usage
);
if ( $result != 1 ) {
usage();
}
#==============================================
# Check user privileges...
#----------------------------------------------
if (! defined $Prepare) {
usage();
}
#==============================================
# Checkout source
#----------------------------------------------
my $pacdir = checkout ( $LocalSource );
#==============================================
# Add %changelog
#----------------------------------------------
if (open (FD,">>$pacdir/kiwi.spec")) {
print FD "\n";
print FD '%changelog -n kiwi';
print FD "\n";
convert_changes_to_rpm_changelog ("$pacdir/kiwi.changes",*FD);
close FD;
}
#==============================================
# convert spec to utf8
#----------------------------------------------
qx (iconv -f ISO-8859-1 -t utf8 $pacdir/kiwi.spec > $pacdir/kiwi.spec.new);
qx (mv $pacdir/kiwi.spec.new $pacdir/kiwi.spec);
qx (iconv -f ISO-8859-1 -t utf8 $pacdir/kiwi.changes > $pacdir/kiwi.c.new);
qx (mv $pacdir/kiwi.c.new $pacdir/kiwi.changes);
#==============================================
# Cleanup
#----------------------------------------------
my $host = qx (hostname);
chomp ($host);
print 'Retrieve archive with: ';
print '[ scp -r root@'.$host.':'.$pacdir." . ]\n";
}
#---[ checkout ]-----#
sub checkout {
#-------------------------------------------------
# checkout sources and create a package directory
# ready to go to /work/src/done
#
my $pacdir = repoup (@_);
chdir $pacdir;
qx( cp -a -p kiwi/rpm/* . );
chdir "./kiwi";
qx (./.archive);
chdir $pacdir;
qx( mv kiwi/*.bz2 . );
qx( rm -rf kiwi );
return $pacdir;
}
#----[ repoup ]----------------#
sub repoup {
#-----------------------------------------------
# checkout kiwi source according to an optional
# tag and return the pathname of the temp directory
# where the new sources are located
#
#===========================================
# create tmp directory and change into it
#-------------------------------------------
my $parent = qx ( pwd );
my $tmpdir = qx (
mktemp -q -d /tmp/gitkiwi.XXXXXX
);
chomp $parent;
chomp $tmpdir;
chdir $tmpdir
|| die "Could not create temp dir: $!";
#===========================================
# pack up local source
#-------------------------------------------
print "Checkout source level [local]...\n";
qx( cp -a -p $parent/ $tmpdir/kiwi );
qx ($parent/.lutime $parent $tmpdir);
chdir $tmpdir
|| die "Could not create temp dir: $!";
return $tmpdir;
}
#----[ usage ]------------#
sub usage {
#----------------------------------------
# give me a usage message
#
print "usage: doit -p --local\n";
print "--\n";
exit (0);
}
#----[ convert_changes_to_rpm_changelog ]------------#
sub convert_changes_to_rpm_changelog {
#----------------------------------------
# convert changes to rpm changelog
#
my $file = shift;
local *FD = shift;
my @entries = ();
my %entries = ();
my @datarray= ();
my @hourarray=();
my $outstr;
my $rpm_birth = 852159600;
my $rpm_birth_str = "Thu Jan 02 1997";
my $actual = 999999999999;
my %month_to_num = (Jan=>0,Feb=>1,Mar=>2,Apr=>3,May=>4,Jun=>5,Jul=>6,Aug=>7,Sep=>8,Oct=>9,Nov=>10,Dec=>11);
# handle first line in entry specially
my $firstline = 0;
open (LG,$file);
while (<LG>) {
chomp ($_);
next if (/^--------------/);
next if (/^========================/);
if (
/^[A-Za-z]*\s*[A-Za-z]*\s*[0-9]*\s*[0-9][0-9]:[0-9][0-9].*-.*\@.*/
|| /^[A-Za-z]*\s*[A-Za-z]*\s*[0-9]*\s*[0-9][0-9][0-9][0-9]\s*-.*\@.*/
) {
#warn ("found changes style dateline $_\n");
if (
/^Mon / || /^Tue / || /^Wed / || /^Thu / || /^Fri /
|| /^Sat / || /^Sun /
) {
my @xline = split ( '-', $_);
my $datestr = shift ( @xline );
my $address = join ('-', @xline);
#my ($datestr,$address) = split ( '-', $_);
$datestr =~ s/CEST/MEST/;
@datarray = split ( ' ',$datestr);
if ($datarray[3] =~ /:/) {
@hourarray = split ( ':',$datarray[3]);
} else {
@hourarray = ("00","00","00");
}
$actual = timelocal ($hourarray[2],$hourarray[1],$hourarray[0],
$datarray[2],$month_to_num{$datarray[1]},
$datarray[$#datarray]-1900);
$address =~ s/^\s*(.*)/\1/;
$address =~ s/\s+/ /g;
my $datestr;
if ( ! $actual ) {
print "INVALID DATESTR=\"$datestr\" !!!";
print "$actual Skipping rest...";
exit 1;
}
if ( $actual < $rpm_birth ) {
$datestr = $rpm_birth_str;
} else {
my $ltime = localtime $actual;
$datestr = sprintf("%s %s %02d %4d",
(qw(Sun Mon Tue Wed Thu Fri Sat Sun))[$ltime->wday],
(qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$ltime->mon],
$ltime->mday,1900+$ltime->year);
}
chomp ($datestr);
$outstr = "$datestr - $address";
if ( $entries{$actual} =~ /$outstr/ ) {
# nope
} else {
$entries{$actual} .= "* $outstr\n";
}
$firstline = 1;
next;
} else {
warn ("$_ is not in english locale\n");
$actual = timelocal ( 0,0,0,1,0,100); # Jan 1st 2000
$entries{$actual} .= "* Tue Jan 01 2000 - nobody\@suse.de\n" unless ( $entries{$actual} =~ /$outstr/ );
}
}
if (
/^\* Mon / || /^\* Tue / || /^\* Wed / || /^\* Thu / ||
/^\* Fri / || /^\* Sat / || /^\* Sun /
) {
my ($datestr,$address) = split ( '-', $_);
@datarray = split ( ' ',$datestr);
$actual = timelocal(0,0,0,$datarray[3],$month_to_num{$datarray[2]},
$datarray[$#datarray]-1900);
$address =~ s/^\s*(.*)/\1/;
$address =~ s/\s+/ /g;
if ( ! $actual ) {
print "INVALID DATESTR=\"$datestr\" !!!";
print "$actual Skipping rest...";
exit 1;
}
$entries{$actual} .= "$_\n";
$firstline = 1;
next;
}
$_ =~ s/([^%])%([^%])/\1%%\2/g;
if (/^-/ || /^\s*-/) {
$_ =~ s/^\s*(\S*)/\1/ if($firstline);
$_ =~ s/(\S*)\s*$/\1/;
$entries{$actual} .= "$_\n";
$firstline = 0;
next;
}
if (/^\s*\#/) {
# hash is comment, try to escape
s/^(\s*)(\#\d*)/$1\[$2\]/;
}
if (/\S/) {
$_ =~ s/^\s*(\S*)/\1/;
$_ =~ s/(\S*)\s*$/\1/;
$entries{$actual} .= " $_\n";
$firstline = 0;
}
}
my $first = "1";
foreach my $key (sort {0+$b <=> 0+$a} (keys %entries)) {
if ( $first eq "1" && $entries{$key} !~ /^\*/ ) {
my $dst = `date`;
chomp ($dst);
print "* $dst - broken\@suse.de\n";
}
$first = "0";
print FD "$entries{$key}";
}
}
main();
Jump to Line
Something went wrong with that request. Please try again.