#!/usr/local/bin/perl
# www_pl  -  perl subroutines for use w/WWW development
#
# by: Eric Hall
# date: 8/11/94
#
# desc: this file contains many useful and reusable subroutines
#
# Enjoy,
# --eric hall
# --ehall1@duck.ford.com
# heavily modified by Sunil
################################################################
 
################################################################
#  perl script has to do something
################################################################
$caption_length=17;
$pad_string='&#160;';
$has_blank_item=1;
$list_is_sorted=1;
 
################################################################
#used for alphabetical sorts
################################################################
sub alpha { $a cmp $b; }
%tags; 
 
################################################################
#parses the standard input (STDIN) and generates
#an associative array called %FORM w/the key=input box name
#and value=what user typed into input box
################################################################
sub GET_FIELDS {
 
    local($name,$value,$pair,$buffer,@pairs,%FORM);
 
    # Get the input
    read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
 
    # Split the name-value pairs
    @pairs = split(/&/, $buffer);
 
    foreach $pair (@pairs)
    {
	($name, $value) = split(/=/, $pair);
 
	# Un-Webify plus signs and %-encoding
	$value =~ tr/+/ /;
	$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
 
	#want to skip submissions of default values
	next if (grep(/\?\?\?\?\?/,$value));
 
	# Stop people from using subshells to execute commands
	# Not a big deal when using sendmail, but very important
	# when using UCB mail (aka mailx).
	$value =~ s/~!/ ~!/g;
	$value =~ s/\240/ /g;
 
	$FORM{$name} = $value;
    }
 
    return (%FORM);
 
} #end sub GET_FIELDS
 
 
################################################################
#generates required header
#call w/title of page and recognition list
################################################################
sub PRINT_HEADER {
 
    local($title, @flist) = @_;
 
    print "Content-type: text/html\n\n";
    print "<html>\n";
    print "<head>\n";
    if (@flist[0] ne "") { &PRNREC(@flist); }
    print "<Title>$title</Title>\n";
    print "</head>\n";
    print "<body>\n";
    print "\n";
 
} #end sub PRINT_HEADER
 
################################################################
#generates footer to file
################################################################
sub PRINT_FOOTER {
 
    print "\n";
    print "<HR>\n";
    print "\n";
    print "</html>\n";
    print "</body>\n";
 
} #end sub PRINT_FOOTER
 
 
 
################################################################
#generates a recognition header
################################################################
sub PRNREC {
 
    local($fname,$ftease,$fauth,$fdesc) = @_;
 
    print "\n";
    print "<!--------------------------------------------------------------->\n\
n";
    print "<!-- $fname >\n";
    print "<!-- $ftease >\n\n";
    print "<!-- author: $fauth >\n";
    print "<!-- description: $fdesc >\n\n";
    print "<!--------------------------------------------------------------->\n\
n";
 
} #end sub PRNREC
 
 
################################################################
# whats the name of our server?
################################################################
sub get_username
{
   $answer = $ENV{"REMOTE_IDENT"};
}

sub get_this_URL
{
  local ($server,$server_port,$scriptname);

  $server = $ENV{"SERVER_NAME"};
  $server_port = $ENV{"SERVER_PORT"};
  if ($server_port ne "80") 
  {
    $server .= ":" . $server_port;
  }
  $scriptname = $ENV{"SCRIPT_NAME"};
  
  $answer = "http://$server$scriptname";
}

################################################################
# generate a <select> thing from a list
################################################################
sub gen_select
{
  local ($name, @list) = @_;
  local ($item, @my_list);

  $count = @list;

  print "<SELECT name=\"$name\">\n";
  if ( $has_blank_item )   {print "<option>\n";}

  if ( $list_is_sorted)
  {
     @my_list = sort sort_caseinsensitive (@list);
  }
  else
  {
    @my_list = @list;
    #push ( @my_list, "unsort")
  }

  foreach $item ( @my_list)
  {
    if ( $item =~ /^\*.*/ ) 
    {
      $item =~ s/^\*//;
      print "<OPTION SELECTED>";
    }
    else
    {
      print "<OPTION>";
    }
    print "$item\n";
  }
  print "</SELECT>";
}

