1 : #!/usr/local/bin/perl 2 : 3 : # initialize list to empty 4 : $header = ""; 5 : while ($line = ) { 6 : # remove leading and trailing spaces 7 : $line =~ s/^s+|s+$//g; 8 : @words = split(/s+/, $line); 9 : foreach $word (@words) { 10: # remove closing punctuation, if any 11: $word =~ s/[.,;:-]$//; 12: # convert all words to lower case 13: $word =~ tr/A-Z/a-z/; 14: &add_word_to_list($word); 15: } 16: } 17: &print_list; 18: 19: sub add_word_to_list { 20: local($word) = @_; 21: local($pointer); 22: 23: # if list is empty, add first item 24: if ($header eq "") { 25: $header = $word; 26: $wordlist{$word} = ""; 27: return; 28: } 29: # if word identical to first element in list, 30: # do nothing 31: return if ($header eq $word); 32: # see whether word should be the new 33: # first word in the list 34: if ($header gt $word) { 35: $wordlist{$word} = $header; 36: $header = $word; 37: return; 38: } 39: # find place where word belongs 40: $pointer = $header; 41: while ($wordlist{$pointer} ne "" && 42: $wordlist{$pointer} lt $word) { 43: $pointer = $wordlist{$pointer}; 44: } 45: # if word already seen, do nothing 46: return if ($word eq $wordlist{$pointer}); 47: $wordlist{$word} = $wordlist{$pointer}; 48: $wordlist{$pointer} = $word; 49: } 50: 51: sub print_list { 52: local ($pointer); 53: print ("Words in this file:n"); 54: $pointer = $header; 55: while ($pointer ne "") { 56: print ("$pointern"); 57: $pointer = $wordlist{$pointer}; 58: } 59: }
运行结果如下:
Here are some words. Here are more words. Here are still more words. ^D Words in this file: are here more some still words