#!/usr/bin/perl -w # reduck10.pl # Copyright 2002 Charlie Kim # # 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. # # For a copy of the GNU General Public License, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # This program uses the following modules # Perl/Tk 800.023 Copyright (c) 1995-1996 Nick Ing-Simmons. # http://starbase.neosoft.com/%7Eclaird/comp.lang.perl.tk/ptkFAQ.html use Tk; use Tk::Label; use Tk::Button; use Tk::Checkbutton; use Tk::Frame; use Tk::Entry; use Tk::Radiobutton; use Tk::Scale; use Tk::Scrollbar; use Tk::Text; $mw = MainWindow->new(-title=>'REDUCK'); $mw->Label(-text=>'Remove Duplicate Lines by Charlie Kim', )->pack(); $mw->Label(-text=>"Copyright 2002 Charlie Kim GNU General Public License\n")->pack(); # Input # $inputfr = $mw->Frame(-relief=>'groove', -label=>'Input File', -borderwidth=>2, )->pack(-side=>'top', -anchor=>'nw', -fill=>'both', ); $single_e = $inputfr->Entry(-state=>'normal', -textvariable=> \$singlefile, -width=>30, )->pack(-side=>'left', -pady=>3, ); $inputfr->Button(-text=>'Browse', -command=> \&selectsinglefile, -borderwidth=>1, -padx=> 0, -pady=> 0, )->pack(-side=>'left', ); # Run # $mw->Button(-text=>"Remove Duplicate Lines", -command=> \&reduckmain, -state=> 'normal', )->pack(); $mw->Button(-text=>"Exit", -command=> sub { exit }, )->pack(); MainLoop; sub selectsinglefile { my $opentypes = [ "{All files} * ", "{Text files} {.txt} ", ]; my $file = $mw->getOpenFile(-filetypes=>$opentypes); if (defined $file and $file ne '') { $single_e->delete(0, 'end'); $single_e->insert(0, $file); $single_e->xview('end'); } } sub errormsg { my $msg = shift; my $errorwin = $mw->Toplevel(); $errorwin->Label(-text=> $msg, )->pack(); $errorwin->Button(-text=>'Close', -command=> sub { $errorwin->destroy }, )->pack(); $errorwin->waitWindow(); } sub reduckmain { my $infile = $singlefile; open(INFILE,$infile) or die "infile\n"; my $outfile = $mw->getSaveFile(); open(OUTFILE,">$outfile") or die "outfile\n"; my %lines = (); my %linetabs = (); my $counter = 0; while() { chomp; $linetabs{$_} = $counter; $lines{$_} = 1; $counter++; } foreach (sort {$linetabs{$a}<=>$linetabs{$b}} keys %linetabs) { print OUTFILE "$_\n"; } close OUTFILE; $mw->bell(); &errormsg("Processing complete"); }