andy-ext.pl

AndyChat 是一种用Perl 来编写的多协议的控制台聊天程序。它的目的在于提供一种共同的控制台界面

#!/usr/bin/perl
#
# 8th of April, 2000
# -  (2.20pm) Cleaned up variables a bit (more use of my())
#

sub datest {
	my ($p1) = @_;
	if ($p1 eq 0)
	{
		return 0;
	}
	elsif ((($p1 >= 4) && ($p1 <= 20)) || ((substr($p1, -1, 1) >= 4) && (substr($p1, -1, 1) <= 9)) || (substr($p1, -1, 1) eq 0))
	{
		return "$p1$+th";
	}
	elsif (substr($p1, -1, 1) eq "1")
	{
		return "$p1$+st";
	}
	elsif (substr($p1, -1, 1) eq "2")
	{
		return "$p1$+nd";
	}
	elsif (substr($p1, -1, 1) eq "3")
	{
		return "$p1$+rd";
	}
}

sub mmoney {
	my ($p1) = @_;

	if (! $p1 || $p1 eq 0)
	{
		$p1 = "0.00";
	}
	elsif (! index($p1, ".") || index($p1, ".") < 0)
	{
		$p1 = $p1 . ".00";
	}
	elsif (index($p1, ".") eq length($p1) - 1)
	{
		$p1 = $p1 . "00";
	}
	elsif (index($p1, ".") eq length($p1) - 2)
	{
		$p1 = $p1 . "0";
	}
	elsif (index($p1, ".") < length($p1) - 3)
	{
		$p1 = substr($p1, 0, index($p1, ".") + 2);
	}
	return "$p1";
}

sub weblspace {
	my ($p2, $p3) = @_;
        my $z;

	if (length($p2) >= $p3)
	{
		return $p2;
	}
	else
	{
		my $v3 = ""; my $v4 = length($p2);
		for ($z = $v4; $z < $p3; $z++)
		{
			if ($v3 eq "")
			{
				$p2 = " $p2";
				$v3 = "TRUE";
			}
			else
			{
				$p2 = "&nbsp;$p2";
				$v3 = "";
			}
		}
	}
	return $p2;
}

sub monthstr {
        my ($p1) = @_;
        if ($p1 eq "01")  
        {
                return "Jan";
        }
        elsif ($p1 eq "02")
        {
                return "Feb";
        }       
        elsif ($p1 eq "03")
        {
                return "Mar";
        }
        elsif ($p1 eq "04")
        {
                return "Apr";
        }
        elsif ($p1 eq "05")
        {
                return "May";
        }
        elsif ($p1 eq "06")
        {
                return "Jun";
        }
        elsif ($p1 eq "07")
        {
                return "Jul";
        }
        elsif ($p1 eq "08")
        {
                return "Aug";
        }
        elsif ($p1 eq "09")
        {
                return "Sep";
        }
        elsif ($p1 eq "10")
        {
                return "Oct";
        }
        elsif ($p1 eq "11")
        {
                return "Nov";
        }
        elsif ($p1 eq "12")
        {
                return "Dec";
        }
        else
        {
                return "Unk";
        }
}

sub fmonthstr {
        my ($p1) = @_;
	$p1 = lc($p1);
        if (($p1 eq "01") || ($p1 eq "jan"))
        {
                return "January";
        }
        elsif (($p1 eq "02") || ($p1 eq "feb"))
        {
                return "February";
        }       
        elsif (($p1 eq "03") || ($p1 eq "mar"))
        {
                return "March";
        }
        elsif (($p1 eq "04") || ($p1 eq "apr"))
        {
                return "April";
        }
        elsif (($p1 eq "05") || ($p1 eq "may"))
        {
                return "May";
        }
        elsif (($p1 eq "06") || ($p1 eq "jun"))
        {
                return "June";
        }
        elsif (($p1 eq "07") || ($p1 eq "jul"))
        {
                return "July";
        }
        elsif (($p1 eq "08") || ($p1 eq "aug"))
        {
                return "August";
        }
        elsif (($p1 eq "09") || ($p1 eq "sep"))
        {
                return "September";
        }
        elsif (($p1 eq "10") || ($p1 eq "oct"))
        {
                return "October";
        }
        elsif (($p1 eq "11") || ($p1 eq "nov"))
        {
                return "November";
        }
        elsif (($p1 eq "12") || ($p1 eq "dec"))
        {
                return "December";
        }
        else
        {
                return "Unknown Month";
        }
}

sub nsuffix {
	my ($p1) = @_;
	if (substr($p1, -1, 1) eq "0")
	{
		return "$p1$+th";
	}
	elsif (($p1 > 3) && ($p1 < 21))
	{
		return "$p1$+th";
	}
	elsif (substr($p1, -1, 1) eq "1")
	{
		return "$p1$+st";
	}
	elsif (substr($p1, -1, 1) eq "2")
	{
		return "$p1$+nd";
	}
	elsif (substr($p1, -1, 1) eq "3")
	{
		return "$p1$+rd";
	}
	else
	{
		return "$p1$+th";
	}
}

sub makedateof {
	my ($p1) = @_;
        my ($p2, $p3, $p4);

	$p4 = substr($p1, 0, 4);
	$p3 = monthstr(substr($p1, 4, 2));
	$p2 = nsuffix(substr($p1, 6, 2));
	return "$p2 $p3 $p4";
}

