#!/usr/bin/perl
# $Id: kupgrade,v 1.3 1998/01/30 20:11:51 deas Exp $
#
# Make patching/upgrading/compiling and installation as automagically
# as possible.
# 
# Author: Andreas Steffan <deas@rrz.uni-hamburg.de>

@CFG_KEYS=qw (MAILTO MAILER PACKAGER ARCH BASE_DIR TAR_DIR RPM_ROOT RPM_OPTS RPM_INST PACKAGES);
%UNCOMPRESS= ( gz=>"gzip -dc",bz2=>"bzip2 -dc" );

use Getopt::Std;
getopts('iso:vuUpP:f:FcRtmh', \%opts);

if ($opts{f}) {
  $CFG_FILE=$opts{f};
} else {
  $CFG_FILE="$ENV{HOME}/.kupgrade";
}
&get_cfg;
if ($opts{h} || (keys %opts)==()) {
  &usage;
  exit 0;
}
if ($opts{v}) {
  $VERBOSE=1;
}
unless ($opts{i}) {
  $INTERACT=1;
}
if ($opts{s}) {
  $SHOW_PACKAGES=1;
}
while (-e "$KUPGRADE{BASE_DIR}/LOCK") { # Wait, if another process is running
  &print_msg("$KUPGRADE{BASE_DIR}/LOCK exists. Waiting ...\n",2);
  sleep 1;
}
chdir "$KDESRCBASE";
open (LOG,">>$LOG") or die "Cannot open $LOG\n"; # Open the logfile
select((select(LOG), $| = 1)[0]);                # Force immediate flushing
&lock; # Make lock
if (! -r "$VERSION" || $opts{F}) {
  &create_current;
  &write_current;
} else {
  &get_current;
}
if ($opts{o}) {
  $RPM_OPTS=$opts{o};
} else {
  $RPM_OPTS=$KUPGRADE{RPM_OPTS};
}
if ($opts{m}) {
  $MAIL=1;
}
if ($opts{u}) {
  &unpack_patches;
}
if ($opts{c}) {
  $COMPILE=1;
}
if ($opts{p}) {
  &patch_sources;
  &write_current;
}
if ($opts{P}) {
  @PACKAGES=split /,/,$opts{P};
} else {
  @PACKAGES=@{ $KUPGRADE{PACKAGES} };
}
if ($opts{R}) {
  $REMOVE_OLD_PACKAGES=1;
}
if ($opts{t}) {
  $TAR=1;
}
if ($opts{U}) {
  &query_installed;
  $UPGRADE=1;
}

# Main loop
foreach $package (@PACKAGES)  { # Process packages
  unless ($VERSION{$package}) {
    &print_msg("No package $package in $VERSION\n",12);
    next;
  }
  &retar if $TAR;
  if ($COMPILE) {
    &make_spec;
    &compile
  }
  &show_rm if ($REMOVE_OLD_PACKAGES || $SHOW_PACKAGES);
  &install if $UPGRADE;
}

&upgrade_exit;

sub query_installed { # Query rpm for installed versions
  local @kupgrade_sorted=sort keys %VERSION;
  &print_msg("Querying installed versions\n",2);
  open (RPM,"rpm -qa |");
  while (<RPM>) {
    if (/(.+)-(\d{6})/) {
      if (exists $VERSION{$1}) {
	$RPM_VERSION{$1}=$2;
      }
    }
  }
  close RPM;
  if ($?) {
    &print_msg("Error running rpm -qa\n",13);
  }
#  foreach $i (keys %RPM_VERSION)  {
#    print "$i $RPM_VERSION{$i}\n";
#  }
}

