diff options
author | Pascal Rigaux <pixel@mandriva.com> | 2002-08-05 19:04:10 +0000 |
---|---|---|
committer | Pascal Rigaux <pixel@mandriva.com> | 2002-08-05 19:04:10 +0000 |
commit | 9be8d3b3407562628b07f0b2c27b673ef208f225 (patch) | |
tree | 90b9744ee4fc8b953fc120ff38671d44c35aa35f /build_archive | |
parent | eac9649e7ca04a812481abb66c922c2345ef9207 (diff) | |
download | rpmtools-9be8d3b3407562628b07f0b2c27b673ef208f225.tar rpmtools-9be8d3b3407562628b07f0b2c27b673ef208f225.tar.gz rpmtools-9be8d3b3407562628b07f0b2c27b673ef208f225.tar.bz2 rpmtools-9be8d3b3407562628b07f0b2c27b673ef208f225.tar.xz rpmtools-9be8d3b3407562628b07f0b2c27b673ef208f225.zip |
- remove obsolete stuff4.5.2
- move packdrake.pm in its own directory to make MakeMaker happy
Diffstat (limited to 'build_archive')
-rwxr-xr-x | build_archive | 197 |
1 files changed, 0 insertions, 197 deletions
diff --git a/build_archive b/build_archive deleted file mode 100755 index 6da6fae..0000000 --- a/build_archive +++ /dev/null @@ -1,197 +0,0 @@ -#!/usr/bin/perl - -#- Mandrake Simple Archive Builder. -#- Copyright (C) 1999 MandrakeSoft (fpons@mandrakesoft.com) -#- -#- This program is free software; you can redistribute it and/or modify -#- it under the terms of the GNU General Public License as published by -#- the Free Software Foundation; either version 2, or (at your option) -#- any later version. -#- -#- This program is distributed in the hope that it will be useful, -#- but WITHOUT ANY WARRANTY; without even the implied warranty of -#- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -#- GNU General Public License for more details. -#- -#- You should have received a copy of the GNU General Public License -#- along with this program; if not, write to the Free Software -#- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -#- Simple cat archive with bzip2 for perl. -#- read file list and produce an $ARGV[0].cz2 archive file. -#- uncompressing sheme is: -#- | | -#- | | | | -#- $off1 =|*| } | | -#- |*| } $off2 =|+| } -#- |*| } $siz1 => 'bzip2 -d' => |+| } $siz2 => $filename -#- |*| } |+| } -#- |*| } | | -#- | | | | -#- | | | | -#- | | -#- where %data has the following format: -#- { 'filename' => [ 'f', $off1, $siz1, $off2, $siz2 ] } -#- except for symbolink link where it is: -#- { 'filename_symlink' => [ 'l', $symlink_value ] } -#- and directory where it is only -#- { 'filename_directory' => [ 'd' ] } -#- as you can see, there is no owner, group, filemode... an extension could be -#- made with 'F' (instead of 'f'), 'L' instead of 'l' for exemple. -#- we do not need them as it is used for DrakX for fast archive extraction and -#- owner/filemode is for user running only (ie root). -#- -#- archive file contains concatenation of all bzip2'ed group of files whose -#- filenames are on input, -#- then a TOC (describing %data, concatenation of toc_line) follow and a -#- TOC_TRAILER for summary. - -#+use strict qw(subs vars refs); - -#- tempory file used for building. -my $tmpdir = $ENV{TMPDIR} || "/tmp"; -my $tmpz = "$tmpdir/tmp.z.$$"; - -sub toc_line { - my ($file, $data) = @_; - - for ($data->[0]) { - return(/l/ && pack("anna*", 'l', length($file), length($data->[1]), "$file$data->[1]") || - /d/ && pack("ana*", 'd', length($file), $file) || - /f/ && pack("anNNNNa*", 'f', length($file), $data->[1], $data->[2], $data->[3], $data->[4], $file) || - die "unknown extension $_\n"); - } -} - -sub cat_compress { - my ($compress, @filenames) = @_; - local *F; - open F, "| $compress >$tmpz" or die "cannot start \"$compress\"\n"; - foreach (@filenames) { - my ($buf, $siz, $sz); - local *FILE; - open FILE, $_ or die "cannot open $_: $!\n"; - $siz = -s $_; - while (($sz = sysread(FILE, $buf, $siz > 16384 ? 16384 : $siz))) { - $siz -= $sz; - syswrite(F, $buf); - last unless $siz > 0; - } - close FILE; - } - close F; - -s $tmpz; -} - -sub main { - my ($archivename, $maxsiz) = @_; - my ($compress, $uncompress, $off1, $siz1, $off2, $siz2) = ('', '', 0, 0, 0, 0); - my @filelist = (); - my @data = (); - my %data = (); - - die "usage: $0 <archivename> <maxsiz>\n" unless $maxsiz >= 100000; - - #- guess compress method to use. - if ($archivename =~ /\.cz$/) { - ($compress, $uncompress) = ("gzip -9", "gzip -d"); - } elsif ($archivename =~ /\.cz2$/) { - ($compress, $uncompress) = ("bzip2 -9", "bzip2 -d"); - } else { - die "how to choose a compression which such a filename $archivename\n"; - } - print STDERR "choosing compression method with \"$compress\" for archive $archivename\n"; - - unlink "$archivename"; - unlink $tmpz; - - foreach (<STDIN>) { - chomp; - - my $file = $_; -e $file or die "unable to find file $file\n"; - - push @data, $file; - #- now symbolic link and directory are supported, extension is - #- available with the first field of $data{$file}. - if (-l $file) { - $data{$file} = [ 'l', readlink $file ]; - } elsif (-d $file) { - $data{$file} = [ 'd' ]; - } else { - $siz2 = -s $file; - - push @filelist, $file; - $data{$file} = [ 'f', -1, -1, $off2, $siz2 ]; - - if ($off2 + $siz2 > $maxsiz) { #- need compression. - $siz1 = cat_compress($compress, @filelist); - - foreach (@filelist) { $data{$_} = [ 'f', $off1, $siz1, $data{$_}[3], $data{$_}[4] ] } - - system "cat $tmpz >>$archivename"; - $off1 += $siz1; - $off2 = 0; $siz2 = 0; - @filelist = (); - } - $off2 += $siz2; - } - } - if (scalar @filelist) { - $siz1 = cat_compress($compress, @filelist); - - foreach (@filelist) { $data{$_} = [ 'f', $off1, $siz1, $data{$_}[3], $data{$_}[4] ] } - - system "cat $tmpz >>$archivename"; - $off1 += $siz1; - print STDERR "real archive size of $archivename is $off1\n"; - } - - #- produce a TOC directly at the end of the file, follow with - #- a trailer with TOC summary and archive summary. - local *OUTPUT; - open OUTPUT, ">>$archivename"; - - my ($toc_str, $toc_data) = ('', ''); - my @data_d = (); - my @data_l = (); - my @data_f = (); - - foreach (@data) { - my $file = $_; - $data{$file} or die "build_archive: internal error on $_\n"; - - #- specific according to type. - #- with this version, only f has specific data other than strings. - for ($data{$file}[0]) { - /d/ && do { push @data_d, $file; last; }; - /l/ && do { push @data_l, $file; last; }; - /f/ && do { push @data_f, $file; $toc_data .= pack("NNNN", - $data{$file}[1], - $data{$file}[2], - $data{$file}[3], - $data{$file}[4]); last; }; - die "unknown extension $_\n"; - } - } - - foreach (@data_d) { $toc_str .= $_ . "\n" } - foreach (@data_l) { $toc_str .= $_ . "\n" . $data{$_}[1] . "\n" } - foreach (@data_f) { $toc_str .= $_ . "\n" } - - print OUTPUT $toc_str; - print OUTPUT $toc_data; - print OUTPUT toc_trailer(scalar(@data_d), scalar(@data_l), scalar(@data_f), - length($toc_str), $uncompress); - close OUTPUT; -} - -sub toc_trailer { - my ($toc_d_count, $toc_l_count, $toc_f_count, $toc_str_size, $uncompress) = @_; - - #- 'cz[0' is toc_trailer header where 0 is version information, only 0 now. - #- '0]cz' is toc_trailer trailer that match the corresponding header for information. - return pack "a4NNNNa40a4", 'cz[0', $toc_d_count, $toc_l_count, $toc_f_count, $toc_str_size, $uncompress, '0]cz'; -} - -main(@ARGV); -unlink $tmpz; |