############################################################
#
# stuff_funcs.pl
#
# Functions which do not produce any HTML
#
############################################################

#require "date_calc.pl";
require "uber/uber_date.pl";

@monthList = (
    "January",
    "February",
    "March",
    "April",
    "May",
    "June",
    "July",
    "August",
    "September",
    "October",
    "November",
    "December",
    "INVALID_MONTH"
);

@dayList = (
    "Sunday",
    "Monday",
    "Tuesday",
    "Wednesday",
    "Thursday",
    "Friday",
    "Saturday",
    "INVALID_DAY"
);

@feelings = ("hates",
             "likes",
             "loves",
             "adores",
             "worships",
             "idolises",
             "sucks off",
             "would die for",
             "matches");    

@prospects = (
              "Abysmal",
              "Dreadful",
              "Terrible",
              "Appalling",
              "Awful",
              "Depressing",
              "Dire",
              "Grim",
              "Crap",
              "Really Bad",
              "Poor",
              "Dodgy",
              "A Bit Iffy",
              "So So",
              "Mediocre",
              "Moderate",
              "Alright",
              "Reasonable",
              "Satisfactory",
              "OK",
              "Fairly Good",
              "Sound",
              "Not Bad",
              "Quite Good",
              "Fair",
              "Encouraging",
              "Promising",
              "Fine",
              "Good",
              "Beneficial",
              "Favourable",
              "Grand",
              "Very Good",
              "Rosy",
              "Great",
              "Bright",
              "Super",
              "Smashing",
              "Marvellous",
              "Prosperous",
              "Remarkable",
              "Splendid",
              "Excellent",
              "Wonderful",
              "Fabulous",
              "Terrific",
              "Brilliant",
              "Incredible",
              "Amazing",
              "Superb",
              "Magnificent",
              "Astounding",
              "Astonishing",
              "Outstanding",
              "Extraordinary",
              "Wondrous",
              "Stupendous",
              "Sensational",
              "Fantastic",
              "Miraculous",
              "Spectacular",
              "Awesome",
              "Phenomenal!");

## old prospects:
## Grisly

## new prospects:
## Frightful
## Shocking
## Miserable
## Gruesome
## Horrible
## Depressing
## Shit
## Bollocks

@maleRatings = (
  "Jamie Oliver",
  "Cunt",
  "Motherfucker",
  "Sheepshagger",
  "Cocksucker",
  "Bollockbrain",
  "Tosser",
  "Dildo",
  "Wanker",
  "Arsehole",
  "Shithead",
  "Wankstain",
  "Toilet Trader",
  "Loser",
  "Gonad",
  "Jam Rag",
  "Big Girl's Blouse",
  "Lizard",
  "Small Beer",
  "Dood",
  "Regular Guy",
  "Scholar",
  "Bloke",
  "Geezer",
  "Fellow",
  "Contender",
  "Player",
  "Diamond Geezer",
  "Boss",
  "High Flyer",
  "Stallion",
  "Stud",
  "Master",
  "Winner",
  "Victor",
  "Conquerer",
  "Cool Cat",
  "Hoopy",
  "Frood",
  "Top Dog"
);

@femaleRatings = (
  "Lorraine Kelly",
  "Whore",
  "Slag",
  "Slapper",
  "Hag",
  "Crone",
  "Bag",
  "Witch",
  "Bint",
  "Mare",
  "Mollusc",
  "Seamstress",
  "Tea Lady",
  "Wench",
  "Harridan",
  "Sister",
  "Damsel",
  "Broad",
  "Geisha",
  "Madamoiselle",
  "Signorita",
  "Fraulein",
  "Femme Fatale",
  "Prick Teaser",
  "Ballcrusher",
  "Bird",
  "Chick",
  "Babe",
  "Fox",
  "Sex Kitten",
  "Fab Flange",
  "Starlet",
  "Rose",
  "Diva",
  "Vamp",
  "Lady",
  "Dame",
  "Belle Of The Ball",
  "Countess",
  "Duchess",
  "Princess",
  "Top Bird"
);


