#----------------------------------------
#usage
#$today=&today();

sub today {
local(@Month)=("January", "February", "March","April","May","June","July",
"August","September","October","November","December");
local(@Week)=("Sunday","Monday", "Tuesday",
"Wednesday","Thursday","Friday","Saturday");

local($sec, $min, $hour, $mday, $mon, $year, $wday,
$yday,$isdst)=localtime(time);
local($date)= $Month[$mon]." ".$mday.", 19".$year;
return $date;
}

#----------------------------------------
#usage
#&last_update($filename);

sub last_update {
  
  open(HOMEPAGE, "$_[0]") 
   || print STDOUT "<b>ERROR: </b>Cannot open $_[0]<br>";
  local(@homepage)=<HOMEPAGE>;
  close(HOMEPAGE);

  local($new_homepage)=join("\r", @homepage); 

local($today)=&today();
local($entry);

$new_homepage=~ s/Last update:.*<\/strong>/Last update: $today.<\/strong>/g;

   @homepage=split(/\r/, $new_homepage); 
  

    open (TEMP,">$_[0]") 
    || print STDOUT "<b>ERROR: </b>Cannot write to $_[0]<br>";
    foreach  $entry (@homepage){
       print TEMP  $entry;
    }
    close (TEMP);
}

 


#----------------------------------------

# usage: 
# sort by_lower_case (@array);
sub by_lower_case{
"\L$a" cmp "\L$b";
}

#----------------------------------------

# usage: 
# sort by_lower_case_d (@array);
sub by_lower_case_d{
"\L$b" cmp "\L$a";
}


#----------------------------------------------------
# usage: 
# &delete_block($filename, $begin_mark, $end_mark);
sub delete_block {
  local($filename)=$_[0];
  local($begin_mark)=$_[1];
  local($end_mark)=$_[2];

  open(LIST, "$filename") || print "<b>ERROR: </b>Cannot write to $filename<br>"; 
  local(@list)=<LIST>;
  close(LIST);
  $length=@list;
    local($count)=0;
    local($begin,$end)=(-1,-1);
    local($entry);
    foreach  $entry (@list){
       if($entry =~ /$begin_mark/) {$begin=$count;}
       if($entry =~ /$end_mark/) {$end=$count;  last;}
       $count++;
    } 

    if($begin==-1)
      {print STDOUT "<b>$begin_mark</b> is missing in <b>$filename</b>.<br>"; 
       print STDOUT "Work not done.<br>";
       return 0;}

    if($end==-1)
      {print STDOUT "<b>$end_mark</b> is missing in <b>$filename</b>.<br>"; 
       print STDOUT "Work not done.<br>";
       return 0;}



    for($times=0;$times<=$begin;$times++) {$shiftout[$times]=shift(@list); }
    for($times=0;$times<=$length-$end-1;$times++) {$popout[$times]=pop(@list); }


    @list="";


    for($times=$begin;$times>=0;$times--){unshift(@list,$shiftout[$times]); }
    for($times=$length-$end-1;$times>=0;$times--){push(@list,$popout[$times]); }

    open (TEMP,">$filename") || print "<b>ERROR: </b>Cannot write to $filename<br>";
    foreach  $entry (@list){
       print TEMP  $entry;
    }
    close (TEMP);
}


#----------------------------------------------------
# usage: 
# &insert($filename, $begin_mark, $end_mark, $new_entry, $sort);
#$sort=1 => sort in increasing order
#$sort=2 => sort in decreasing order