################################################################
# generate a checkbox and a <select> thing from a list
################################################################
sub gen_check_select
{
  local ($caption, $root, @list ) = @_;

  print "<input name=\"chk_${root}\" type=\"checkbox\"><code>";
  &pad_print ($caption, $caption_length);
  print "</code> ";
  &gen_select ( "list_${root}", @list);
  if ( ! $tags{"NOBR"} )
  {
    print "<br>\n";
  }
}

################################################################
# generate a checkbox with a label
################################################################
sub gen_labelled_check
{
  local ($caption, $name ) = @_;
  &code;
  &pad_print ($caption, $caption_length);
  print "<input type=\"checkbox\" name=\"$name\">";
  if ( ! $tags{"NOBR"} )
  {
    print "<br>\n";
  }
  &_code;
}

################################################################
# select with a label
################################################################
sub gen_labelled_select
{
  local ($caption, $name, @list ) = @_;

  &code;
  &pad_print ($caption, $caption_length);
  &_code;
  &gen_select ( $name, @list);
  if ( ! $tags{"NOBR"} )
  {
    print "<br>\n";
  }
}

################################################################
# generate a <radio button> thing
################################################################
sub gen_labelled_radio
{
  local ($caption, $root ) = @_;

  print "<input name=\"txt_${root}\" type=radio value=\"$caption\">";
  &code;
  &pad_print ($caption, $caption_length);
  &_code;
}

################################################################
# generate a <text> thing
################################################################
sub gen_len_label_text
{
  local ($caption, $name, $length ) = @_;

  &code;
  &pad_print ($caption, $caption_length);
  &_code;
  &gen_text($name,$length);
  if ( ! $tags{"NOBR"} )
  {
    print "<br>\n";
  }
}

sub gen_hidden
{
  local ($name,$data) = @_;
  print "<input type=hidden name=\"$name\" value=\"$data\">";
}

sub gen_text
{
  local ($name,$length) = @_;
  print "<input name=\"$name\" size=$length>";
}

################################################################
# generate a <text> thing
################################################################
sub gen_labelled_text
{
  local ($caption, $name ) = @_;
  &gen_len_label_text( $caption, $name, 20);
}

################################################################
# generate a <text> thing and select from a list
################################################################
sub gen_text_select
{
  local ($caption, $root ,@list) = @_;

  &nobr;
  &gen_labelled_text($caption, "txt"+$field_id);
  &gen_select("lst"+$field_id, @list);
  &_nobr;
  print "<br>\n";
}

################################################################
# generate a checkbox and a <text> thing from a list
################################################################
sub gen_check_text
{
  local ($caption, $root ) = @_;

  print "<input name=\"chk_${root}\" type=\"checkbox\"><code>";
  &pad_print ($caption, $caption_length);
  print "</code><input name=\"txt_${root}\" size=20>";
  if ( ! $tags{"NOBR"} )
  {
    print "<br>\n";
  }
}

###################################################################
# return contents of file
###################################################################
sub read_file
{
  local ($filename) = @_;
  local ($output);

  $output="";
  $handle = open(FILE,$filename);
  if ($handle)
  {
    while (<FILE>)
    {
      $output .= $_;
    }
  }

  return $output;

}

###################################################################
# user didnt enter valid criteria
###################################################################
sub no_terms
{
  &PRINT_HEADER("No search terms","");
  &h1 ("You didnt enter any search terms");
  &PRINT_FOOTER;
}

###################################################################
# print a padded cell character
###################################################################
sub pad_print
{
  local ($caption, $pad_len) = @_;
  local ($n_pad);

  $n_pad = $pad_len - length($caption);
  print $caption;
  print $pad_string x $n_pad unless ($n_pad <1);
}

sub pad_print_text
{
   local ($caption, $pad_len) = @_; 
   local ($old_pad);
   
   $old_pad = $pad_string;
   $pad_string = " ";
   &pad_print($caption, $pad_len);
   $pad_string = $old_pad;
   
}

###################################################################
# print a right aligned padded cell character
###################################################################
sub right_print
{
  local ($caption, $pad_len) = @_;
  local ($n_pad);

  $n_pad = $pad_len - length($caption);
  print $pad_string x $n_pad unless ($n_pad <1);
  print $caption;
}

