#!/usr/local/bin/perl5 -- # -*- Perl -*- $VERSION = 1.3; require 5; require 'jcode.pl'; =head1 NAME cookie -- print NetHack fortune cookie message =head1 SYNOPSIS B [B<-f> I] [B<-m> I] [B<-v>] [B<-T>|B<-F>] =head1 DESCRIPTION B picks up a random message from the NetHack fortune cookie database and print it. Printed messages are trusted to the same extent you do to the original game's. =head1 OPTIONS =over 4 =item B<-f> I Uses I as an encrypted fortune database instead of the default one. =item B<-m> I Prints all fortunes which match the given Perl regular expression I. See L for detail. =item B<-v> Prints version information and exits. =item B<-T> B<-F> Prints true(B<-T>)/false(B<-F>) fortunes only. Only the database owner can use these option or simply ignored. Also, neigher of these will work when both of them are specified at the same time. =back =head1 ENVIRONMENT =over 4 =item B Name of the directory where Nethack related files reside, which defaults to F. =item B Name of the encrypted cookie database file, which defaults to F<$HACKDIR/rumors>. =back =head1 SEE ALSO L, L, L. =head1 AUTHOR OZAWA Sakuro The algorithm used for decryption has been stolen from C in Nethack 3.1.3 source archive. =head1 COPYRIGHT Copyright (c) 1995 OZAWA Sakuro. All rights reserved. This program is free software; you can redistribute it and/or modify it under the terms stated in the I. =cut #' use Env; use File::Basename; use Getopt::Std; use subs qw(xcrypt); getopts('f:m:vhTF') or die "$!"; $version_message = <. EOT $usage_message = <; # skip the header $size{true} = hex ; $start{true} = tell; $end{true} = $start{false} = $start{true} + $size{true}; seek COOKIE, 0, 2; $end{false} = tell; ## Header ########################################################### print< RogueLike\@lab3: Fortune Cookie

- Fortune Cookie -

% The cookie has a scrap of paper inside. It reads... %

EofHeader ##################################################################### if ($opt_m) { $start = $start{true}; $end = $end{false}; } else { $which = rand >= 0.5 ? 'true' : 'false'; $start = $start{$which}; $end = $end{$which}; } if (-O $COOKIE) { if ($opt_T and !$opt_F) { $start = $start{true}; $end = $end{true}; } elsif (!$opt_T and $opt_F) { $start = $start{false}; $end = $end{false}; } } seek COOKIE, $end, 0; $sentinel = ; seek COOKIE, $start, 0; $. = 1; if ($opt_m) { while ($_ = and $_ ne $sentinel) { $_ = xcrypt $_; # ---- from here ---- # print if /$opt_m/io; if(/$opt_m/io){ $tsumura = $_; &jcode::convert(*tsumura, 'jis'); print $tsumura; } # ---- to here ---- } } else { rand($.) < 1 and $it = $_ while $_ = and $_ ne $sentinel; # ---- from here ---- # print xcrypt $it; $tsumura = xcrypt $it; &jcode::convert(*tsumura, 'jis'); print $tsumura; # ---- to here ---- } sub xcrypt { my($mask, $buf) = (1, '' x length $_[0]); foreach (split //, $_[0]) { my($ord) = ord; $buf .= $ord & (32|64) ? chr($ord ^ $mask) : $_; $mask = 1 if ($mask <<= 1) >= 32; } $buf; } ## Footer ########################################################### print<

This page is using cookie by Sakuro Ozawa.  Thanks.
[roguelike\@lab3]
roguelike-admin\@lab3.kuis.kyoto-u.ac.jp
EofFooter ##################################################################### __END__