@primaries = ("Primary",
              "Secondary",
              "Tertiary",
              "Quaternary",
              "Quinternary",
              "Sexternary",
              "Septernary",
              "Octernary",
              "Nonernary",
              "Decernary"); # I don't know how many of these
                            # words are real but we don't
                            # use them all anyway.

@stock_days = ();
$invalid_date = "";


# Colours
@colourList1 = ("blue", "purple", "#f0f0a0", "#f0f0d0", "#c0d0f0",
                "#d0e0ff", "#e0f0ff");
@colourList2 = ("brown", "orange", "#f0f0a0", "#f0f0d0", "#e0c0a0",
                "#f0d0b0", "#ffe0c0");
@colourList3 = ("green", "orange", "#f0f0a0", "#f0f0d0", "#d0f0d0",
                "#d0ffd0", "#e0ffe0");

############################################################

sub seed_word # converts A-Z to a-z and removes any characters that
              # aren't a-z, 0-9 or _
{
    # Note: word must be passed in by reference, e.g.
    # seed_word(\$my_word);

    my $wordRef = shift(@_);

    $$wordRef = lc($$wordRef);
    $$wordRef =~ tr/a-z0-9_//cd;
}

############################################################

sub substitute_vars
{
    my $lineRef = shift(@_);

    $$lineRef =~ s/\$HOST/$HOST/g;
    $$lineRef =~ s/\$CGI_BIN/$CGI_BIN/g;
    $$lineRef =~ s/\$SCRIPT/$SCRIPT/g;

    $$lineRef =~ s/\$HOST/$HOST/g;
    $$lineRef =~ s/\$CGI_BIN/$CGI_BIN/g;
    $$lineRef =~ s/\$SCRIPT/$SCRIPT/g;
    $$lineRef =~ s/\$THIS_CGI/$THIS_CGI/g;
    $$lineRef =~ s/\$IMGDIR1/$IMGDIR1/g;
    $$lineRef =~ s/\$IMGDIR2/$IMGDIR2/g;
    $$lineRef =~ s/\$IMGPOODIR/$IMGPOODIR/g;
    $$lineRef =~ s/\$IMGSHITEDIR/$IMGSHITEDIR/g;
    $$lineRef =~ s/\$IMGCAPTIONSDIR/$IMGCAPTIONSDIR/g;
    $$lineRef =~ s/\$IMGTROOPDIR/$IMGTROOPDIR/g;
    $$lineRef =~ s/\$IMGNNMHDIR/$IMGNNMHDIR/g;
    $$lineRef =~ s/\$DATADIR/$DATADIR/g;

    $$lineRef =~ s/\$\{HOST\}/$HOST/g;
    $$lineRef =~ s/\$\{CGI_BIN\}/$CGI_BIN/g;
    $$lineRef =~ s/\$\{SCRIPT\}/$SCRIPT/g;
    $$lineRef =~ s/\$\{THIS_CGI\}/$THIS_CGI/g;
    $$lineRef =~ s/\$\{IMGDIR1\}/$IMGDIR1/g;
    $$lineRef =~ s/\$\{IMGDIR2\}/$IMGDIR2/g;
    $$lineRef =~ s/\$\{IMGPOODIR\}/$IMGPOODIR/g;
    $$lineRef =~ s/\$\{IMGSHITEDIR\}/$IMGSHITEDIR/g;
    $$lineRef =~ s/\$\{IMGCAPTIONSDIR\}/$IMGCAPTIONSDIR/g;
    $$lineRef =~ s/\$\{IMGTROOPDIR\}/$IMGTROOPDIR/g;
    $$lineRef =~ s/\$\{IMGNNMHDIR\}/$IMGNNMHDIR/g;
    $$lineRef =~ s/\$\{DATADIR\}/$DATADIR/g;
    
$$lineRef =~ s/\$STUPID_SITE/ARSE/g;
}

