This commit was manufactured by cvs2svn to create tagV10_3_0_52mdk

'V10_3_0_52mdk'.

1 files changed, 0 insertions, 361 deletions

diff --git a/tools/install-xml-file-list b/tools/install-xml-file-list
deleted file mode 100755
index 388e03ee5..000000000
--- a/tools/install-xml-file-list
+++ /dev/null
@@ -1,361 +0,0 @@
-#!/usr/bin/perl
-
-use MDK::Common;
-use XML::Parser;
-use Data::Dumper;
-use Config;
-use Cwd 'cwd';
-
-my $want_sudo = $ARGV[0] eq '--sudo' && shift @ARGV;
-
-@ARGV == 2 or die "usage: install-xml-file-list [--sudo] <xml file> <destination>\n";
-my ($xml_file_list, $DEST) = @ARGV;
-
-my $sudo = '';
-if ($>) {
-    $sudo = "sudo" if $want_sudo;
-    $ENV{PATH} = "/sbin:/usr/sbin:$ENV{PATH}";
-}
-
-#$verbose = 1;
-
-my $initial_dir = cwd();
-my $ARCH = arch() =~ /i.86/ ? 'i386' : arch();
-my $LIB = arch() =~ /x86_64/ ? "lib64" : "lib";
-
-my $base_cpio_options = '-pumd --quiet';
-
-my $tree = XML::Parser->new(Style => 'Tree')->parsefile($xml_file_list);
-
-my $main_node = decompose($tree);
-
-$main_node->{tag} eq 'list' or die "bad file $xml_file_list (main tag should be <list>)\n";
-
-handle_nodes({}, $main_node);
-
-install_needed_libraries();
-
-final_cleanup();
-
-sub final_cleanup() {
-    #- cpio creates directory 700, that's not nice
-    system("find $DEST -type d | xargs $sudo chmod 755");
-}
-
-sub handle_nodes {
-    my ($env, $e) = @_;
-    handle_node($env, decompose($_)) foreach @{$e->{l}};
-}
-sub handle_node {
-    my ($env, $node) = @_;
-
-    if (!$node->{tag} && $node->{text} !~ /\S/) {
-    } elsif (!$node->{tag}) {
-	install($env, $node->{text});
-    } elsif ($node->{tag} eq 'if') {
-	my $cond = valid_cond($node->{attr});
-	handle_nodes($env, $node) if $cond;
-    } elsif ($node->{tag} eq 'if-not') {
-	my $cond = valid_cond($node->{attr});
-	handle_nodes($env, $node) if !$cond;
-    } elsif (member($node->{tag}, 'from', 'to', 'mode', 'filter')) {
-	handle_nodes(add_to_env($env, $node->{tag} => $node->{attr}), $node);
-    } else {
-	warn "expecting tag <from>, not <$node->{tag}>\n";
-    }
-}
-
-sub valid_cond {
-    my ($attr) = @_;
-    every {
-	if ($_ eq 'ARCH') {
-	    $ARCH =~ /$attr->{$_}/;
-	} elsif ($_ eq 'set') {
-	    $ENV{$attr->{$_}};
-	} else {
-	    die "<if>: unknown condition $_\n";
-	}
-    } keys %$attr;
-}
-
-sub add_to_env {
-    my ($env, $tag, $attr) = @_;
-    my %env = map_each { $::a => +{%$::b} } %$env;
-    foreach (keys %$attr) {
-	!$env{$tag}{$_} or die qq(overriding attribute <$tag $_="$env{$tag}{$_}"> with $_="$attr->{$_}"\n); 
-	$env{$tag}{$_} = $attr->{$_};
-    }
-    \%env;
-}
-
-sub group_by_n {
-    my ($n, $l) = @_;
-    my (@r, $subl);
-    my $i = 0;
-    foreach (@$l) {
-	if ($i % $n == 0) {
-	    push @r, $subl = [];
-	}
-	push @$subl, $_;
-	$i++;
-    }
-    @r;
-}
-
-sub identify_file {
-    my ($dev, $ino) = @_;
-    "$dev:$ino";
-}
-
-sub all_files_rec_ {
-    my ($d) = @_;
-
-    $d, -d $d && ! -l $d ? map {  all_files_rec_("$d/$_") } all($d) : ();
-}
-
-sub expand_macros {
-    my ($f) = @_;
-    $f =~ s!\bLIB\b!$LIB!g;
-    $f =~ s!\bARCH\b!$ARCH!ge;
-    $f =~ s!\$\((\w+)\)!$ENV{$1} || die "$1 undefined\n"!ge;
-    $f;
-}
-
-my %needed_libraries;
-sub collect_needed_libraries {
-    my (@to_check) = @_;
-    while (@to_check) {
-	my $to_check = join(' ', @to_check);
-	my @l = `ldd $to_check 2>/dev/null` =~ m! => (/\S+)!g;
-	foreach (@l) {
-	    if ($main_node->{attr}{'no-arch-libraries'}) {
-		#- replace /lib/tls or /lib/i686 with /lib
-		s!^(/lib(64)?/).*?/!$1!;
-	    }
-	}
-	@to_check = grep { !$needed_libraries{$_}++ } @l;	
-	@to_check = ();
-    }
-}
-sub install_needed_libraries {
-    copy_files('', $DEST, [ keys %needed_libraries ], '', '--dereference');
-}
-
-sub collect_needed_perl_files {
-    my ($local_rep, $dest, @scripts) = @_;
-
-    my (%local, %global);
-    foreach my $script (@scripts) {
-	foreach (`strace -efile perl -cw -I$local_rep $script 2>&1`) {
-	    my ($f) = /^open\("(.*?)",.*\)\s*=\s*\d+$/ or next;
-	    if ($f =~ m!^\Q$local_rep\E/(.*)!) {
-		$local{$1} = 1;
-	    } elsif (begins_with($f, '/dev/')) {
-		# skip
-	    } elsif (begins_with($f, '/')) {
-		if ($main_node->{attr}{'no-arch-libraries'}) {
-		    #- replace /lib/tls or /lib/i686 with /lib
-		    $f =~ s!^(/lib(64)?/).*?/!$1!;
-		}
-		$global{$f} = 1;
-	    }
-	}
-    }
-    [ keys %local ], [ keys %global ];
-}
-
-sub copy_files {
-    my ($working_dir, $to_dir, $files, $b_flatten, @options) = @_;
-
-    if ($b_flatten) {
-	mkdir_p($to_dir);
-	my $options = join(' ', '-r', @options);
-	foreach (group_by_n(20, $files)) {
-	    warn "cp $options to_dir $to_dir from $working_dir: @$_\n" if $verbose;
-	    system("cd $working_dir ; $sudo cp $options @$_ $to_dir");
-	}
-    } else {
-	my $options = join(' ', $base_cpio_options, @options);
-	warn "cpio $options to_dir $to_dir from $working_dir: @$files\n" if $verbose;
-	open(my $F, "| cd $working_dir ; $sudo cpio $options $to_dir");
-	print $F "$_\n" foreach @$files;
-	close($F) or die "cpio $to_dir failed\n";
-    }
-}
-
-sub install {
-    my ($env, $text) = @_;
-
-    my $from_dir = expand_macros($env->{from}{dir});
-    my $to_dir = $DEST . expand_macros($env->{to}{dir} || $env->{to}{flatten} && $from_dir || '');
-    my $copy_mode = $env->{mode}{copy} || '';
-    my $working_dir = '.';
-
-    my $expand = $env->{from}{expand} || '';
-
-    my $disallow_from_dir = sub {
-	!$from_dir or die "from dir not allowed with $expand binary\n";
-    };
-
-    my $from_file = sub {
-	my ($rel, $b_full_glob, $b_recursive_dirs) = @_;
-	my $f = expand_macros($from_dir ? "$from_dir/$rel" : $rel);
-	my @l = $f;
-	chdir $working_dir;
-	if ($f =~ /\*/ || $b_full_glob) {
-	    @l = glob($f) or die "no match for $f\n"; 
-
-	    @l == 1 || $b_full_glob or die "multiple match for $f\n";	    
-	} else {
-	    -e $f or die "missing file $f ($rel) in $working_dir\n";
-	}
-	if (@l == 1 && -d $l[0] && $b_recursive_dirs) {
-	    @l = all_files_rec_($l[0]);
-	}
-	@l = grep { !m!/CVS($|/)! } @l;
-	if (my $re = $env->{from}{matching}) {
-	    @l = grep { eval $re } @l;
-	}
-
-	collect_needed_libraries(grep { -x $_ } @l);
-
-	chdir $initial_dir;
-	@l;
-    };
-
-    my @files;
-    if ($expand eq 'tar') {
-	foreach (split(' ', $text)) {
-	    system('tar', 'xfj', $from_file->($_), '-C', $to_dir);
-	}
-	# not filling @files, things are already done
-
-    } elsif ($expand eq 'command') {
-	@files = chomp_(`$text`);
-
-    } elsif ($expand eq 'glob') {
-	#- glob done in $from_file
-	@files = split(' ', $text);
-
-    } elsif ($expand eq 'binary') {
-	$disallow_from_dir->();
-	my @PATH = qw(/sbin /bin /usr/bin /usr/sbin /usr/X11R6/bin);
-	foreach my $name (map { expand_macros($_) } split(' ', $text)) {
-	    my @l = grep { -x $_ } map { "$_/$name" } @PATH;
-	    @l or die "can't find binary $name\n";
-	    if (@l > 1) {
-		my @m = grep { ! -l $_ } @l;
-		if (@m == 1) {
-		    my $id = identify_file($m[0]);
-		    push @files, grep { -l $_ && identify_file($_) eq $id } @l;
-		}
-		@l = @m if @m;
-	    }
-	    if (@l > 1) {
-		warn "many matches for binary $name: " . join(' ', @l) . ", choosing $l[0]\n";
-	    }
-	    my $f = $l[0];
-	    while (1) {
-		push @files, $f;
-		my $l = readlink($f) or last;
-		if ($l =~ m!/! && $l !~ m!^\.\..*/s?bin/[^/]+$!) {
-		    warn "keeping symlink $f -> $l as is\n";
-		    last;
-		}
-		$f = dirname($f) . '/' . $l;
-	    }
-	}
-	$copy_mode = 'keep-links';
-	$env->{filter}{command} ||= 'strip';
-
-    } elsif ($expand eq 'rpm') {
-	$disallow_from_dir->();
-	foreach my $rpm (split(' ', $text)) {
-	    my @l = chomp_(`rpm -ql $rpm`) or die "rpm $rpm must be installed\n";
-	    push @files, @l;
-	}
-
-    } elsif ($expand eq 'perl') {
-	$disallow_from_dir->();
-	$from_dir = '/usr/lib/perl5/vendor_perl/*';
-	@files = split(' ', $text);
-    } elsif ($expand eq 'main-perl') {
-	$disallow_from_dir->();
-	$from_dir = $Config{privlib};
-	@files = split(' ', $text);
-    } elsif ($expand =~ /collect-perl-files/) {
-	my (undef, $local, $to) = split(' ', $expand);
-
-	@files = split(' ', $text);
-	warn "collect-perl-files $local $to @files ($env->{filter}{command})\n";
-	my ($local_perl_files, $global_perl_files) = collect_needed_perl_files($local, $to, @files);
-	warn "collect-perl-files gave: ", join(' ', @$local_perl_files), "\n";
-#	warn "                    and: ", join(' ', @$global_perl_files), "\n";
-	copy_and_filter("$working_dir/$local", "$DEST$to", $local_perl_files, $env->{filter}, '', '--dereference');
-	copy_and_filter('', $DEST, $global_perl_files, $env->{filter}, '', '--dereference');
-
-    } elsif ($expand) {
-	die "unknown expand method $expand\n";
-    } else {
-	@files = split(' ', $text);
-
-	$env->{filter}{command} ||= 'strip' if $to_dir =~ m!/bin$!;
-    }
-
-    if ($env->{to}{dir} && $from_dir) {
-	$working_dir = $from_dir;
-	undef $from_dir;
-    }
-
-    my @all_files = map { $from_file->($_, $expand eq 'glob', $expand ne 'rpm') } @files;
-   
-    my @options = (
-	if_($copy_mode ne 'keep-links', '--dereference'),
-    );
-    copy_and_filter($working_dir, $to_dir, \@all_files, $env->{filter}, $env->{to}{flatten}, @options);
-}
-
-sub copy_and_filter {
-    my ($working_dir, $to_dir, $all_files, $filter, $flatten, @copy_options) = @_;
-
-    copy_files($working_dir, $to_dir, $all_files, $flatten, @copy_options);
-    apply_filter($to_dir, $filter, $all_files, $flatten);
-}
-
-sub apply_filter {
-    my ($to_dir, $filter, $all_files, $b_flatten) = @_;
-
-    chdir $to_dir;
-    foreach (group_by_n(20, $all_files)) {
-	my @l = $b_flatten ? (map { basename($_) } @$_) : (map { "./$_" } @$_);
-	@l = grep { ! -d $_ } @l;
-
-	if (my $subst = $filter->{subst}) {
-	    system('perl', '-pi', '-e', $subst, @l);
-	}
-	if (my $command = $filter->{command}) {
-	    $command = $initial_dir . "/$command" if $command =~ m!^..?/!;
-	    if ($command =~ /simplify-drakx-modules/) {
-		@l = grep { !/\.so($|\.)/ } @l;
-	    }
-	    my @options = (
-		if_($command eq 'gzip', '-9f'),
-		if_($command eq 'strip', '2>/dev/null'),
-	    );
-	    warn "running $command @options @l\n" if $verbose;
-	    system(join(' ', $command, @options, @l));
-	}
-    }
-    chdir $initial_dir;
-}
-
-sub decompose {
-    my ($tree) = @_;
-    my ($tag, $val) = @$tree;
-    if ($tag eq '0') {
-	{ text => $val };
-    } else {
-	my ($attr, @l) = @$val;
-	{ tag => $tag, attr => $attr, l => [ group_by2(@l) ] };
-    }
-}