###################################################################
#
###################################################################
sub basename
{
  local ($path_name) = @_;
  local (@list, $count);

  @list = split(/\//, $path_name);
  $count = @list;
  return ($list[$count -1]);
}

###################################################################
#
###################################################################
sub end_tag
{
  local ($tag_name) = @_;

  if ( $tags{$tag_name} )
  {
    print "</$tag_name>";
    $tags{$tag_name} --;
  }
  else
  {
    &www_fatal ("attempt to close unopened $tag_name");
  }
}

sub file_button
{
  local($field_name,$caption) = @_;
  
  if ( $tags{"FORM"} )
  {
    print " <input type=\"file\" name=\"$field_name\" value=\"$caption\" >";
  }
  else
  {
    &www_fatal ("file button without FORM");
  }
}

sub reset_button
{
  if ( $tags{"FORM"} )
  {
    print " <input type=\"reset\" >";
  }
  else
  {
    &www_fatal ("button without FORM");
  }
}

sub button
{
  local ($name, $caption) = @_;
  if ( $tags{"FORM"} )
  {
    print " <input type=\"submit\" name=\"$name\" value=\"$caption\">";
  }
  else
  {
    &www_fatal ("button without FORM");
  }
}

sub www_fatal
{
  &h1 ("** error *** @_");
  die "@_";
}


###################################################################
#
###################################################################
sub h1 { print "<h1>@_</h1>"; }
sub h2 { print "<h2>@_</h2>"; }
sub h3 { print "<h3>@_</h3>"; }
sub br { print "<br>" };
sub p { print "<P>" };

sub li 
{ 
  if ( $tags{"OL"} || $tags{"UL"} )
   { print "<li>@_";}
  else
   { &www_fatal ("LI without LIST"); }
}

sub dt
{ 
  if ( $tags{"DL"} )
   { print "<DT>";}
  else
   { &www_fatal ("DT without DL"); }
}

sub dd
{ 
  if ( $tags{"DL"} )
   { print "<DD>";}
  else
   { &www_fatal ("DD without DL"); }
}

#------------------------------------------------------------------
sub  form 
{ 
  local ($action) = @_;
  print "\n<FORM method=POST ACTION=\"$action\">\n";
  $tags{"FORM"} ++;
};

sub hr { print "<HR>"; }
sub bold { print "<B>"; $tags{"B"}++; }
sub i { print "<I>"; $tags{"I"}++; }
sub nobr { print "<NOBR>"; $tags{"NOBR"}++; }
sub pre { print "<PRE>"; $tags{"PRE"}++; }
sub code { print "<CODE>"; $tags{"CODE"}++; }
sub cite { print "<CITE>"; $tags{"CITE"}++; }
sub ul { print "<UL>"; $tags{"UL"}++; }
sub dl { print "<DL>"; $tags{"DL"}++; }
sub ol { print "<OL>"; $tags{"OL"}++; }
sub centre { print "<CENTER>"; $tags{"CENTER"}++; }
sub table 
{ 
  local ($border) = @_;
  print "<TABLE BORDER=$border >"; $tags{"TABLE"}++; 
}

sub row 
{ 
  if  ( $tags{"TABLE"} )
    { print "<TR>"; $tags{"TR"}++; }
  else 
    { &www_fatal ("TR without TABLE");}
}

sub data 
{
  if  ( $tags{"TR"} )
    { print "<TD>"; $tags{"TD"}++; }
  else 
    { &www_fatal ("TD without TR");}
}

#------------------------------------------------------------------
sub _i { &end_tag ("I"); }
sub _bold { &end_tag ("B"); }
sub _form { &end_tag ("FORM"); }
sub _nobr { &end_tag ("NOBR"); }
sub _pre { &end_tag ("PRE"); }
sub _code { &end_tag ("CODE"); }
sub _ul { &end_tag ("UL"); }
sub _dl { &end_tag ("DL"); }
sub _ol { &end_tag ("OL"); }
sub _centre { &end_tag ("CENTER"); }
sub _cite { &end_tag ("CITE"); }
sub _table { &end_tag ("TABLE"); }
sub _row { &end_tag ("TR"); }
sub _data { &end_tag ("TD"); }

sub href 
{ 
  local ($url,$anchor) = @_;
  print " <A href=\"$url\">$anchor</A>";
}

################################################################
sub sort_caseinsensitive
{
  local ($a2, $b2);

  ($a2 = $a) =~ tr/[A-Z]/[a-z]/;
  ($b2 = $b) =~ tr/[A-Z]/[a-z]/;
  ($a2 cmp $b2);
}

################################################################
sub fold
{
  open(FOLD_FP, "-|") || exec("fold",  @_);
  $answer  = join ("\n",<FOLD>);
}

################################################################
sub print_table
{
  local ($table_sorting,$n_cols,@list) = @_;
  local (@sorted,$item,$split_count);
  local ($n_rows, $n_items,$row, $col, $index);
  local ($n_rows2);

  #--------------------------------------------------
  # init 
  #--------------------------------------------------
  if ($table_sorting)
  {
    @sorted = sort sort_caseinsensitive (@list);
  }
  else
  {
    @sorted = @list
  }
  $n_items = @sorted;

  $n_rows = int($n_items / $n_cols);
  if ( $n_items % $n_cols )
  {
    $n_rows ++;
  }


  #--------------------------------------------------
  # do it
  #--------------------------------------------------
  &table;
  for ($row = 0 ; $row < $n_rows ; $row ++)
  {
    &row;
    for ($col = 0 ; $col < $n_cols ; $col ++)
    {
      $index = ($col * $n_rows) + $row;

      if ($index <= $n_items)
      {
	&data;
	print "$sorted[$index]";
	&_data;
      }
    }
    &_row;
  }
  &_table;

}

################################################################
sub print_radio_table
{
  local ($name,$table_sorting,$n_cols,@list) = @_;
  local (@sorted,$item,$split_count);
  local ($n_rows, $n_items,$row, $col, $index,$item);
  local ($n_rows2);

  #--------------------------------------------------
  # init 
  #--------------------------------------------------
  if ($table_sorting)
  {
    @sorted = sort sort_caseinsensitive (@list);
  }
  else
  {
    @sorted = @list
  }
  $n_items = @sorted;

  $n_rows = int($n_items / $n_cols);
  if ( $n_items % $n_cols )
  {
    $n_rows ++;
  }


  #--------------------------------------------------
  # do it
  #--------------------------------------------------
  &table;
  for ($row = 0 ; $row < $n_rows ; $row ++)
  {
    &row;
    for ($col = 0 ; $col < $n_cols ; $col ++)
    {
      $index = ($col * $n_rows) + $row;

      if ($index <= $n_items)
      {
	$item =  $sorted[$index];
	&data;
	print "<input type=radio name=$name value=\"$item\">$item";
	&_data;
      }
    }
    &_row;
  }
  &_table;

}


################################################################

sub print_text_table
{
  local ($table_sorting,$n_cols,@list) = @_;
  local (@sorted,$item,$split_count, $max_len);
  local ($n_rows, $n_items,$row, $col, $index);
  local ($n_rows2, $max_len, $len);

  $max_len = 0;
  
  #--------------------------------------------------
  # init 
  #--------------------------------------------------
  if ($table_sorting)
  {
    @sorted = sort sort_caseinsensitive (@list);
  }
  else
  {
    @sorted = @list
  }
  $n_items = @sorted;

  $n_rows = int($n_items / $n_cols);
  if ( $n_items % $n_cols )
  {
    $n_rows ++;
  }
  
  #-----------------------find out width of each cell--------------------------
  foreach $item (@sorted)
  {
    $len = length($item);
    if ($len > $max_len) { $max_len = $len;}
  }
  $max_len ++;


  #--------------------------------------------------
  # do it
  #--------------------------------------------------
  for ($row = 0 ; $row < $n_rows ; $row ++)
  {
    print "\n    ";
    for ($col = 0 ; $col < $n_cols ; $col ++)
    {
      $index = ($col * $n_rows) + $row;

      if ($index <= $n_items)
      {  
	 if (	$sorted[$index])
	 {
	   &pad_print_text ($sorted[$index], $max_len);
	 }
      }
    }
  }
  print "\n";
}

################################################################
sub trim
{
   local ($expression) = @_;
   $expression =~ s/^\s+//;
   $expression =~ s/\s+$//;
   $expression =~ s/\s+/ /g;
   $expression =~ tr/[A-Z]/[a-z]/;

   return $expression;
}

################################################################
sub sort_reverse_numerically
{
  ( $b <=> $a);
}

################################################################
sub sort_numerically
{
  ( $a <=> $b);
}

#########################################################
sub unwebify 
{
  local ($in) = @_;
  local (@broken, $char, $out);
  local ($in_string, $in_literal, $in_tag);

  #------------------------init---------------------------
  $in_string = 0;
  $in_literal = 0;
  $in_tag = 0;
  $out = "";

  $in =~ s/\n//g;
  $in =~ s/^\s+//;
  $in =~ s/\s+$//;
  $in =~ s/\s+/ /;
  @broken = split ( // , $in);

  #-------------------------------------------------------
  foreach $char ( @broken)
  {
    # - - - - - - - literal characters take precedence - - - - - 
    if ($in_literal)			
    { 
      $in_literal = 0; 
    }
    elsif ($char eq "\\")		
    {
      $in_literal = 1; 
    }

    # - - - - - - - detection of strings is next - - - - - - - - 
    elsif ($char eq "\"")
    {
      $in_string = ( !$in_string);
    }
    elsif ($in_string )		
    {
      #do nothing, you're in a string
    }


    # - - - neither a literal nor in a string - - - - - - - - - - 
    elsif ($char eq "<")
    {
	$in_tag++;
	$char = "";
    }
    elsif ($char eq ">")
    {
	$in_tag--;
	$char = "";
    }

    if ( ! $in_tag)
    {
      $out .= $char;
    }

  }

  return $out;
}


#########################################################
# get_tag taken from extracttitle from kidofwais.pl
#
# Michael A. Grady</A> (m-grady@uiuc.edu)";
# try and get the <title> ... </title> field from file
# only try to find it in the first 5 lines, and then give up
#########################################################
sub get_tag 
{
  local($filename,$tag) = @_;
  local($value, $read_lines);

  if ( $tag eq "TITLE" )
  {
    $read_lines=5;
  }
  else
  {
    $read_lines=15;
  }

  # ------------read the file and extract the title---------------
  open (FP, "$filename") || return "File $filename can't be read.";
  while (<FP>) 
  {
    if ( $. > $read_lines ) 
    {
      $value = "";
      last; 
    }

    if (/<$tag\s?>(.*)<\/$tag\s?>/i)		#tag on one line
    {
	$value = $1;
	last;
    }
    elsif (/<$tag\s?>(.*)$/i)			#start of tag
    {
	$value = $1;
    }
    elsif (/^(.*)<\/$tag\s?>/i)			#end of tag
    {
	$value .= $1;
	last;
    }
    elsif ($value)				#within a tag
    {
	$value .= $_;
    }
  }
  close (FP);

  # ------------read the file and extract the tag---------------
  $value =~ s/^\s+//; # remove whitespace at front
  $value =~ s/\s+$//; # remove whitespace at end
  return $value;
}

sub newline
{
  print "\n";
}

#########################################################
sub check_user
{
  local ($in_name) = @_;
  local ($line, %userlist);
  local ($p_name, $dummy, $p_fullname, $key);
  local ($found, $upper_fullname, $upper_key);

  #----------------get the list of users---------------
  open ( NAME_FP , "ypcat passwd |");
  while ( $line = <NAME_FP> )
  {
    ($p_name, $dummy, $dummy, $dummy, $p_fullname) = split (/:/, $line);
    if ( $p_fullname !~ "UNPERSON")
    {
      $p_fullname =~ s/;.*$//;
      $userlist{ $p_name} = $p_fullname;
    }
  }
  close(NAME_FP);

  #----------------search user list--------------------
  $in_name =~ tr/[a-z]/[A-Z]/;
  $in_name =~ s/\s+$//;
  $found = "";

  $is_fullname = ( $in_name =~ / /);

  foreach $key ( keys %userlist)
  {
    $upper_key =  $key;
    $upper_key =~ tr/[a-z]/[A-Z]/;

    $upper_fullname =  $userlist{$key};
    $upper_fullname =~ tr/[a-z]/[A-Z]/;

    if (($in_name eq $upper_fullname) || ($in_name eq $upper_key))
    {
      return ($userlist{$key}, $key);
      last;
    }
  }

  return "";
}

1;

