Fortune-0.2/ 40755 764 144 0 7056105751 11236 5ustar gregusersFortune-0.2/t/ 40755 764 144 0 7056105751 11501 5ustar gregusersFortune-0.2/t/read.t100444 764 144 1643 6663602576 12712 0ustar gregusersuse Fortune; # # Test the reading capabilities of the Fortune module. # # $Id: read.t,v 1.1 1999/02/20 18:56:59 greg Exp $ # my $i = 0; sub test { my $ok = shift; print (($ok ? 'ok ' : 'not ok ') . (++$i) . "\n"); } print "1..13\n"; test (my $ff = new Fortune ('t/test')); $ff->read_header (); test ($ff->{'numstr'} == 3 && $ff->num_fortunes() == 3); test ($ff->{'max_length'} == 54 && $ff->{'min_length'} == 13); test ($ff->{'delim'} eq '%'); @fortunes = ("This is\na test\nfortune file.\n", "Must have single-line as well as multi-line fortunes.\n", "And goodbye!\n"); test ($ff->read_fortune (0) eq $fortunes[0]); test ($ff->read_fortune (1) eq $fortunes[1]); test ($ff->read_fortune (2) eq $fortunes[2]); eval { $ff->read_fortune (3) }; test (defined $@ && $@ =~ /invalid fortune number/); for $i (1 .. 5) { $f = $ff->get_random_fortune (); test (grep ($_ eq $f, @fortunes) == 1); } Fortune-0.2/t/test100444 764 144 144 6663577356 12476 0ustar gregusersThis is a test fortune file. % Must have single-line as well as multi-line fortunes. % And goodbye! Fortune-0.2/t/test2100444 764 144 627 7056040054 12537 0ustar gregusersEschew Obfuscation ** Time flies like an arrow; Fruit flies like a banana. ** A closed mouth gathers no foot. ** Time heals all wounds--if you don't keep picking off the scab. --Holly Ward ** Death lasts even longer than grade school and high school put together. --Matt Groening ** A ship carrying two tons of red paint and a ship carrying one ton of blue paint collide. All the passengers are marooned. Fortune-0.2/t/test.dat100644 764 144 50 6663577367 13225 0ustar gregusers6 %WdFortune-0.2/t/readnohdr.t100444 764 144 2647 7056105316 13735 0ustar gregusersuse Fortune; # # Test the reading capabilities of the Fortune module in the # absence of a header (.dat) file. # # $Id: readnohdr.t,v 1.3 2000/02/27 02:23:04 greg Exp $ # my $i = 0; sub test { my $ok = shift; print (($ok ? 'ok ' : 'not ok ') . (++$i) . "\n"); } print "1..14\n"; test (my $ff = new Fortune ('t/test2')); $ff->compute_header ('**'); test ($ff->{'numstr'} == 6 && $ff->num_fortunes() == 6); test ($ff->{'max_length'} == 123 && $ff->{'min_length'} == 19); test ($ff->{'delim'} eq '**'); @fortunes = ("Eschew Obfuscation\n", "Time flies like an arrow; Fruit flies like a banana.\n", "A closed mouth gathers no foot.\n", "Time heals all wounds--if you don't keep picking off the scab.\n--Holly Ward\n", "Death lasts even longer than grade school and high school put\ntogether. --Matt Groening\n", "A ship carrying two tons of red paint and a ship carrying one ton\nof blue paint collide. All the passengers are marooned.\n"); @lengths = sort {$a <=> $b} (map (length, @fortunes)); test ($ff->{'max_length'} == $lengths[-1] && $ff->{'min_length'} == $lengths[0]); test ($ff->read_fortune (0) eq $fortunes[0]); test ($ff->read_fortune (1) eq $fortunes[1]); test ($ff->read_fortune (5) eq $fortunes[5]); eval { $ff->read_fortune (6) }; test (defined $@ && $@ =~ /invalid fortune number/); for $i (1 .. 5) { $f = $ff->get_random_fortune (); test (grep ($_ eq $f, @fortunes) == 1); } Fortune-0.2/Makefile.PL100444 764 144 342 6663602455 13270 0ustar gregusers# $Id: Makefile.PL,v 1.1 1999/02/20 18:53:06 greg Exp $ use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'Fortune', 'VERSION_FROM' => 'Fortune.pm', 'dist' => { COMPRESS => "gzip", SUFFIX => "gz" }, ); Fortune-0.2/README100444 764 144 2315 7056105675 12217 0ustar gregusers Fortune.pm version 0.2 26 February 2000 Greg Ward Copyright (c) 1999-2000 Gregory P. Ward. All rights reserved. This is free software; you can redistribute it and/or modify it under the same terms as Perl itself. This module provides an interface to fortune cookie databases, as implemented by the fortune-mod-9708 distribution (which is widely used in the Linux world, and available with at least the Red Hat and Debian distributions). Currently, it is a read-only interface. If I ever need to a read-write interface, I suppose I'll write one; if *you* need one, feel free to write it and send me a patch! AVAILABILITY ------------ The latest version of this module will be available at: http://starship.python.net/~gward/perl/ If you need a full-blown fortune package, try fortune-mod, which should be available at: http://www.progsoc.uts.edu.au/~dbugger/hacks/hacks.html CREDITS ------- Thanks to Bill Ward for adding the code that allows reading a fortune file that doesn't have a header (index) file. $Id: README,v 1.2 2000/02/27 02:28:13 greg Exp $ Fortune-0.2/Fortune.pm100444 764 144 26700 7056105362 13334 0ustar gregusers# # Fortune.pm # # interface to fortune cookie databases # # by Greg Ward, 1999/02/20 # # $Id: Fortune.pm,v 1.4 2000/02/27 02:22:31 greg Exp $ # package Fortune; require 5.004; use strict; use Carp; use IO::File; $Fortune::VERSION = '0.2'; =head1 NAME Fortune - read and write fortune (strfile) databases =head1 SYNOPSIS # input $ffile = new Fortune ($base_filename); $ffile->read_header (); $num_fortunes = $ffile->num_fortunes (); $fortune = $ffile->read_fortune ($num); $fortune = $ffile->get_random_fortune (); # create header file from data file -- NOT IMPLEMENTED YET $ffile = new Fortune ($base_filename); $ffile->write_header (); # write to data file -- NOT IMPLEMENTED YET $ffile = new Fortune (">>$base_filename"); $ffile->write_fortune ($fortune); =head1 DESCRIPTION The C program is a small but important part of the Unix culture, and this module aims to provide support for its "fortune cookie" databases to Perl programmers. For efficiency, all versions of C rely on a binary header consisting mainly of offsets into the fortune file proper. Modern versions of fortune keep this header in a separate file, and this is the style adopted by the C module; the older style of munging the header and data into one large "compiled" file is not (currently) supported. Using the C module makes it trivial to write a simplified version of the C program: # trivial 'fortune' progam my $fortune_filename = $ARGV[0]; my $fortune_file = new Fortune ($fortune_filename); $fortune_file->read_header (); my $fortune = $fortune_file->get_random_fortune (); print $fortune; This can be compressed considerably: print new Fortune ($ARGV[0])->read_header()->get_random_fortune(); Of course, this doesn't provide all of C's interesting features, such as parallel databases of offensive fortunes, selection of long or short fortunes, dealing with multiple fortune files, etc. If you want C, use it -- but if you just want a simple Perl interface to its data files, the C module is for you. Currently, the C module does not support writing fortune databases. If it did, writing a simplified C (the program that processes a fortune database to create the header file) would also be trivial: # trivial (and hypothetical) 'strfile' program my $fortune_filename = @ARGV[0]; my $fortune_file = new Fortune ($fortune_filename); $fortune_file->write_header (); Note that the header filename is assumed to be just the name of the main fortune database, with C<".dat"> appended. You can supply an alternate header filename to the constructor, C, if you wish. =head1 METHODS =head2 Initialization/cleanup =over 4 =item new (FILE [, HEADER_FILE]) Opens a fortune cookie database. FILE is the name of the data file to open, and HEADER_FILE (if given) the name of the header file that contains (or will contain) meta-data about the fortune database. If HEADER_FILE is not given, it defaults to FILE with C<".dat"> appended. The data file is opened via C, which Cs if the file cannot be opened. The header file is I opened, whether you supply its filename or not -- after all, it might not exist yet. Rather, you must explicitly call C or C as appropriate. =cut sub new { my ($class, $filename, $header_filename) = @_; $class = ref $class || $class; my $self = bless { filename => $filename, header_filename => $header_filename || $filename . ".dat", }, $class; $self->open_file (); return $self; } sub DESTROY { my $self = shift; $self->close_file (); } =item open_file () Opens the fortune file whose name was supplied to the constructor. Dies on failure. =cut sub open_file { my $self = shift; my $file = new IO::File $self->{'filename'} or die "unable to open $self->{'filename'}: $!\n"; $self->{'file'} = $file; } =item close_file () Closes the fortune file if it's open; does nothing otherwise. =cut sub close_file { my $self = shift; $self->{'file'}->close () if defined $self->{'file'}; } =back =head2 Header functions (read and write) =over 4 =item read_header () Reads the header file associated with this fortune database. The name of the header file is determined by the constructor C: either it is based on the name of the data file, or supplied by the caller. If the header file does not exist, this function calls C automatically, which has the same effect as reading the header from a file. The header contains the following values, which are stored as attributes of the C object: =over 4 =item C version number =item C number of strings (fortunes) in the file =item C length of longest string in the file =item C length of shortest string in the file =item C bit field for flags (see strfile(1) man page) =item C character that delimits fortunes =back C is available via the C method; if you're interested in the others, you'll have to go grubbing through the C object, e.g.: $fortune_file = new Fortune ('fortunes'); $fortune_file->read_header (); $delim = $fortune_file->{'delim'}; C Cs if there are any problems reading the header file, e.g. if it seems to be corrupt or truncated. C returns the current C object, to allow for sneaky one-liners (see the examples above). =cut sub read_header { my ($self) = @_; my $filename = $self->{'header_filename'}; if (! -f $filename && -f $self->{'filename'}) { return $self->compute_header(); } my $hdr_file = new IO::File $filename or die "couldn't open $filename: $!\n|"; binmode ($hdr_file); # from the strfile(1) man page: # unsigned long str_version; /* version number */ # unsigned long str_numstr; /* # of strings in the file */ # unsigned long str_longlen; /* length of longest string */ # unsigned long str_shortlen; /* shortest string length */ # unsigned long str_flags; /* bit field for flags */ # char str_delim; /* delimiting character */ # that 'char' is padded out to a full word, so the header is 24 bytes my $header; read ($hdr_file, $header, 24) == 24 or die "failed to read full header\n"; @{$self}{qw(version numstr max_length min_length flags delim)} = unpack ("NNNNNaxxx", $header); my $expected_offsets = $self->{'numstr'} + 1; my $amount_data = 4 * $expected_offsets; my $data; read ($hdr_file, $data, $amount_data) == $amount_data or die "failed to read offsets for all fortunes\n"; my @offsets = unpack ("N*", $data); die sprintf ("found %d offsets (expected %d)\n", scalar @offsets, $expected_offsets) unless @offsets == $expected_offsets; $self->{'offsets'} = \@offsets; close ($hdr_file); return $self; } # read_header =item compute_header ([DELIM]) Reads the contents of the fortune file and computes the header information that would normally be found in a header (F<.dat>) file. This is useful if you maintain a file of fortunes by hand and do not have the corresponding data file. An optional delimiter argument may be passed to this function; if present, that delimiter will be used to separate entries in the fortune file. If not provided, the existing C attribute of the Fortune object will be used. If that is not defined, then a percent sign ("%") will be used. =cut sub compute_header { my ($self, $delim) = @_; $delim = $self->{'delim'} || '%' unless defined $delim; local $/ = $delim . "\n"; # read whole fortunes my $filename = $self->{'filename'}; my $file = new IO::File $filename or die "couldn't open $filename: $!\n"; my @offsets = (0); # start with offset of first fortune my $fortune = ''; my($min, $max); while (defined ($fortune = <$file>)) { chomp $fortune; my $len = length $fortune; if (!defined $min || $len < $min) { $min = $len } elsif (!defined $max || $len > $max) { $max = $len } push (@offsets, tell $file); } $self->{'version'} = 1; $self->{'numstr'} = $#offsets; $self->{'max_length'} = $max; $self->{'min_length'} = $min; $self->{'flags'} = 0; $self->{'delim'} = $delim; $self->{'offsets'} = \@offsets; } =item num_fortunes () Returns the number of fortunes found by C. =cut sub num_fortunes { my $self = shift; croak "header not read" unless defined $self->{'numstr'}; return $self->{'numstr'}; } =item write_header ([DELIM]) is not yet implemented. =cut =back =head2 Fortune input =over 4 =item get_fortune (NUM) Reads string number NUM from the open fortune file. NUM is zero-based, ie. it must be between 0 and C (inclusive). Cs if you haven't opened the file and read the header, or if NUM is out of range. (Opening the file is pretty hard to screw up, since it's taken care of for you by the constructor, but you have to read the header explicitly with C.) Returns the text of the fortune as a (possibly) multiline string. =cut sub read_fortune { my ($self, $num) = @_; croak "fortune file not open" unless defined $self->{'file'} and defined fileno ($self->{'file'}); croak "header file not read" unless defined $self->{'numstr'}; croak "invalid fortune number (max " . ($self->{'numstr'}-1) . ")" unless $num < $self->{'numstr'} && $num >= 0; my $start = $self->{'offsets'}[$num]; my $end = $self->{'offsets'}[$num+1]; my $length = $end - $start; # decrement length 2 bytes for most fortunes (to drop trailing "%\n"), # and none for the last one (keep trailing newline) my $delimlength = length $self->{'delim'} || 1; $length -= ($num == $self->{'numstr'}-1) ? 0 : ($delimlength+1); my $file = $self->{'file'}; my $fortune; seek ($file, $start, 0); read ($file, $fortune, $length) == $length or die "unable to read entire fortune\n"; return $fortune; } # get_fortune =item get_random_fortune () Picks a random fortune for you and reads it with C. =cut sub get_random_fortune { my ($self) = @_; croak "header file not read" unless defined $self->{'numstr'}; my $num = int (rand $self->{'numstr'}); return $self->read_fortune ($num); } =back =head2 Fortune output =over 4 =item write_fortune (FORTUNE) is not yet implemented. =back =cut 1; =head1 AUTHOR AND COPYRIGHT Written by Greg Ward Egward@python.netE, 20 February 1999. Copyright (c) 1999-2000 Gregory P. Ward. All rights reserved. This is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AVAILABILITY You can download the C module from my web page: http://starship.python.net/~gward/perl/ and it can also be found on CPAN. If you are using an operating system lacking a sufficient sense of humour to include C as part of its standard installation (most commercial Unices seem to be so afflicted), the Linux world has a solution: the C distribution. The latest version as of this writing is C, and the README file says you can find it at http://www.progsoc.uts.edu.au/~dbugger/hacks/hacks.html This is the C implementation on which the C module is based. Fortune-0.2/dump_header100555 764 144 1440 6663602523 13535 0ustar gregusers#!/usr/bin/perl -w # # dump_header # # Quick hack to satisfy my curiosity about the header files # generated by strfile and used by fortune. (The Fortune # module is essentially a puffed-up, glorified version # of this, with the added ability to read actual fortune # files based on the offsets from the header file.) # # by Greg Ward, 1999/02/20 # # $Id: dump_header,v 1.1 1999/02/20 18:56:04 greg Exp $ # die "usage: dump_header header_file\n" unless @ARGV == 1; open (D, $ARGV[0]) || die "couldn't open $ARGV[0]: $!\n"; undef $/; $d = ; @d = unpack ("NNNNNaxxxN*", $d); print <