sub makefulldateof {
	my ($p1) = @_;
        my ($p2, $p3, $p4);

	$p4 = substr($p1, 0, 4);
	$p3 = fmonthstr(substr($p1, 4, 2));
	$p2 = nsuffix(substr($p1, 6, 2));
	return "$p2 of $p3, $p4";
}

sub readablesecs {
  my ($p1) = @_;

  # 60 = 1 minute, 3600 = 1 hour, 86400 = 1 day, 604800 = 1 week
  my $ras_weeks = 0; my $ras_days = 0; my $ras_hours = 0; my $ras_mins = 0;

  while ($p1 >= 604800)
  {
    $ras_weeks++;
    $p1 = $p1 - 604800;
  }
  while ($p1 >= 86400)
  {
    $ras_days++;
    $p1 = $p1 - 86400;
  }
  while ($p1 >= 3600)
  {
    $ras_hours++;
    $p1 = $p1 - 3600;
  }
  while ($p1 >= 60)
  {
    $ras_mins++;
    $p1 = $p1 - 60;
  }
  if ($p1 > 0) { $ras_secs = $p1; } else { $ras_secs = 0; }
  $p1 = "";
  if ($ras_weeks > 0)
  {
    $p1 = $p1 . $ras_weeks . " weeks";
  }
  if ($ras_days > 0)
  {
    if ($p1)
    {
      $p1 = $p1 . " ";
    }
    $p1 = $p1 . $ras_days . " days";
  }
  if ($ras_hours > 0)
  {
    if ($p1)
    {
      $p1 = $p1 . " ";
    }
    $p1 = $p1 . $ras_hours . " hours";
  }
  if ($ras_mins > 0)
  {
    if ($p1)
    {
      $p1 = $p1 . " ";
    }
    $p1 = $p1 . $ras_mins . " mins";
  }
  if ($ras_secs > 0)
  {
    if ($p1)
    {
      $p1 = $p1 . " ";
    }
    $p1 = $p1 . $ras_secs . " secs";
  }
  return $p1;
}

sub alphan {
	my ($p1, $p2) = @_;
	
        my $zto;

	if (length($p2) > length($p1))
	{
		$zto = length($p1);
	}
	else
	{
		$zto = length($p2);
	}
	for ($z = 0; $z < $zto; $z++)
	{
		my $z1 = substr($p1, $z, 1);
		my $z2 = substr($p2, $z, 1);
		if (ord($z1) > ord($z2))
		{
			return 2;
		}
		elsif (ord($z2) > ord($z1))
		{
			return 1;
		}
	}
	if (length($p1) > length($p1))
	{
		return 2;
	}
	else
	{
		return 1;
	}
}

sub htmlfriendly {
	my ($z1) = @_;

	my $z2 = "";
        my $z3;

	if ($z1 ne "")
	{
		for ($z = 0; $z < length($z1); $z++)
		{
			$z3 = substr($z1, $z, 1);
			if ($z3 eq ";")
			{
				$z2 = "$z2,";
			}
			elsif ($p3 eq "<")
			{
				$z2 = "$z2(";
			}
			elsif ($p3 eq ">")
			{
				$z2 = "$z2)";
			}
#			elsif ($p3 eq "&")
#			{
#				$z2 = $z2 and ";
#			}
			else
			{
				$z2 = "$z2$z3";
			}
		}
	}
	return $z2;
}


sub strpadd {
	my ($z1, $z2, $z3) = @_;

#	if (! $z1 || $z2 <= length($z1) || ! $z3)
	if ($z2 <= length($z1) || $z3 eq "")
	{
		return $z1;
	}
	else
	{
		while (length($z1) < $z2)
		{
			$z1 = "$z1$z3";
		}
		return $z1;
	}
}

sub ltrim {
  my ($z1) = @_;
  while ($z1 =~ /^ /)
  {
    $z1 = substr($z1, 1);
  }
  return $z1;
}

sub rtrim {
  my ($z1) = @_;
  while ($z1 =~ / $/)
  {
    $z1 = substr($z1, 0, -1);
  }
  return $z1;
}

sub qbDATE {
  my @y1 = localtime(time);

  $y1[4] = $y1[4] + 1;
  $y1[5] = $y1[5] + 1900;

  return strpadd("", 2 - length($y1[3]), "0") . "$y1[3]-" . strpadd("", 2 - length($y1[4]), "0") . "$y1[4]-$y1[5]";
}

sub qbTIME {
  my @y1 = localtime(time);

  return strpadd("", 2 - length($y1[2]), "0") . "$y1[2]:" . strpadd("", 2 - length($y1[1]), "0") . "$y1[1]:" . strpadd("", 2 - length($y1[0]), "0") . $y1[0];
}

sub SPACEs {
  my ($y1) = @_;

  return strpadd("", $y1, " ");
}

sub makekbmbgb {
  my ($y1, $y2, $y3, $y4) = @_;

  my (@yy) = (" b", "Kb", "Mb", "Gb", "Tb");

  if ($y2)
  {
    $y1 = $y1 / ($y2 * 3);
  }
  else
  {
    $y2 = 0;
    while ($y1 > 999)
    {
      $y1 = $y1 / 1024;
      $y2++;
    }
  }

  if ($y2 eq 0)
  {
    $y1 = $y1 . ".";
  }

  if ($y3 && length($y1) >= $y3)
  {
    $y1 = substr($y1, 0, $y3);
  }
  elsif ($y3)
  {
    $y1 = strpadd($y1, $y3, "0");
  }

  if ($y4)
  {
    $y1 = $y1 . " " . $yy[$y2];
  }

  return ($y1, $y2);
}