#!/usr/bin/perl

# Copyright (C) 2004 Marcel Meckel <debian [at] thermoman [dot] de>
#
# 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, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

# dpkg-clean 0.2.1
# clean debian package database of unavailable/purged
# entries
#
# hint: call 'dselect update' before running this script


 $dir		= '/var/lib/dpkg';
 $statusfile	= "$dir/status";
 $backupfile	= "$dir/status.backup.dpkg-clean";
 $newfile	= "$dir/status.new";

 open( DATA, $statusfile ) || die "Can not open $statusfile\n";	# read complete file in array
 @lines = <DATA>;
 close DATA;

 chomp(@lines);

 $bigline = join("\n", @lines)."\n";

 # delete unwanted entries
 $bigline =~ s/Package: [^\n]*\nStatus: (purge|deinstall) ok not-installed\nPriority: [^\n]*\nSection: [^\n]*\n(Architecture: [^\n]*\n)?\n//g;

 open( DATA, ">$newfile" ) || die "Can not open $newfile\n";
 print DATA $bigline; # write the big string in a new file
 close DATA;

 rename($statusfile, $backupfile) || die "Can not rename $statusfile to $backupfile\n";	# make a backup of current status file
 rename($newfile, $statusfile) || die "Can not rename $newfile to $statusfile\n"; # move the .new file to the place of status

 # finished
 
 exit 0;