sub show_rm { # Show/remove packages
  local $extension,$pkg,$answer;
  &print_msg("*** Package: $package\tCurrent version: $VERSION{$package} ***\n",8) if ($SHOW_PACKAGES || $INTERACT);
  foreach  $extension (keys %PATH){
    local @packages=sort <$PATH{"$extension"}/$package-??????*.$extension>;
    for (local $i;$i <= $#packages;$i++) {
      $packages[$i]=~/.*($package.*)/;
      $pkg=$1;
      if ($i==$#packages && $REMOVE_OLD_PACKAGES) {
	&print_msg("\t$pkg\tMost recent. Won't remove it.\n",10);
	next;
      } else {
	&print_msg("\t*** $extension ***\n",8) if (($SHOW_PACKAGES || $INTERACT) && $i==0);
	&print_msg ("\t\t$pkg",8) if ($SHOW_PACKAGES || $INTERACT);
	&print_msg ("\n",8) if (($SHOW_PACKAGES) && !$REMOVE_OLD_PACKAGES);
      }
      if ($REMOVE_OLD_PACKAGES) {
	if ($INTERACT) {
	  &print_msg("\tRemove [N/y] ",0);
	  $answer=<STDIN>;
	  chomp $answer;
	  if ("$answer" ne "y") {
	    next;
	  }
	  unlink "$packages[$i]";
	} else {
	  &print_msg("\tRemoving $packages[$i] (obsolete)\n",14);
	  unlink "$packages[$i]";
	}
      }
    }
  }
}

sub install { # Install most recent rpm-package
  local @all_bins=sort <$PATH{"$KUPGRADE{ARCH}.rpm"}/$package-*.rpm>;
  local $most_recent=pop @all_bins;
  unless ($most_recent) {
    return;
  }
  $most_recent=~/(\d{6})[^\/]/;
  local $version_most_recent=$1;
  if ($RPM_VERSION{$package}) {
    if ($RPM_VERSION{$package}>=$version_most_recent) {
      &print_msg("Installed version for $package is $RPM_VERSION{$package}\n",10);
      &print_msg("Won't install $most_recent\n",10);
      return;
    }
  }
  if ($INTERACT) {
    &print_msg("Install $most_recent ? [N/y] ",0);
    local $answer=<STDIN>;
    chomp $answer;
    unless ($answer=~/^y$/i) {
      return;
    }
  }
  if(system("$KUPGRADE{RPM_INST} $most_recent")!=0) {
    &print_msg("Error installing $most_recent\n",13);
  } else {
    &print_msg("$most_recent installed\n",12);
  }
}

sub make_spec { # Create new spec-file
  local $line;
  if (-r "$KUPGRADE{BASE_DIR}/spec.src/$package.spec.src" ) {
    open (SPEC_SRC,"$KUPGRADE{BASE_DIR}/spec.src/$package.spec.src");
    open (SPEC,">$KUPGRADE{RPM_ROOT}/SPECS/$package.spec") or &print_msg("Cannot write $KUPGRADE{RPM_ROOT}/SPECS/$package.spec\n",13);
    &print_msg("Creating $KUPGRADE{RPM_ROOT}/SPECS/$package.spec\n",14);
    while (<SPEC_SRC>) {
      $line=$_;
      $line=~s/VERSION/$VERSION{$package}/g;
      $line=~s/PACKAGER/$PACKAGER/g;
      print SPEC "$line";
    }
    close SPEC;
    close SPEC_SRC;
  } else {
    &print_msg("Cannot open $KUPGRADE{BASE_DIR}/spec.src/$package.spec.src\n",12);
  }
}

