Глава 1: Введение
1.5. Прогулка по стране Perl
1.5.16. Окончательные варианты программ

Здесь вашему вниманию предлагаются программы, которые мы писали в этой главе, в окончательном виде. Сначала — программа-приветствие:

#!/usr/bin/perl

&init_words() ;

print "what is your name? " ;
$name = <STDIN>;
chomp ($name) ;

if ($name =~ /^randalVb/i) { # обратно на другой путь :-)
  print "Hello, Randal! How good of you to be here!\n";

} else {
  print "Hello, $name! \n"; # обычное приветствие 
  print "What is the secret word? ";
  $guess = <STDIN> ;
  chomp ($guess);

  while (! good_word( $name, $guess)) {
    print "Wrong, try again. What is the secret word? ";
    $guess = <STDIN> ;
    chomp ($guess);
  }
}

dbmopen (%last_good, "lastdb", 0666);
$1ast_good{$name} = time;
dbmclose (%last_good);

sub init_words {

  while ($filename = <*.secret>) { 
    open (WORDSLIST, $filename) || die "can't open $filename: $!";

    if (-M WORDSLIST < 7) {

      while ($name = <WORDSLIST>) {
        chomp ($name);
        $word = <WORDSLIST> ;
        chomp ($word);
        $words {$name} = $word ;
      }

    } else { # rename the file so it gets noticed
      rename ($filename, "$filename.old") || die "can't rename $filename.old: $!";
    }

    close WORDSLIST;
  }
}

sub good_word {

  my($somename,$someguess) = @_; # перечислить параметры
  $somename =~ s/\W.*//; # удалить все символы, стоящие после первого слова
  $somename =~ tr/A-Z/a-z/; # перевести все символы в нижний регистр

  if ($somename eq "randal") { # не нужно угадывать
    return 1; # возвращаемое значение — true

  } elsif (($wordsf$somename( II "groucho") eq $someguess) {
    return 1; # возвращаемое значение — true

  } else {
    open MAIL, "| mail YOUR_ADDRESS_HERE";
    print MAIL "bad news: $somename guessed $someguess\n";
    close MAIL;
    return 0; # возвращаемое значение — false
  }
}

Теперь — листер секретных слов:

#!/usr/bin/perl

while ($filename = <*.secret>) {
  open (WORDSLIST, $filename) || die "can't open $filename: $!";

  if (-M WORDSLIST < 7) {

    while ($name = <WORDSLIST>) {
      chomp ($name) ;
      $word = <WORDSLIST> ;
      chomp ($word) ;
      write; # вызвать format STDOUT в STDOUT
    }
  }
  close (WORDSLIST) ;

  format STDOUT = @<“““““““ @““<““ @““““<“
  $ filename, $name, $word

  format STDOUT_TOP = Page @“$%
  Filename Name Word

И, наконец, программа выдачи времени последнего правильного ввода пароля:

#!/usr/bin/perl
dbmopen (%last good, "lastdb", 0666);
foreach $name (sort keys %last_good) {
  $when = $1ast_good ($name);
  $hours = (time - $when) / 3600; #вычислить истекшее время в часах
  write;
}
format STDOUT =
User @<“““““: last correct guess was @“< hours ago.
$name, $hours
.

Добавьте к этим программам списки секретных слов (файлы с именами что-то.secret, находящиеся в текущем каталоге) и базу данных lastdb.dir и lastdb.pad, и у вас будет все, что нужно.