#!/usr/bin/perl -W # Copyright (C) 2001 Mandrakesoft # Author David Odin # # $Id: packages_to_update.pl,v 1.9 2001/06/05 16:21:32 philippe Exp $ # # version 0.5 # CAUTION: this script isn't arch safe! # for the classical 7.2 update #my $mandrake_release = 7.2; # for the specific SNF my $mandrake_release = "snf7.2"; # First get the transaction name (FIRST STEP IN ALL SCRIPTS) my $transaction_name = shift @ARGV if @ARGV; # if $test = 1, the current mirror is taken on the command-line # if $test = 0, the current mirror is taken from the proxy variable config file my $test = 0; my $CurrentMirror; if ($test) { $CurrentMirror = $ARGV[0]; } else { if (! $transaction_name ) { $transaction_name = "$$"; # initialize a backend transaction system ("config-wrapper.pl $transaction_name -i"); } # Get the CurrentMirror value $CurrentMirror = `config-wrapper.pl $transaction_name -g CurrentMirror`; chomp $CurrentMirror; if ( $transaction_name eq "$$" ) { # cleanup the transaction system ("config-wrapper.pl $transaction_name -a"); } } my (@to_update, $rep, $name); $rep = ""; open F, "curl -s $CurrentMirror/$mandrake_release/ls-lR |"; foreach () { if (/^([^ ]+):$/) { $rep = "updates/$mandrake_release/$1"; } elsif (/^(-|l)/) { $rep =~ /SRPMS/ and next; my @l = split; push @to_update, $l[4], "$rep/$l[8]" if $l[8]; } } close F or die; get_updates2(@to_update); #-######################################################################## # get_updates2 #-######################################################################## sub get_updates2 { # add ""/mandrake-release-(.*?)-/ and $version = $1;"" in the map to get the mandrake release number my @installed = map { chop; $_ } `rpm -qa`; my $installeds = join "|", map { my ($a) = /(.*)-.+?-/ or return 0; quotemeta($a) } @installed; my $installedf = join "|", map { quotemeta } @installed; my $first_mirror = 1; my $rc; my ($i, $size, @to_really_update); foreach (@_) { if ($i = !$i) { $size = $_; } else { $fullname = $_; $fullname =~ s!.*/!!; m!(^|/)($installeds)-([^-]+)-([^-]+)\.[^.]+\.rpm$! or next; # the following line is still there for speed purpose /$installedf/ and next; # must not be exactly like already installed $package = $2; $ver = $3; $rel = $4; $version = "$ver-$rel"; $installed_ver = `rpm -q --queryformat "%{VERSION}" $package`; $installed_rel = `rpm -q --queryformat "%{RELEASE}" $package`; $installed_version = "$installed_ver-$installed_rel"; $rc = rpmvercmp($installed_ver, $ver); if ($rc == 1 || ($rc == 0 && rpmvercmp($installed_rel, $rel) >= 0)) { next; } # push @to_really_update, $_, $2, $3, $size; if ($first_mirror) { $first_mirror = 0; } else { print ","; } print "$package (version=$version installed_version=$installed_version "; print "size=$size)"; } } # @to_really_update } # This sub is the Perl-port of the same function defined in the rpmlib # as far as possible I've tried to use the same variable name sub rpmvercmp { my ($a, $b) = @_; my ($one, $two); my ($str1, $str2); my $rc; if ($a eq $b) { return 0 }; ($one, $two) = ($a, $b); while ($one && $two) { $one = $1 if $one =~ /^[^A-Za-z0-9]*(.*)$/; $two = $1 if $two =~ /^[^A-Za-z0-9]*(.*)$/; if ($one =~ /^[0-9]/) { $one =~ /^0*([0-9]+)(.*)/; ($str1, $one) = ($1, $2); if ($two =~ /^[0-9]/) { $two =~ /^0*([0-9]+)(.*)/; ($str2, $two) = ($1, $2); } else { return -1; } if (length($str1)>length($str2)) { return 1; } if (length($str1)