package AmphetaDesk::Utilities;
###############################################################################
# AmphetaDesk                                           (c) 2000-2002 Disobey #
# morbus@disobey.com                      http://www.disobey.com/amphetadesk/ #
###############################################################################
# ABOUT THIS PACKAGE:                                                         #
#   This package contains all the minor utilities needed through out Ampheta, #
#   like logging, newline removable, HTML removal, and so on. None of these   #
#   routines require knowledge of the AmphetaDesk SETTINGS, so use freely.    #
#                                                                             #
# LIST OF ROUTINES BELOW:                                                     #
#   encode_to_dec - encodes certain characters into decimal equivalents.      #
#   get_response - returns the currently saved response array.                #
#   note and error - send a message to our logfile.                           #
#   set_response - sets the response to user action in an array.              #
#   strip_newlines_and_tabs - strips all newlines and tabs from incoming.     #
###############################################################################
#      "Use freely? Bah! Wait until the RIAA gets their hands on it."         #
###############################################################################

use strict; $|++;
use URI::Escape;
require Exporter;
use vars qw( @ISA @EXPORT );
@ISA = qw( Exporter );
@EXPORT = qw( encode_to_dec error get_response note
              set_response strip_newlines_and_tabs );

# where we store responses that should be shown
# to the user based on their requested action.
# see the get_ and set_response routines.
my @RESPONSES;

###############################################################################
# encode_to_dec - encodes certain characters into decimal equivalents.        #
###############################################################################
# USAGE:                                                                      #
#    $modified = encode_to_dec( $data );                                      #
#                                                                             #
# NOTES:                                                                      #
#    Used to encode non-alphanumerics to decimal equivalents (like %20).      #
#                                                                             #
# RETURNS:                                                                    #
#    $modified; the modified data, with non-alphanumerics encoded.            #
###############################################################################

sub encode_to_dec {
   my ($toencode) = @_; # what's a toe ncode? horrible hangnail?
   $toencode = uri_escape($toencode, "^a-zA-Z0-9_.-");
   return $toencode; # what sort of song are we singing to enc?
}

###############################################################################
# get_response - returns the currently saved response array.                  #
# set_response - sets the response to user action in an array.                #
###############################################################################
# USAGE:                                                                      #
#    my @answers = get_response( );                                           #
#    set_response( "You've successfully added a channel!" );                  #
#                                                                             #
# NOTES:                                                                      #
#    Returns the currently saved response, which is used for displaying       #
#    diagnostic messages in the browser window (either in normal template     #
#    pages, or in a javascript popup window. set_response will save a new     #
#    response. get_response will remove the saved response(s) once retrieved. #
#                                                                             #
#    One way of handling the response is:                                     #
#        my $response = join("<br />", get_response());                       #
#                                                                             #
# RETURNS:                                                                    #
#    $value; the value of the passed or set.                                  #
#    undef; if the setting doesn't exist or isn't defined.                    #
###############################################################################

sub get_response {
   my @responses = @RESPONSES;
   undef @RESPONSES; # read once.
   return @responses;
}

sub set_response {
   my ($response) = @_;
   push (@RESPONSES, $response);
}

###############################################################################
# note and error - send a message to our logfile.                             #
###############################################################################
# USAGE:                                                                      #
#   note("This is a logged line. Yup.");          sends to logfile.           #
#   note("This is a logged line. Yup.", 1);     sends to gui window also.     #
#   note("This is added to @RESPONSES", 1, 1); add to our responses array.    #
#   error("This is an error!");                  die after logging.           #
#                                                                             #
# NOTES:                                                                      #
#   You may use note to write a note to the gui window and LOG, and return    #
#   happily. Whatever happens in the GUI portion is controlled by those       #
#   libraries. error reaches into note, and exits the script when finished.   #
#                                                                             #
# RETURNS:                                                                    #
#   1; if the log was successfully written to.                                #
###############################################################################

sub note {

   my ($message, $gui, $response) = @_;

   # what time is it, kenneth?
   my ($sec, $min, $hour) = localtime;
   $sec = sprintf "%02.0d", $sec;
   $min = sprintf "%02.0d", $min;
   $hour = sprintf "%02.0d", $hour;

   # print the entry to our log file.
   print LOG "[$hour:$min:$sec] $message\n";

   # and save the message in our response log
   # if the message is also being sent to the gui.
   set_response($message) if $response;

   # if we've been told to pass it to our GUI, do so.
   # see cookbook 12.13. there are probably better
   # and smarter ways to do this, but I'm fed up.
   {
      no strict 'refs'; my $os;
      $os = "MacOSX"  if $^O =~ /darwin/;
      $os = "MacOS"   if $^O =~ /Mac/;
      $os = "Windows" if $^O =~ /Win/;
      $os = "Linux" unless defined $os;
      my $packname = "AmphetaDesk::OS::";
      my $funcname = "::gui_note";
      &{ $packname. $os . $funcname }($message) if $gui;
   }

   return 1;

}

sub error {

   my ($message) = @_;

   # send everywhere.
   note($message);

   # if we've been told to pass it to our GUI, do so.
   # see cookbook 12.13. there are probably better
   # and smarter ways to do this, but I'm fed up.
   { 
      no strict 'refs'; my $os;
      $os = "MacOS"   if $^O =~ /Mac/;
      $os = "Windows" if $^O =~ /Win/;
      $os = "Linux" unless defined $os;
      my $packname = "AmphetaDesk::OS::";
      my $funcname = "::gui_note";
      &{ $packname. $os . $funcname }($message);
   }

   # we sleep for 10 seconds so that the 
   # error message is seen by someone.
   sleep 10;

   exit;

}

###############################################################################
# strip_newlines_and_tabs - strips all newlines and tabs from incoming.       #
###############################################################################
# USAGE:                                                                      #
#    $modified = strip_newlines_and_tabs( $data );                            #
#                                                                             #
# NOTES:                                                                      #
#    This routine removes newlines and tabs from the passed data. It can      #
#    dip into arrays, single level hashes, and normal variables. It replaces  #
#    all newlines and tabs with a single space character.                     #
#                                                                             #
# RETURNS:                                                                    #
#    $modified; the modified data, sans newlines and tabs.                    #
###############################################################################

sub strip_newlines_and_tabs {

   my ($data) = @_;

   # depending on our data type,
   # process it differently.
   if (ref($data) eq "HASH") {
      foreach ( keys %{ $data } ) {
         next if not defined( $data->{$_} );
         $data->{$_} =~ s/\n|\r|\f|\t/ /g if defined $data;
      }
   }
   elsif (ref($data) eq "ARRAY") {
      foreach ( @ { $data } ) {
         next if not defined( $data->[$_] );
         $data->[$_] =~ s/\n|\r|\f|\t/ /g  if defined $data;
      }
   }
   else {
      $data =~ s/\n|\r|\f|\t/ /g if defined $data;
   }

   return $data;

}

1;