#!/usr/local/bin/perl5	 -- # -*- Perl -*-

$VERSION = 1.3;
require 5;
require 'jcode.pl';

=head1 NAME

cookie -- print NetHack fortune cookie message

=head1 SYNOPSIS

B<cookie> [B<-f> I<file>] [B<-m> I<pattern>] [B<-v>] [B<-T>|B<-F>]

=head1 DESCRIPTION

B<cookie> 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<file>

Uses I<file> as an encrypted fortune database instead of the default
one.

=item B<-m> I<pattern>

Prints all fortunes which match the given Perl regular expression
I<pattern>.  See L<perlre(1)> 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<HACKDIR>

Name of the directory where Nethack related files reside, which defaults to
F</usr/games/lib/nethackdir>.

=item B<COOKIE>

Name of the encrypted cookie database file, which defaults to
F<$HACKDIR/rumors>.

=back

=head1 SEE ALSO

L<perlre(1)>, L<nethack(6)>, L<fortune(6)>.

=head1 AUTHOR

OZAWA Sakuro <mailto:ozawa@prince.pe.u-tokyo.ac.jp>

The algorithm used for decryption has been stolen from C<hacklib.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<NETHACK GENERAL PUBLIC LICENSE>.

=cut

#'

use Env;
use File::Basename;
use Getopt::Std;
use subs qw(xcrypt);

getopts('f:m:vhTF') or die "$!";

$version_message = <<EOT;
NetHack fortune cookie teller, version $VERSION
Copyright 1995, OZAWA Sakuro <mailto:ozawa\@prince.pe.u-tokyo.ac.jp>.
EOT

$usage_message = <<EOT;
Usage: ${\basename $0} [-f file] [-m pattern] [-v] [-T|-F]
EOT

if ($opt_v or @ARGV) {
    die $version_message;
} elsif ($opt_h) {
    die $usage_message;
}

$HACKDIR = '/usr/local/pkgs/Games/nethack-3.2.2/lib' unless $HACKDIR;
$COOKIE = $opt_f || "$HACKDIR/rumors" unless $COOKIE;
open COOKIE or die "$COOKIE: $!";

srand(time % $$);

<COOKIE>; # skip the header
$size{true} = hex <COOKIE>;
$start{true} = tell;
$end{true} = $start{false} = $start{true} + $size{true};
seek COOKIE, 0, 2;
$end{false} = tell;


## Header ###########################################################
print<<EofHeader;
Content-Type: text/html

<HTML><HEAD>
<TITLE>RogueLike\@lab3: Fortune Cookie</TITLE>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">
</HEAD>

<BODY text = "#FFFFFF" link = "#00EEEE" vlink = "#00BBBB" bgcolor = "#000000">
<H2><div align=center>
<font color="#98fb98">- Fortune Cookie -</font></div>
<p><HR><div align=center><font color="#f0e68c">
<img src="/misc/roguelike/pic/pixmap/cookie.gif" alt="%">
The cookie has a scrap of paper inside. It reads...
<img src="/misc/roguelike/pic/pixmap/cookie.gif" alt="%">
</font></div><HR><p align=center>
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 = <COOKIE>;
seek COOKIE, $start, 0;
$. = 1;

if ($opt_m) {
    while ($_ = <COOKIE> 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 $_ = <COOKIE> 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<<EofFooter;
</p></h2><hr>
<em>This page is using <a
href="http://www.shiojiri.ne.jp/~crouton/nethack/cookie">cookie</a>
by <a href="http://www.shiojiri.ne.jp/~crouton/nethack/">Sakuro Ozawa</a>.
&nbsp;Thanks.
</em>
<hr><a href="/misc/roguelike/"><img src="/misc/roguelike/pic/defbanner.gif"
align=right alt="[roguelike\@lab3]" border=0></a>
<ADDRESS>
roguelike-admin<font color="#98fb98">\@</font>lab3.kuis.kyoto-u.ac.jp
</ADDRESS>
</BODY></HTML>
EofFooter
#####################################################################


__END__
