#!/usr/bin/perl (our $VERSION) = q$Id$ =~ /(\d+\.\d+)/; #- 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; use Pod::Usage; 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 () { pod2usage({ -verbose => 1 }); } GetOptions( 'dest=s' => \$dest, 'headersdir=s' => \$tmpdir, 'help|h' => sub { usage(); exit 0 }, nobadrpm => \$dontdie, noclean => \$noclean, s => \$nooutput, 'suffix=s' => \$suffix, 'v|version' => sub { warn "$0 version $VERSION\n"; exit 0 }, ); my $urpm = new URPM; my $index = "hdlist$suffix.cz"; my $synthesis = "synthesis.$index"; my @dir = @ARGV ? @ARGV : ("."); grep { m!^/! } @dir and die "Directories to parse should be relative\n"; $dest and do { chdir $dest or die "Can't chdir in directory $dest\n" }; rmtree($tmpdir) unless $noclean; mkpath($tmpdir); my @rpms; my %rpmslist; # get rpm list open my $list, ">", "list$suffix" or die "Can't create list file: $!\n"; foreach my $dir (@dir) { print "parsing $dir\n" unless $nooutput; @rpms = (); %rpmslist = (); File::Find::find( { wanted => sub { if (-f $_ && /^.*\.rpm$/) { push(@rpms, $File::Find::name); } }, follow => 1, }, $dir, ); $urpm->parse_rpms_build_headers( dir => $tmpdir, rpms => \@rpms, dontdie => $dontdie, silent => $nooutput, callback => sub { my ($urpm, $id, %options) = @_; # This code needs 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!.*/(.*)\z!)[0]} or next; print $list "$rpm\n"; } } close($list); # create index file # No rpms, exit ! @{$urpm->{depslist}} > 0 or die "Nothing read\n"; $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, ); __END__ =head1 NAME genhdlist - generates an hdlist file =head1 SYNOPSIS gendistrib [options] dir [dir...] =head1 OPTIONS =over 4 =item --dest dir Build index from this directory. =item --headersdir dir Put temporary files in directory. =item --nobadrpm Do not abort on bad rpms. =item --noclean Keep cache files. =item -s Silent mode. =item --suffix SUFFIX Put a suffix on hdlist names. =back =head1 DESCRIPTION =head1 SEE ALSO gendistrib(1) =head1 COPYRIGHT 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. =cut