############################################################

sub add_date_args_to_link
{
    my $lineRef = shift(@_);

    $$lineRef =~ s/\?p=/\?$date_args&p=/g if ($$lineRef =~/href/);
}

############################################################

sub make_seed  # returns an integer derived from the characters in a 
               # string.
{
    my $word = shift(@_);
    my $seed = 0;
    my $len  = length($word);

    for $c (split //,$word)
    {
        $n = ord($c);
        $s = $n * $len;
        $seed += $s;
        $len--;
    }

    return $seed;
}

############################################################

sub get_seed  # Wrapper for seed_word and make_seed
{
    my $word = shift(@_);

    seed_word(\$word);
    return make_seed($word);
}

############################################################

sub randy_old  # returns a random integer in the range start - end
           # using seed
{
    my ($start, $end, $seed) = @_;
    my $ran;

    $range = $end - $start + 1;
    srand $seed;

    $n = $seed % 100 + 2;

    while ($n-- > 0)
    {
        $ran = int (rand $range) + $start;
    }

    return $ran;
}

############################################################

sub randy  # returns a random integer in the range start - end
           # using seed
{
    my ($start, $end, $seed) = @_;
    my $ran;

    $range = $end - $start + 1;
    srand $seed;

    $n = (($seed + 99) % 200) + 2;

    while ($n-- > 0)
    {
        $ran = int (rand $range) + $start;
    }

    return $ran;
}

############################################################
sub all_lines  # Populates a list with all lines from
               # a file.
               # Returns number of items in list,
               # or -1 if there's problems with file.
{
    # Note: list must be passed in by reference, e.g.
    # all_lines($my_fname, \@my_list);

    my ($fname, $listRef) = @_;
    my $line = "";

    @$listRef = ();
    open (INFILE, "$fname") || return -1;

    while (<INFILE>)
    {
        chop;
        next if (/^\s*$/);  # ignore blank lines
        next if (/^#/);     # ignore commented lines
        push (@$listRef, $_);
    }

    return scalar(@$listRef);
}

############################################################

sub random_file  # gets a random filename from a directory
                 # using a seed
{
    my ($dir, $seed, $ext) = @_;
    my @fileList = split /\n/, `ls $dir`;
    my $nFiles = scalar (@fileList);
    my $r = randy (0, $nFiles - 1, $seed+$nFiles);

    return $fileList[$r];
}

############################################################

sub random_line  # gets a random line from a file using a seed
{
    my ($fname, $seed) = @_;
    my $line = "";
    my @list = ();
    my $size = 0;
    my $r = 0;

    open (INFILE, "$fname") || return $line;

    while (<INFILE>)
    {
        chop;
        next if (/^\s*$/);  # ignore blank lines
        next if (/^#/);     # ignore commented lines
        push @list, $_;
    }

    $size = scalar (@list);
    $r = randy (0, $size - 1, $seed+$size);
    $line = $list[$r];

    return $line;
}

############################################################

sub fixed_line   # gets a fixed line from a file where the given date
                 # matches the first field
{
    my ($fname, $date) = @_;
    my $line = "";

    open (INFILE, "$fname") || return $line;

    while (<INFILE>)
    {
        chop;
        next if (/^\s*$/);  # ignore blank lines
        next if (/^#/);     # ignore commented lines

        @fields = split /;/, $_;

        if ($fields[0] eq "$date")
        {
            $line = $_;
            last;
        }
    }

    return $line;
}

############################################################

sub get_prospects  # Maps a total score to the prospects list
{
    my $total = shift(@_);
    $total = 0 if ($total < 0);
    my $prosp_size = scalar(@prospects);
    my $prosp = $prospects[$prosp_size - 1]; # If out of range
                                             # get max.

    $prosp = $prospects[$total] if ($total < $prosp_size - 1);

    return $prosp;
}

############################################################

sub get_rating  # Maps a score to a ratings list
{
    my ($score, $listRef) = @_;
    $score = 0 if ($score < 0);
    my $ratings_size = scalar(@$listRef);
#print "score=$score ratings_size=$ratings_size<br>\n";
    my $rating = $$listRef[$ratings_size - 1]; # If out of range
                                              # get max.

    $rating = $$listRef[$score] if ($score < $ratings_size - 1);

    return $rating;
}

############################################################

sub random_sort  # Sort stock list into random order based
                 # on today's seed.
{
    my ($listRef, $seed) = @_;
    my $temp = "";
    my $size = scalar (@$listRef);
    my $swaps = $size;
    my $s1 = 0;
    my $s2 = 0;

    srand $seed;

    while ($swaps > 0)
    {
        $s1 = int (rand 100) % $size;
        $s2 = int (rand 100) % $size;
        $temp = $$listRef[$s1];
        $$listRef[$s1] = $$listRef[$s2];
        $$listRef[$s2] = $temp;
        $swaps--;
    }
}

############################################################

sub random_sort_new  # Sort stock list into random order based
                 # on today's seed.
{
    my ($listRef, $seed) = @_;
    my $temp = "";
    my $size = scalar (@$listRef);
    my $swaps = $size;
    my $s1 = 0;
    my $s2 = 0;

    srand $seed;

    while ($swaps > 0)
    {
        $swaps--;
        $s1 = $swaps;
        $s2 = int (rand $size);
        $temp = $$listRef[$s1];
        $$listRef[$s1] = $$listRef[$s2];
        $$listRef[$s2] = $temp;
    }
}

############################################################

sub get_stock
{
    my $date = shift(@_);

    get_lesser($date);
    get_great($date);

    # Today's Guest Stock is the TOP of the Lesser list
    # and needs to be added to the BOTTOM of the Great list

    push @greatList, $lesserList[0];
}

############################################################

sub get_great  # Populate data structures with details
               # of the Great Stocks
{
    my $date = shift(@_);
    if ($date eq "") { $date = $u_yyyymmdd; }

    @greatList = ();
    open (INFILE, "$STOCKS_GREAT_FILE");

    while (<INFILE>)
    {
        chop;
        next if (/^\s*$/);  # ignore blank lines
        next if (/^#/);     # ignore commented lines
    
        $record = {};
        ($id, $singular, $plural, $filename, $article) = split /;/, $_;
    
        $record->{id} = $id;
        $record->{singular} = $singular;
        $record->{plural}   = $plural;
        $record->{filename} = $filename;
        $record->{article}  = $article;
    
        $stockHash->{$id} = $record;
        push @greatList, $id;
    }
    close (INFILE);
    random_sort(\@greatList, $date);
}

############################################################

sub get_lesser  # Populate data structures with details
                # of the Lesser Stocks
{
    my $date = shift(@_);
    if ($date eq "") { $date = $u_yyyymmdd; }

    @lesserList = ();
    open (INFILE, "$STOCKS_LESSER_FILE");

    while (<INFILE>)
    {
        chop;
        next if (/^\s*$/);  # ignore blank lines
        next if (/^#/);     # ignore commented lines
    
        $record = {};
        ($id, $singular, $plural, $filename, $article) = split /;/, $_;
    
        $record->{id} = $id;
        $record->{singular} = $singular;
        $record->{plural}   = $plural;
        $record->{filename} = $filename;
        $record->{article}  = $article;
    
        $stockHash->{$id} = $record;
        push @lesserList, $id;
    }
    close (INFILE);
    random_sort(\@lesserList, $date);
}

############################################################
 
sub get_properties  # Populate data structures with properties
                    # of the Great Stocks
{
    open (PROPFILE, "$PROPERTIES_FILE");
 
    while (<PROPFILE>)
    {
        chop;
        next if (/^\s*$/);  # ignore blank lines
        next if (/^#/);     # ignore commented lines
 
        $record = {};
        ($id, $title, $property, $filename) = split /;/, $_;
 
        $record->{id} = $id;
        $record->{title} = $title;
        $record->{property} = $property;
        $record->{filename} = $filename;
 
        $propHash->{$id} = $record;
        push @propList, $id;
    }
    close (PROPFILE);
}

############################################################
 
sub get_groups  # Populate data structures with details
                # of the Groups
{
    open (GROUPSFILE, "$GROUPS_FILE") || return;
 
    while (<GROUPSFILE>)
    {
        chop;
        next if (/^\s*$/);  # ignore blank lines
        next if (/^#/);     # ignore commented lines
 
        $record = {};
        ($id, $groupname, $filename) = split /;/, $_;
 
        $record->{id} = $id;
        $record->{groupname} = $groupname;
        $record->{filename}  = $filename;
 
        $groupHash->{$id} = $record;
        push @groupList, $id;
    }
    close (GROUPSFILE);
}
 
############################################################

sub strip_leading_trailing_spaces
{
    my $stringRef = shift(@_);
    $$stringRef =~ s/^\s+//;
    $$stringRef =~ s/\s+$//;
}

############################################################
 
sub get_shitems  # Populate data structures with details
                 # of the Shitespace shitems
{
    my ($shiteHashRef, $shiteListRef, $filter) = @_;
    my $include = 0;

    $filter = "d" if ($filter eq "");

    open (SHITEFILE, "$SHITE_INDEX_FILE") || return;
 
    while (<SHITEFILE>)
    {
        chop;
        next if (/^\s*$/);  # ignore blank lines
        next if (/^#/);     # ignore commented lines
        $include = 0;
 
        $record = {};
        ($record->{potd},
         $record->{type},
         $record->{shiteId},
         $record->{title},
         $record->{author},
         $record->{pageId},
         $record->{imageCode}) = split /;/, $_;

        # Restrict which shitems get included in the list

        if ($filter eq "r")       # Make "Recommended Reading" list
        {
            $include = 1 if (($record->{potd} eq "d") || ($record->{potd} eq "+"));
        }
        elsif ($filter eq "d")    # Make "Poem Of The Day" list
        {
            $include = 1 if ($record->{potd} eq "d");
        }
        elsif ($filter eq "a")    # Make list of "All" shitems
        {
            $include = 1;
        }

        if ($include > 0)
        { 
            strip_leading_trailing_spaces(\$record->{shiteId});
            strip_leading_trailing_spaces(\$record->{title});
            strip_leading_trailing_spaces(\$record->{author});
            strip_leading_trailing_spaces(\$record->{pageId});
            strip_leading_trailing_spaces(\$record->{imageCode});
 
            $$shiteHashRef->{$record->{shiteId}} = $record;
            push @$shiteListRef, $record->{shiteId};
        }
    }
    close (SHITEFILE);
}
 
############################################################

sub get_pages  # Populate data structures with details
               # of the Shitespace pages
{
    my ($pageHashRef, $pageListRef, $filter) = @_;
    my $include = 0;

    $filter = "v" if ($filter eq "");

    open (PAGEFILE, "$PAGE_INDEX_FILE") || return;
 
    while (<PAGEFILE>)
    {
        chop;
        next if (/^\s*$/);  # ignore blank lines
        next if (/^#/);     # ignore commented lines
        $include = 0;
 
        $record = {};
        ($record->{authorCode},
         $record->{pick},
         $record->{category},
         $record->{pageFormat},
         $record->{date},
         $record->{pageId},
         $record->{title},
         $record->{alternativeTitle}) = split /;/, $_;

        # Restrict which pages get included in the list

        if ($filter eq "v")       # All publically Visible pages
        {
            $include = 1 if ($record->{category} ne "n");
        }
        elsif ($filter eq "n")       # All Hidden pages
        {
            $include = 1 if ($record->{category} eq "n");
        }
        elsif ($filter eq "c")    # Only Crappalot's pages
        {
            $include = 1 if ($record->{category} eq "C");
        }
        elsif ($filter eq "a")    # All pages
        {
            $include = 1;
        }

        if ($include > 0)
        { 
            strip_leading_trailing_spaces(\$record->{date});
            strip_leading_trailing_spaces(\$record->{pageId});
            strip_leading_trailing_spaces(\$record->{title});
            strip_leading_trailing_spaces(\$record->{alternativeTitle});
 
            $$pageHashRef->{$record->{pageId}} = $record;
            push @$pageListRef, $record->{pageId};
        }
    }
    close (PAGEFILE);
}
 
############################################################

sub favourite   # Returns the name of a stock's "favourite"
                # property
{
    my ($stock_name, $prop_id) = @_;
    my $seed = get_seed ($stock_name);
    my $prop_file = $propHash->{$prop_id}->{filename};
    my $fav = random_line ("$LISTDIR/$prop_file", $seed);

    return $fav;
}

############################################################

sub calc_feelings  # Calculate feelings between two stocks
                   # (ignoring stock bonuses)
{
    my ($stock_name1, $stock_name2) = @_;
    my $points = 0;
    my $prop = "";
    my $fav1 = "";
    my $fav2 = "";

    if ($stock_name1 eq "" || $stock_name2 eq "") { return -1; }

    for $prop (@propList)
    {
        $fav1 = favourite ($stock_name1, $prop);
        $fav2 = favourite ($stock_name2, $prop);
        $points++ if ($fav1 eq $fav2);
    }

    return $points;
}

############################################################

sub calc_total  # Calculate total feeling of stocks
{
    my $l_yyyymmdd = shift(@_);  # for a given DoB
    my $total = 0;
    my $points = 0;
    my $stock = "";
    my $s = "";
    my $stock_file = "";
    my $todays_stock = "";
    my $birth_stock = "";
    my $l_birth_seed = $l_yyyymmdd;
    my $bonus = $STOCK_BONUS;

    @stock_days = (); # global

    for $stock (@greatList)
    {
        $s = $stockHash->{$stock};   # Stock ref
        $stock_file = $s->{filename};
        $todays_stock = random_line ("$LISTDIR/$stock_file", $date_seed);
        $birth_stock = random_line ("$LISTDIR/$stock_file", $l_birth_seed);
        $points = calc_feelings ($todays_stock, $birth_stock);
        $points *= $bonus;
        $total += $points if ($points > 0);

        # Populate a list with stock id's
        # where today's stock matches birth stock

        if ($todays_stock eq $birth_stock)
        {
            push @stock_days, $stock;
        }

        $bonus--;
        $bonus = 1 if ($bonus < 1);
    }

    return $total;
}

############################################################

sub add_lesser_stock_days # Adds lesser stocks to global list of stock days
{
    my $l_yyyymmdd = shift(@_);  # for a given DoB
    my $stock = "";
    my $s = "";
    my $stock_file = "";
    my $todays_stock = "";
    my $birth_stock = "";

    for $stock (@lesserList)
    {
        $s = $stockHash->{$stock};   # Stock ref
        $stock_file = $s->{filename};
        $todays_stock = random_line ("$LISTDIR/$stock_file", $date_seed);
        $birth_stock = random_line ("$LISTDIR/$stock_file", $l_yyyymmdd);

        # Populate a list with stock id's
        # where today's stock matches birth stock

        if ($todays_stock eq $birth_stock)
        {
            push @stock_days, $stock if (isInList($stock, \@stock_days) < 1);

            # Need isInList because guest stock could be in both
            # greatList and lesserList.
        }
    }
}

############################################################

sub format_date  # Converts (23,September,1962) to 19620923
{
    my ($f_mday, $f_month, $f_year) = @_;
    my $f_yyyymmdd = -1;
    my $f_mon = 12;      # Bad month number (range: 0 to 11)

    for ($i = 0; $i < 12; $i++)  # What month number?
    {
        if ($f_month eq $monthList[$i]) { $f_mon = $i; }
    }

    $f_yyyymmdd = sprintf "%04d%02d%02d", $f_year, $f_mon+1, $f_mday;

    return $f_yyyymmdd;
}

############################################################

sub parse_date  # Converts 19620923 to Sunday;23;September;1962;9
{
    my $i_yyyymmdd = shift(@_);
    my $yyyy = substr ($i_yyyymmdd, 0, 4);
    my $mm   = substr ($i_yyyymmdd, 4, 2);
    my $dd   = substr ($i_yyyymmdd, 6, 2);
    my $month = "";
    my ($l_yyyymmdd, $day);

    if ($mm > 0 && $dd > 0)
    {
        $month = $monthList[$mm - 1];
        ($l_yyyymmdd, $day) = split / /, date_calc("-s $i_yyyymmdd");
        $dd =~ s/^0//;
        $mm =~ s/^0//;
    }
    else
    {
        $dd = "";
        $mm = "";
    }

    return "${day};${dd};${month};${yyyy};${mm}";

    # Returned fields:
    # $day   = Day Of Week (Sunday)
    # $dd    = Day Of Month (23)
    # $month = Month Name (September)
    # $yyyy  = Year (1962)
    # $mm    = Month Number (9)
}

############################################################

sub poem_of_the_day   # old version using poems_random
{
    my $i_yyyymmdd = shift(@_);
    $i_yyyymmdd = $u_yyyymmdd if ($i_yyyymmdd eq "");
    my $file = "";
    my $title = "";
    my $author = "";
    my $type = "";
    my $p_yyyymmdd = "";
    my $ret = "";
    my $record = fixed_line ("$POEMS_FIXED_FILE", $i_yyyymmdd);

    if ($record eq "")  # No fixed poem today so get random one
    {
        $record = random_line ("$POEMS_RANDOM_FILE", $i_yyyymmdd);
        ($file, $title, $author) = split /;/, $record;
        $type = "R";
    }
    else
    {
        ($p_yyyymmdd, $file, $title, $author) = split /;/, $record;
        $type = "F";
    }

    $ret = "${file};${title};${author};${type}";
    return $ret;
}

############################################################

sub todays_poem     # replacement for poem_of_the_day
{
    my $i_yyyymmdd = shift(@_);
    $i_yyyymmdd = $u_yyyymmdd if ($i_yyyymmdd eq "");
    my $shiteId = "";
    my $title = "";
    my $author = "";
    my $type = "";
    my $imageCode = "";
    my $p_yyyymmdd = "";
    my $ret = "";
    my $record = fixed_line ("$POEMS_FIXED_FILE", $i_yyyymmdd);

    if ($record eq "")  # No fixed poem today so get random one
    {
        my @list = ();
        my $size = 0;
        my $seed = 0;
        my $r = 0;
    
        open (INFILE, "$SHITE_INDEX_FILE") || return $record;
    
        while (<INFILE>)
        {
            chop;
            next if (!/^d;/);   # only want potd=d records
            next if (/^\s*$/);  # ignore blank lines
            next if (/^#/);     # ignore commented lines
            push @list, $_;
        }
    
        $size = scalar (@list);
        $seed = $i_yyyymmdd + $size;
        $r = randy (0, $size - 1, $seed);
        $record = $list[$r];
        ($potd, $type, $shiteId, $title, $author, $pageId, $imageCode)
            = split /;/, $record;
        $type = "R";
    }
    else
    {
        ($p_yyyymmdd, $shiteId, $title, $author, $pageId, $imageCode) = split /;/, $record;
        $type = "F";
    }

    $shiteId =~ s/\s+//g;
    $title =~ s/^\s+//;
    $title =~ s/\s+$//;
    $author =~ s/^\s+//;
    $author =~ s/\s+$//;
    $type =~ s/\s+//g;
    $imageCode =~ s/\s+//g;

    $ret = "${shiteId};${title};${author};${type};${imageCode};${pageId}";
    return $ret;
}

############################################################

sub isInList   # Returns number of occurrences of item in a list
{
    my ($item, $listRef) = @_;

    $count = 0;

    for (@$listRef)
    {
        $count++ if ($_ eq $item);
    }

    return $count;
}

############################################################

sub nth     # Returns "th" for all numbers except 1 st, 2 nd,
            # 21 st, 22 nd etc.
{
    my $num = shift(@_);
    my $th = "th";

    $lastdigit = $num % 10;
    $last2digits = $num % 100;

    if ($lastdigit == 1 && $last2digits != 11) {$th = "st";}
    if ($lastdigit == 2 && $last2digits != 12) {$th = "nd";}

    return $th;
}

############################################################

sub get_trooper_rec  # returns a trooper file record
                     # for a given trooper name
{
    my $aName = shift(@_);
    my $ret = "";

    return $ret if ($aName eq "");

    open (FD, "$TROOP_FILE");
    while (<FD>)
    {
        chop;
        next if (/^#/);
        ($member, $sex, $name, $file) = split /;/, $_;

        if ($aName eq $name)
        {
            $ret = $_;
            last;
        }
    }

    return $ret;
}

############################################################

sub random_seed
{
    my ($l_sec,$l_min,$l_hour,$l_mday,$l_mon,$l_year,$l_wday,$l_yday,$l_isdst)
            = localtime(time);
    my $seed = $l_sec + $l_yday;
    return $seed;
}


############################################################

sub write_log
{
    my $site = shift @_;
    my $month = substr ($r_yyyymmdd, 0, 6);
    my $pageId = $page;
    my $pageArg = $arg1;
    my $otherArg = $cgi->param("i");

    my $remote_addr = $ENV{'REMOTE_ADDR'};
    my $remote_host = $ENV{'REMOTE_HOST'}; 
    my $remote_user = $ENV{'REMOTE_USER'}; 
    my $http_from   = $ENV{'HTTP_FROM'};

    $pageArg = $cgi->param("c") if ($pageArg eq "");

    $LOG_FILE = "${WRITEDIR}/pages_${month}.log";

    open (PAGELOG, ">>$LOG_FILE");  # Record hit in log file
    print PAGELOG "${r_yyyymmdd};${r_now};${pageId};${pageArg};${remote_addr};${otherArg};${b_yyyymmdd};${u_sex};${site}\n";
    close (PAGELOG);
}

############################################################

sub convert_pageId
{
    # convert old-style pageIds to new ones
    # this helps us to remain backwards compatible with old links

    my $myPageId = shift(@_);

    $myPageId = "rate" if ($myPageId eq "" || $myPageId eq "shitespace" ||
                           $myPageId eq "home" || $myPageId eq "front" ||
                           $myPageId eq "shite" || $myPageId eq "vote");
    $myPageId = "map" if ($myPageId eq "pages");
    $myPageId = "bowels" if ($myPageId eq "archives");
    $myPageId = "votes"  if ($myPageId eq "viewlogs");
    $myPageId = "league" if ($myPageId eq "viewvotes");
    $myPageId = "hits"   if ($myPageId eq "viewhits");

    return $myPageId;
}

############################################################

sub sortbypoints { 0 - ($a->{g_points} <=> $b->{g_points}); }

sub sortbyspecial { $a->{g_special} cmp $b->{g_special}; }

1;

############################################################
# END OF FILE
############################################################