sub compile { # Compile the package with rpm
# Skip the compilation, if packages already exist
  if ($RPM_OPTS=~/-ba/ && -e "$PATH{\"src.rpm\"}/$package-$VERSION{$package}-1.src.rpm") {
    &print_msg("$package-$VERSION{$package}-1.src.rpm already exists\n",10);
    return 0;
  }
  if ($RPM_OPTS=~/-bb/ && -e "$PATH{\"src.rpm\"}/$package-$VERSION{$package}-1.$KUPGRADE{ARCH}.rpm") {
    &print_msg("$package-$VERSION{$package}-1.$KUPGRADE{ARCH}.rpm already exists\n",10);
    return 0;
  }
  unless (-e "$KUPGRADE{RPM_ROOT}/SPECS/$package.spec") {
    &print_msg("Missing specfile $KUPGRADE{RPM_ROOT}/SPECS/$package.spec\n");
    return;
  }
  local @compile_log,$answer;
# Ask for compilation when interacting
  if ($INTERACT) {
    &print_msg("Compile $package [$VERSION{$package}] ? [N/y] ",0);
    $answer=<STDIN>;
    chomp $answer;
    if ("$answer" ne "y") {
      return;
    }
  }
  &make_spec; # Create new spec-file
# Make tarball if there is none
  unless (-e "$PATH{\"tar.gz\"}/$package-$VERSION{$package}.tar.gz") {
    &print_msg("$PATH{\"tar.gz\"}/$package-$VERSION{$package}.tar.gz not existing\n",14);
    &print_msg("Creating $package-$VERSION{$package}.tar.gz now\n",14);
    &retar;
  }
  &print_msg("Running rpm $RPM_OPTS $KUPGRADE{RPM_ROOT}/SPECS/$package.spec [$VERSION{$package}]\n",14);
#  return 0;
# Compile the package
  open(RPM,"rpm $RPM_OPTS $KUPGRADE{RPM_ROOT}/SPECS/$package.spec 2>&1 |");
  while (<RPM> ) {
    if ($#compile_log > 20) {
      shift @compile_log;
    }
    &print_msg("$_",2);
    push @compile_log,"\t$_";
  }
  close RPM;
# Print errors if occured
  if ($?!=0) {
    &print_msg("Error compiling $package [$VERSION{$package}]:\n\n",12);
    foreach $msg (@compile_log) {
      &print_msg("$msg",12);
    }
  } else {
    &print_msg("Package $package [$VERSION{$package}] built\n",12);
  }
  undef @compile_log;
}

sub retar { # Create new tarball
  local $file;
  local $now=time;
  local @old_archives=<$PATH{"tar.gz"}/$package-??????.tar.gz>;
  unless (-d "$KDESRCBASE/$package" ) {
    &print_msg("No directory $KDESRCBASE/$package to tar\n",12);
    return;
  }
  if (-e "$PATH{\"tar.gz\"}/$package-$VERSION{$package}.tar.gz") {
    &print_msg("$package-$VERSION{$package}.tar.gz exists\n",10);
    return;
  } else {
# Fix the timestamps
    utime($now-1,$now-1,"$KDESRCBASE/$package/aclocal.m4") if (-e "$KDESRCBASE/$package/aclocal.m4");
    utime($now,$now,"$KDESRCBASE/$package/Makefile.in") if (-e "$KDESRCBASE/$package/Makefile.in");
    &print_msg("Creating $package-$VERSION{$package}.tar.gz\n",14);
    chdir "$KDESRCBASE";
# Create the tarball
    if (system("tar cOf - $package | gzip -c >$PATH{\"tar.gz\"}/$package-$VERSION{$package}.tar.gz ")!=0) {
      &print_msg("Cannot create $PATH{\"tar.gz\"}/$package-$VERSION{$package}.tar.gz\n",13);
    }
  }
}

sub create_current { # Create initial VERSION file
  local $package,$version,$file,@files;
  foreach $package (@{ $KUPGRADE{PACKAGES} }){
    @files=<$PATH{"tar.gz"}/$package-??????.tar.gz>;
    @files=(@files,<$KUPGRADE{BASE_DIR}/patches/$package-??????-??????.*>);
    foreach $file (@files) {
      ($version)=($file=~/-(\d{6})\./);
      if(! $VERSION{$package} || $version > $VERSION{$package}) {
	$VERSION{$package}=$version;
      }
    }
  }
}

sub write_current { # Write the VERSION file
  local $package;
  open (VERSION,">$VERSION") or &print_msg("Cannot write to $VERSION\n",13);
#  foreach $package (keys %VERSION){
  foreach $package (@{ $KUPGRADE{PACKAGES} }){
    print VERSION "$package $VERSION{$package}\n";
  }
  close VERSION;
  &print_msg("$VERSION written\n",14);
}

sub get_current {
  local $package,$version;
  open (VERSION,"$VERSION");
  while (<VERSION>) {
    chomp;
    unless (/\w+ \d{6}/) {
      &print_msg("Invalid entry $_ in $VERSION ... ignoring\n",12);
      next;
    }
    ($package,$version)=split / /,$_;
    $VERSION{$package}=$version;
  }
  close VERSION;
#  foreach $i (keys %VERSION) {
#    print "$i $VERSION{$i}\n";
#  }
}

