Index: /main/trunk/model-sites-dev/von-sparql/collect/nz-natlib-cat/pre-import/HUNT-FOR-NON-ASCII.pl
===================================================================
--- /main/trunk/model-sites-dev/von-sparql/collect/nz-natlib-cat/pre-import/HUNT-FOR-NON-ASCII.pl	(revision 36291)
+++ /main/trunk/model-sites-dev/von-sparql/collect/nz-natlib-cat/pre-import/HUNT-FOR-NON-ASCII.pl	(revision 36291)
@@ -0,0 +1,225 @@
+use strict;
+
+use Encode qw(decode encode);
+
+binmode STDERR, ":encoding(utf8)";
+binmode STDOUT, ":encoding(utf8)";
+
+my $DEBUG = 0;
+
+sub debug_unicode_string
+{
+    join("",
+         map { $_ > 127 ?                      # if wide character...
+                   sprintf("\\x{%04X}", $_) :  # \x{...}
+                   chr($_)          
+               } unpack("U*", $_[0]));         # unpack Unicode characters
+}
+
+
+sub debug_unicode_string_bytes
+{
+    join("",
+         map { $_ > 127 ?                      # if wide character...
+                   sprintf("\\u{%02X}", $_) :  # \x{...}
+                   chr($_)          
+               } unpack("U*", $_[0]));         # unpack Unicode characters
+}
+
+
+# Returns true (1) if the given string is utf8 and false (0) if it isn't.
+# Does not modify the string parameter.
+sub check_is_utf8 {
+    my $value=shift;
+
+    if (!defined($value)) {
+	return 0; # not utf8 because it is undefined
+    }
+
+    $value =~ m/^/g; # to set \G
+    while ($value =~ m!\G.*?([\x80-\xff]+)!sg) {
+	my $highbytes=$1;
+	# make sure this block of high bytes is utf-8
+	$highbytes =~ /^/g; # set pos()
+	while ($highbytes =~
+		m!\G (?: [\xc0-\xdf][\x80-\xbf]   | # 2 byte utf-8
+			[\xe0-\xef][\x80-\xbf]{2} | # 3 byte
+			[\xf0-\xf7][\x80-\xbf]{3} | # 4 byte
+			[\xf8-\xfb][\x80-\xbf]{4} | # 5 byte
+			[\xfc-\xfd][\x80-\xbf]{5} | # 6 byte
+			)*([\x80-\xff])? !xg
+		) {
+	    my $badbyte=$1;
+	    if (defined $badbyte) { # not end of string
+		return 0; # non-utf8 found
+	    } 
+	}
+    }
+    
+    return 1;
+}
+
+
+sub unescapeEntities
+{
+    my ($line) = @_;
+    
+    # unescape reserved entities
+    $line =~ s/&apos;/'/g;
+    $line =~ s/&quot;/"/g;
+    $line =~ s/&lt;/</g;
+    $line =~ s/&gt;/>/g;
+    $line =~ s/&amp;/&/g;
+
+    return $line;
+}
+
+
+sub getTagPairs
+{
+    my ($line,$opt_filter) = @_;
+
+    my @filtered_tag_pairs = ();
+    
+    my @tag_pairs = split(/(<[^>]*>)/,$line);
+    shift @tag_pairs; # given the split RE, there's always an empty-string first match
+
+    my $tag_pairs_len = scalar(@tag_pairs);
+    
+    for (my $i=0; $i<$tag_pairs_len; $i+=2) {
+	my $tag = $tag_pairs[$i];
+	my $inner_text = $tag_pairs[$i+1];
+	$inner_text = "" if $inner_text eq "\n";
+
+	if (!defined $opt_filter) {
+	    push(@filtered_tag_pairs,$tag,$inner_text);
+	}
+	elsif ($tag =~ m/^<$opt_filter/i) {
+	    push(@filtered_tag_pairs,$tag,$inner_text);
+	}	
+    }
+    
+    
+    return \@filtered_tag_pairs;
+}
+
+sub getInnerTextFromTags
+{
+    my ($line,$opt_filter) = @_;
+
+    my @inner_text_vals = ();
+    
+    my $filtered_tag_pairs = getTagPairs($line,$opt_filter);
+        
+    my $filtered_tag_pairs_len = scalar(@$filtered_tag_pairs);
+
+    for (my $i=0; $i<$filtered_tag_pairs_len; $i+=2) {
+	my $tag = $filtered_tag_pairs->[$i];
+	my $inner_text = $filtered_tag_pairs->[$i+1];
+	
+	if ($inner_text ne "") {
+	    my $inner_text_unescaped = unescapeEntities($inner_text);
+	    
+	    push(@inner_text_vals,$inner_text_unescaped);
+	}	
+    }
+
+    my $inner_text_vals_len = scalar(@inner_text_vals);
+
+    if ($DEBUG) {
+	if ($inner_text_vals_len > 0) {
+	    print "Filtered tags, innner text: [\n";
+	    map {print "    $_\n"} @inner_text_vals;
+	    print "]\n";
+	}
+    }
+    
+    return \@inner_text_vals;
+}
+
+sub processInnerTextVals
+{
+    my ($inner_text_vals,$line_num) = @_;
+
+    for my $line (@{$inner_text_vals}) {
+	
+	my $is_utf8 = check_is_utf8($line);
+	if ($is_utf8) {
+	    # if ($line =~ m/[^[:ascii:]]/) {
+	
+	    # from_to($line, "iso-8859-1", "UTF-8");   #1 -- does not turn on unicode-aware flag
+	    # my $line_utf8 = decode("iso-8859-1", $line);  #2 -- does turn on unicode-aware flag
+	
+	    my $line_utf8 = decode("utf8", $line);  #2 -- does turn on unicode-aware flag
+	    
+	    if ($line =~ m/[^\x{00}-\x{7F}]/) {
+		print "$line_num:\tUses Non-ASCII chars:\t$line_utf8\n";
+		print "            UTF8 Bytes > 127:\t", debug_unicode_string_bytes($line), "\n";
+		print "    Unicode codepoints > 127:\t", debug_unicode_string($line_utf8), "\n";
+		print "-" x 20, "\n";
+	    }
+	}
+	else {
+	    # my $line_utf8 = decode("utf8", $line);  # decode() turns on unicode-aware flag
+	    
+	    print "$line_num:\tNOT VALID UTF8\n";
+	    print "            UTF8 Bytes > 127:\t", debug_unicode_string_bytes($line), "\n";
+	    print "           As Latin1 mapping:\t$line", "\n";
+	    print "-" x 20, "\n";
+	}
+    }
+
+}
+
+sub processLine
+{
+    my ($line_num,$line) = @_;
+
+    my $inner_text_vals = getInnerTextFromTags($line,"subfield|marc:subfield");
+
+    processInnerTextVals($inner_text_vals,$line_num);
+    
+#    # strip out tags
+#    $line =~ s/<[^>]*>/ /g;
+        
+#    # unescape reserved entities
+#    $line = unescapeEntities($line);
+    
+}
+
+sub processFile
+{
+    my ($filename) = @_;
+    
+
+    my $line_num = 0;
+    
+    #if (open FILE, '<:encoding(utf8)', $filename) {
+    # Explicitly forcing to Latin1 causes the text file to be read in a 1 byte per char
+    if (open FILE, "< :encoding(Latin1)", $filename) {
+	#if (open FILE, $filename) {
+	while(<FILE>) {
+	    my $line .= $_;
+	    $line_num++;
+	    
+	    processLine($line_num,$line)
+	}
+	close FILE;
+    }
+    else {
+	print STDERR "Failed to open '$filename'\n";
+	print $!;
+    }
+}
+
+my $filename = $ARGV[0];
+
+
+processFile($filename);
+
+
+#perl -ne 'print if /[^[:ascii:]]/' $*
+    
+#<subfield code="a">Ren
+
+#    <subfield code="a">Ren
