adding deletion of surveys to remove ou scripts
[migration-tools.git] / match_fingerprints
index 4300429..4c77480 100755 (executable)
@@ -1,4 +1,22 @@
 #!/usr/bin/perl
+
+# Copyright 2009-2012, Equinox Software, Inc.
+#
+# 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., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+
+
 use strict;
 use warnings;
 use open ':utf8';
@@ -14,6 +32,8 @@ my @recs = (); # fingerprints belonging to each record
 my %seen = (); # records we've already seen
 my $lastscore = 0; # previous fingerprint's score
 
+my %subs  = (); # error-checking hashe
+
 open FP, '<', $ARGV[0] or die "Can't open input file: $!\n";
 
 print "Loading and ranking fingerprints\n";
@@ -85,8 +105,19 @@ sub dump_records {
     open OUT, '>', $conf->{output}
       or die "Can't open ", $conf->{output}, "$!\n";
     for my $rec (@recs) {
-        print OUT $rec->{id}, "\t$_\n"
-          for ( @{ $fps{ $rec->{sha1} } } );
+        for ( @{ $fps{ $rec->{sha1} } } ) {
+            # check for dupes and die if they exist
+            die "Collision: dupe sub record $_\n" if $subs{$_};
+            $subs{$_} = 1;
+            die "Collision: lead in sub list ", $rec->{id}, "\n"
+              if $subs{ $rec->{id} };
+
+            # we don't want subs below threshold
+            next if ($_ < $conf->{threshold});
+
+            # still here? output.
+            print OUT $rec->{id}, "\t$_\n"
+        }
     }
 }
 
@@ -99,6 +130,7 @@ sub initialize {
 
     my $rc = GetOptions( $c,
                          'output|o=s',
+                         'threshold|t=i',
                          'help|h',
                        );
     show_help() unless $rc;
@@ -112,11 +144,13 @@ sub initialize {
         print "Required option: ", join(', ', @missing), " missing!\n";
         show_help();
     }
+
+    $c->{threshold} = 0 unless $c->{threshold};
 }
 
 sub show_help {
     print <<HELP;
-Usage is: compress_fingerprints -o OUTPUTFILE INPUTFILE
+Usage is: compress_fingerprints [-t THRESHOLD] -o OUTPUTFILE INPUTFILE
 HELP
 exit;
 }