sub patch_sources { # Patch the sources
  local $t_version,$diff_version,$bins_version,$package,@patches;
  local $rest,$extension;
  foreach $package (@{ $KUPGRADE{PACKAGES} }) {
    @patches=sort <$KUPGRADE{BASE_DIR}/patches/$package-$VERSION{"$package"}*>;
    while (@patches) {
      $patch=$patches[0];
      ($t_version,$rest)=($patch=~/-(\d{6})\.(.+)/);
      ($extension)=($rest=~/([^\.]+)$/);
      unless ($UNCOMPRESS{$extension}) {
	&print_msg("Don't know how to handle extension $extension\n",12);
	&print_msg("Skipping $patch\n",12);
      }
      if ($patch=~/diff.$extension$/) { # Patch
	 &print_msg("Applying $patch\n",14);
	 if (system ("$UNCOMPRESS{$extension} $patch | patch -p0 -st")!=0) {
	   &print_msg("Error applying $patch\n",12);
	 } else {
	   system("find $package -name \"*.orig\" -exec rm -f {} \\;");
	  $diff_version=$t_version;
	}
      }
      if ($patch=~/tar.$extension$/) { # Untar
	 &print_msg ("Untaring $patch\n",14);
	 if (system ("$UNCOMPRESS{$extension} $patch | tar xf -")!=0) {
	   &print_msg("Error applying $patch\n",12);
	 } else {
	   $bins_version=$t_version;
	 }
      }
      shift @patches;
      if (@patches==()) { # Set new version for current package
	if ($diff_version>$VERSION{$package}) {
	  $VERSION{$package}=$diff_version;
	}
	if ($bins_version>$VERSION{$package}) {
	  $VERSION{$package}=$bins_version;
	}
	@patches=sort <$KUPGRADE{BASE_DIR}/patches/$package-$VERSION{"$package"}*>;
      }
    }
  }
}

sub unpack_patches { # uudecode, untar and move the patches
  local @patches,$patch;
  mkdir "$TMP_DIR/kde-unpack$$",0755 or &print_msg("Cannot create dir $TMP_DIR/kde-unpack$$\n",13);
  chdir "$TMP_DIR/kde-unpack$$";
  &print_msg("uudecoding ...\n",14);
  if (system("uudecode")!=0) {
    &print_msg("Error uudecoding",13);
  }
  if (-e "diff.tgz") { # Untar tarball if there is a diff.tgz
    open(TAR,"gzip -dc diff.tgz | tar xvf - |"); # Untar
    &print_msg("Untaring diff.tgz\n",14);
    while (<TAR>) {
      if (!/\/$/) {
	chomp;
	push @patches,$_;
      }
    }
    close TAR;
    if ($?!=0) {
      &print_msg("Error untaring $TMP_DIR/kde-unpack$$/diff.tgz\n",13);
    }
  } else { # Get the diff.gz filename 
    @patches=<*.diff.gz>;
  }
  if (@patches) {
    foreach $patch (@patches) { # Move the patches
      $patch=~/(.+)\/([^\/]+)/;
      if (system("mv $patch $KUPGRADE{BASE_DIR}/patches")!=0) {
	&print_msg("Error moving $patch to $KUPGRADE{BASE_DIR}/patches\n",13);
      } else {
	&print_msg("Moving $patch to $KUPGRADE{BASE_DIR}/patches\n",14);
      }
    }
    chdir "$KDESRCBASE";
    &print_msg("Removing $TMP_DIR/kde-unpack$$\n",14);
    system ("rm -rf $TMP_DIR/kde-unpack$$");
    undef @patches;
  } else {
    &print_msg("Neither diff.tgz nor any diff.gz's found in $TMP_DIR/kde-unpack$$/diff.tgz\n",13);
  }
}

sub print_msg { # Print message to stdout/mail/logfile
  if (($_[1]&4)==4) {# To logfile ?
    local $time=localtime;
    print LOG "$time $_[0]";
  }
  if (($_[1]&2)==2) { # Verbose message
    if ($VERBOSE) {
      if ($MAIL && (($_[1]&8)==8)) {
	push @MAIL,$_[0];
      } else {
	print "$_[0]";
      }
    }
  } else { # Usual message
    if ($MAIL) {
      push @MAIL,$_[0];
    } else {
      print "$_[0]";
    }
  }
  if (($_[1]&1)==1) {# Error ?
    &upgrade_exit("$_[1]");
  }
}

