#!/usr/bin/perl -w # debfiles -- lintian collector script # Copyright (C) 1999 by Joey Hess # # 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 of the License, 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, you can find it on the World Wide # Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, # MA 02110-1301, USA. use strict; ($#ARGV == 1) or fail("syntax: debfiles "); my $pkg = shift; my $type = shift; -e "unpacked" or fail("debfiles invoked in wrong directory"); use lib "$ENV{'LINTIAN_ROOT'}/lib"; use Pipeline; if (-e "debfiles") { spawn('rm', '-rf', 'debfiles') == 0 or fail("cannot rm old debfiles directory"); } mkdir('debfiles', 0777) or fail("cannot mkdir debfiles: $!"); # Don't copy the whole directory, just all files in it. opendir(DEBIAN, 'unpacked/debian') or fail("cannot open unpacked/debian/ directory: $!"); while (my $file=readdir(DEBIAN)) { next if -d $file; spawn('cp', '-a', "unpacked/debian/$file", 'debfiles/') == 0 or fail("cannot copy unpacked/debian/$file: $!"); } closedir(DEBIAN); exit 0; # ----------------------------------- sub fail { if ($_[0]) { print STDERR "internal error: $_[0]\n"; } elsif ($!) { print STDERR "internal error: $!\n"; } else { print STDERR "internal error.\n"; } exit 1; }