sub insert {
  local($filename)=$_[0];
  local($begin_mark)=$_[1];
  local($end_mark)=$_[2];
  local($new_entry)=$_[3];
  local($sort)=$_[4];

  open(LIST, "$filename") || print "<b>ERROR: </b>Cannot write to $filename<br>"; 
  @list=<LIST>;
  close(LIST);
  $length=@list;
    local($count)=0;
    local($begin,$end)=(-1,-1);
    local($entry);
    foreach  $entry (@list){
       if($entry =~ /$begin_mark/) {$begin=$count;}
       if($entry =~ /$end_mark/) {$end=$count;  last;}
       $count++;
    } 

    if($begin==-1)
      {print STDOUT "<b>$begin_mark</b> is missing in <b>$filename</b>.<br>"; 
       print STDOUT "Work not done.<br>";
       return 0;}

    if($end==-1)
      {print STDOUT "<b>$end_mark</b> is missing in <b>$filename</b>.<br>"; 
       print STDOUT "Work not done.<br>";
       return 0;}


    for($times=0;$times<=$begin;$times++) {$shiftout[$times]=shift(@list); }
    for($times=0;$times<=$length-$end-1;$times++) {$popout[$times]=pop(@list); }


    push(@list,$new_entry);

    if($sort==1) { #sort in increasing order
    @list= sort  by_lower_case (@list);
    }
   
    if($sort==2) { #sort in decreasing order
    @list= sort  by_lower_case_d (@list);
    }
   

    for($times=$begin;$times>=0;$times--){unshift(@list,$shiftout[$times]); }
    for($times=$length-$end-1;$times>=0;$times--){push(@list,$popout[$times]); }


    open (TEMP,">$filename") || print "<b>ERROR: </b>Cannot write to $filename<br>";
    foreach  $entry (@list){
       print TEMP  $entry;
    }
    close (TEMP);
}

#---------------------------------------------------

# usage: 
# $content=&content($filename, $begin_mark, $end_mark);
# return value:
# an array @array

sub content {
  local($filename)=$_[0];
  local($begin_mark)=$_[1];
  local($end_mark)=$_[2];

  open(LIST, "$filename") || print  "<b>ERROR: </b>Cannot write to $filename<br>"; 
  local(@list)=<LIST>;
  close(LIST);
  $length=@list;
    local($count)=0;
    local($begin,$end)=(-1,-1);
    local($entry);
    foreach  $entry (@list){
       if($entry =~ /$begin_mark/) {$begin=$count;}
       if($entry =~ /$end_mark/) {$end=$count;  last;}
       $count++;
    } 

    if($begin==-1)
      {print STDOUT "Begin Mark<b>$begin_mark</b> is missing in <b>$filename</b>.<br>"; 
       print STDOUT "Work not done.<br>";
       return 0;}

    if($end==-1)
      {print STDOUT "<b>End mark $end_mark</b> is missing in <b>$filename</b>.<br>"; 
       print STDOUT "Work not done.<br>";
       return 0;}



    for($times=0;$times<=$begin;$times++) {$shiftout[$times]=shift(@list); }
    for($times=0;$times<=$length-$end-1;$times++) {$popout[$times]=pop(@list); }

#    push(@list,"\r");    
#    push(@list,"\r");    

    $content=join("\r", @list);

}





#----------------------------------------------------
#function
#replace in bulk
# usage: 
# &replace($filename, $begin_mark, $end_mark, $new_entry);
sub replace {

  local($filename)=$_[0];
  local($begin_mark)=$_[1];
  local($end_mark)=$_[2];
  local($entry)=$_[3];
  local(@new_entry)=split(/\r/, $entry); 

  open(LIST, "$filename") || print  "<b>ERROR: </b>Cannot write to $filename<br>"; 
  local(@list)=<LIST>;
  close(LIST);
  $length=@list;
    local($begin,$end)=(-1,-1);
    local($count)=0;
    local($entry);
    foreach  $entry (@list){
       if($entry =~ /$begin_mark/) {$begin=$count;}
       if($entry =~ /$end_mark/) {$end=$count;}
       $count++;
    } 

    if($begin==-1)
      {print STDOUT "<b>$begin_mark</b> is missing in <b>$filename</b>.<br>"; 
       print STDOUT "Work not done.<br>";
       return 0;}

    if($end==-1)
      {print STDOUT "<b>$end_mark</b> is missing in <b>$filename</b>.<br>"; 
       print STDOUT "Work not done.<br>";
       return 0;}


for($times=0;$times<=$begin;$times++) 
  {$shiftout[$times]=shift(@list); }
for($times=0;$times<=$length-$end-1;$times++) 
  {$popout[$times]=pop(@list); }



    for($times=$begin;$times>=0;$times--)
       {unshift(@new_entry,$shiftout[$times]); }
    for($times=$length-$end-1;$times>=0;$times--)
       {push(@new_entry,$popout[$times]); }



    open (TEMP,">$filename") || print "<b>ERROR: </b>Cannot write to $filename.<br>";
    foreach  $entry (@new_entry){
       print TEMP  $entry;
    }
    close (TEMP);
}