sub upgrade_exit { # Exit
  &unlock;
  close LOG;
  if ($MAIL && @MAIL) {
    &mail;
    exit $_[0];
  } else {
    exit $_[0];
  }
}

sub mail { # Mail the output
  local $time=time;
  local $date=localtime($time);
  open (MAILER,"| $KUPGRADE{MAILER}");
  print MAILER "To: $KUPGRADE{MAILTO}\n";
  print MAILER "From: kupgrade\n";
  print MAILER "Subject: kde-upgrade: $date report\n";
  print MAILER @MAIL;
  close MAILER;
}

sub lock { # Make lockfile
  &print_msg("Locking\n",10);
  open (LOCK,">$KUPGRADE{BASE_DIR}/LOCK") or &print_msg("Cannot create lockfile $KUPGRADE{BASE_DIR}/LOCK\n",13);
  print LOCK "$$\n";
  close LOCK;
}

sub check_lock { # Check for lockfile
  if (-e "$KUPGRADE{BASE_DIR}/LOCK") {
    return 1;
  } else {
    return 0;
  }
}

sub unlock { # Remove the lockfile
  &print_msg("Unlocking\n",10);
  unlink "$KUPGRADE{BASE_DIR}/LOCK";
}
sub get_cfg { # Get the configuration from kupgrade.rc
  local $req_entry;
  unless (open (CFG,"$CFG_FILE")) {
    print STDERR "Cannot open configuration file $CFG_FILE\n";
    exit 1;
  }
  while (<CFG>) {
    s/^ +| +$|\t//g;
    s/ +/ /g;
    unless (/^(\w+)=(.+)/) {
      next;
    }
    if ("$1" eq "PACKAGES") {
      $KUPGRADE{PACKAGES}=[ split / /,$2 ];
    } else {
      $KUPGRADE{"$1"}=$2;
    }
  }
  close CFG;
  foreach $req_entry (@CFG_KEYS) {
    unless ($KUPGRADE{$req_entry}) {
      &print_msg( "Missing entry $req_entry in $ENV{HOME}/.kupgrade\n",13);
    }
  }
  %PATH=("tar.gz" => "$KUPGRADE{TAR_DIR}",
	 "$KUPGRADE{ARCH}.rpm" => "$KUPGRADE{RPM_ROOT}/RPMS/$KUPGRADE{ARCH}",
	 "src.rpm" => "$KUPGRADE{RPM_ROOT}/SRPMS");
  $LOG="$KUPGRADE{BASE_DIR}/log/kupgrade.log";
  $VERSION="$KUPGRADE{BASE_DIR}/log/VERSION";
  $TMP_DIR="$KUPGRADE{BASE_DIR}/tmp";
  $KDESRCBASE="$KUPGRADE{BASE_DIR}/src";
}
sub usage {
print <<EOF

kupgrade [ovuUpcRtmh] [-f <cfgfile>] [-P package_1,...,package_n]

Version $Revision: 1.3 $\

-v                  verbose
-u                  Uudecode, untar and move the patches
                    to $KUPGRADE{BASE_DIR}/patches.
                    Expects uudecoded diff.tgz on STDIN
-U                  Upgrade the package(s) using rpm -U
-p                  Patch the sources up to date. Searches for patches
                    in $KUPGRADE{BASE_DIR}/patches.
-P package_1,...    Work on package_1,...
                    Default is to work on all packes set in
                    $ENV{HOME}/.kupgrade
-f cfgfile          Use config-file cfgfile instead of $ENV{HOME}/.kupgrade
-c                  Compile the packages with rpm.
-o 'opts'           Compile-options for rpm. Default is $KUPGRADE{RPM_OPTS}.
-R                  Remove old package(s)
-t                  Create new tarball(s)
-m                  Mail the output to $KUPGRADE{MAILTO}
-h                  Show this help
-i                  Disable interaction. Default is interaction on.
-s                  Show packages
-F                  Force recreation of $KUPGRADE{BASE_DIR}/log/VERSION 

EOF
}
