#!/usr/bin/perl -w # # Copyright (c) 2002-2003 Erik Oliver # # $Id: unique.cgi,v 1.7 2003/08/12 00:25:43 erik Exp $ # # Permission is hereby granted, free of charge, to any person # obtaining a copy of this software and associated documentation # files (the "Software"), to deal in the Software without # restriction, including without limitation the rights to use, copy, # modify, merge, publish, distribute, sublicense, and/or sell copies # of the Software, and to permit persons to whom the Software is # furnished to do so, subject to the following conditions: # # The above copyright notice and this permission notice shall be # included in all copies or substantial portions of the Software. # # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, # EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF # MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND # NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT # HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, # WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, # OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER # DEALINGS IN THE SOFTWARE. use strict; use vars qw/$q/; use CGI; use CGI::Carp qw(fatalsToBrowser); $q = new CGI; print $q->header(); print q| Sort-Unique Filter
Erik's Web Web Based Patent Polishing Tools Sort-Unique Filter
|; if ($q->param('polish') && $q->param('polish') ne "") { &doPolish(); } else { &printForm(); } print q|

This program is made available 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.

$Id: unique.cgi,v 1.7 2003/08/12 00:25:43 erik Exp $

|; # # # end of main flow sub printForm() { print $q->start_form(),"\n"; print "
\n"; print "\n"; print "

Paste data into box below

\n"; print $q->textarea(-name=>'polish',-rows=>10,-columns=>60); print "
\n"; print $q->submit(-label=>'Sort-Unique'); print "
"; print "
\n"; print $q->end_form(); } sub doPolish() { my $contents = $q->param('polish'); # some simple cleanups $contents =~ s/\r\n/\n/g; $contents =~ s/\r/ /g; $contents =~ s/\t/ /g; $contents =~ s/\013/\n/g; # vertical tab/^k used by FMPro print "

Output Results for Sort-Unique

\n"; my @contents = split "\n", $contents; my %counts; foreach (@contents) { next if($_ eq ""); if(exists($counts{$_})) { $counts{$_} += 1; } else { $counts{$_} = 1; } } #my @keys = sort {$counts{$a} <=> $counts{$b}} keys %counts; my @keys = sort keys %counts; print "\n"; foreach (@keys) { print "\n"; } print "
$counts{$_}$_
\n"; }