[SPOILER] Regular Quiz #8

Corrected a bad blunder, I had a working version & then changed

    tr/'.//d;

to

    $allowed_punctuation = q('.);
    ...
    tr/$allowed_punctuation//d

without checking the results;( (or reading the manual)

changed a /^[a-z]/ to /^[:lower:]] to be locale sensitive.

changed sub substrings to remove duplicates from the list of substrings.


#!/bin/perl

use strict;
use warnings;

my %entries;

my $file = shift or die "Usage: $0 <file of words>\n";
process_words($file);
write_QandA();
exit;

sub process_words {
    my $input = shift;
    open INPUT, $input or die "Can't open $input: $!\n";
    foreach my $word (<INPUT>) {
        foreach my $substring ( substrings($word) ) {
            $entries{$substring} =
              ( exists $entries{$substring} ) ? "" : $word;
        }
    }
    close INPUT;
}

sub substrings {
    my $substring_length   = 4;
    my $string             = lc shift;
    $string =~ tr/'.//d;
    my %substrings =
      map { $_ => "" }
      grep { not /[^[:lower:]]/ }
      map { substr $string, $_, $substring_length }
      0 .. length($string) - $substring_length;
    return keys %substrings;
}

sub write_QandA {
    my $Qfile = "questions";
    my $Afile = "answers";
    open QUESTIONS, ">$Qfile" or die "Can't open $Qfile:$!\n";
    open ANSWERS,   ">$Afile"   or die "Can't open $Afile:$!\n";
    foreach my $substring ( sort keys %entries ) {
        unless ( $entries{$substring} eq "" ) {
            print QUESTIONS "$substring\n";
            print ANSWERS $entries{$substring};
        }
    }
    close ANSWERS;
    close QUESTIONS;
}

InterScan_Disclaimer.txt
Description: Text document