#--------------------------------------------------------------------
# Perl Routines to Manipulate CGI input
# S.E.Brenner@bioc.cam.ac.uk
# $Header: /people/seb1005/http/cgi-bin/RCS/cgi-lib.pl,v 1.2 1994/01/10 15:05:40 seb1005 Exp $
#
# Copyright 1993 Steven E. Brenner  
# Unpublished work.
# Permission granted to use and modify this library so long as the
# copyright above is maintained, modifications are documented, and
# credit is given for any use of the library.

# ReadParse
# Reads in GET or POST data, converts it to unescaped text, and puts
# one key=value in each member of the list "@in"
# Also creates key/value pairs in %in, using '\0' to separate multiple
# selections

# If a variable-glob parameter (e.g., *cgi_input) is passed to ReadParse,
# information is stored there, rather than in $in, @in, and %in.

sub ReadParse {
  if (@_) {
    local (*in) = @_;
  }

  local ($i, $loc, $key, $val);

  # Read in text
  if ($ENV{'REQUEST_METHOD'} eq "GET") {
    $in = $ENV{'QUERY_STRING'};
  } elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
    for ($i = 0; $i < $ENV{'CONTENT_LENGTH'}; $i++) {
      $in .= getc;
    }
  } 

  @in = split(/&/,$in);

  foreach $i (0 .. $#in) {
    # Convert plus's to spaces
    $in[$i] =~ s/\+/ /g;

    # Convert %XX from hex numbers to alphanumeric
    $in[$i] =~ s/%(..)/pack("c",hex($1))/ge;

    # Split into key and value.
    $loc = index($in[$i],"=");
    $key = substr($in[$i],0,$loc);
    $val = substr($in[$i],$loc+1);
    $in{$key} .= '\0' if (defined($in{$key})); # \0 is the multiple separator
    $in{$key} .= $val;
  }

  return 0; # just for fun
}

# PrintHeader
# Returns the magic line which tells WWW that we're an HTML document

sub PrintHeader {
  return "Content-type: text/html\n\n";
}

# PrintVariables
# Nicely formats variables in an associative array passed as a parameter
# And returns the HTML string.

sub PrintVariables {
  local (%in) = @_;
  local ($old, $out);
  $old = $*;  $* =1;
  $output .=  "<DL COMPACT>";
  foreach $key (sort keys(%in)) {
    ($out = $in{$key}) =~ s/\n/<BR>/g;
    $output .=  "<DT><B>$key</B><DD><i>$out</I><BR>";
  }
  $output .=  "</DL>";
  $* = $old;

  return $output;
}

# PrintVariablesShort
# Nicely formats variables in an associative array passed as a parameter
# Using one line per pair (unless value is multiline)
# And returns the HTML string.

sub PrintVariablesShort {
  local (%in) = @_;
  local ($old, $out);
  $old = $*;  $* =1;
  foreach $key (sort keys(%in)) {
    if (($out = $in{$key}) =~ s/\n/<BR>/g) {
      $output .= "<DL COMPACT><DT><B>$key</B> is <DD><i>$out</I></DL>";
    } else {
      $output .= "<B>$key</B> is <i>$out</I><BR>";
    }
  }
  $* = $old;

  return $output;
}

1; #return true