#!/usr/bin/perl # # $Id$ # #- Copyright (C) 1999-2005 Mandrakesoft #- #- 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. use strict; use URPM; use URPM::Build; use File::Find; use File::Path; use Getopt::Long; my ($noclean, $nooutput, $dontdie, $suffix, $dest) = (0, 0, 0, "", ""); my $tmpdir = (-d "$ENV{HOME}/tmp" ? "$ENV{HOME}/tmp" : $ENV{TMPDIR} || "/tmp") . "/.build_hdlist"; sub usage { print < sub { usage(); exit }, 'noclean' => \$noclean, 'headersdir=s' => \$tmpdir, 'fermetagueule|s' => \$nooutput, 'dest=s' => \$dest, 'nobadrpm' => \$dontdie, 'suffix=s' => \$suffix, ); my $urpm = new URPM; my $index = "hdlist$suffix.cz"; my $synthesis = "synthesis.$index"; my @dir = @ARGV ? @ARGV : ("."); grep { m!^/! } @dir and die "Directory path to parse should be relative"; $dest and do { chdir $dest or die "can't chdir in directory $dest" }; rmtree($tmpdir) unless $noclean; mkpath($tmpdir); my @rpms; my %rpmslist; sub wanted { if (-f $_ && /^.*\.rpm$/) { push(@rpms, $File::Find::name); } } # get rpm list open my $list, ">", "list$suffix" or die "can't create list file: $!"; foreach my $dir (@dir) { print "parsing $dir\n" unless $nooutput; @rpms = (); %rpmslist = (); File::Find::find({ wanted => \&wanted, follow => 1 }, $dir); $urpm->parse_rpms_build_headers( dir => $tmpdir, rpms => \@rpms, dontdie => $dontdie, silent => $nooutput, callback => sub { my ($urpm, $id, %options) = @_; # This code need a fix in perl-URPM # print $list "$options{file}\n"; $rpmslist{scalar($urpm->{depslist}[$id]->fullname) . ".rpm"} = 1; $urpm->{depslist}[$id]->pack_header; }, ); # This code will become useless... see above foreach my $rpm (@rpms) { $rpmslist{($rpm =~ m!.*/(.*)$!)[0]} or next; print $list "$rpm\n"; } } close($list); # create index file # No rpms, exit ! @{$urpm->{depslist}} > 0 or die "nothing read"; $urpm->build_hdlist(start => 0, end => $#{$urpm->{depslist}}, dir => $tmpdir, hdlist => $index, ratio => 9); rmtree($tmpdir) unless $noclean; # create synthesis file $urpm->build_synthesis(start => 0, end => $#{$urpm->{depslist}}, synthesis => $synthesis);