package Martian::Toolkit;

$VERSION = "0.0a";
require 5.004;
require Exporter;

@ISA = qw(Exporter);
@EXPORT = qw(mysplit in urlize unurlize istrue typeof copyhash makelist mapfield sgmlify unsgmlify);


sub mysplit {
  my($sep, $text) = @_;
  chomp $text;
  my(@f)=();
  while($text && ($text =~ m!^("[^"]*?")$! || $text =~ m!^('[^']*?')$! || $text =~ m!^([^$sep]*?)$! || $text =~ m!^("[^"]*?")$sep! || $text =~ m!^('[^']*?')$sep! || $text =~ m!^([^$sep]*?)$sep!)) {
    @f = (@f, $1);
    if($text =~ m!^"[^"]*?"$!) {
      $text =~ s!^"[^"]*?"$!!;
    } elsif($text =~ m!^'[^']*?'$!) {
      $text =~ s!^'[^']*?'$!!;
    } elsif($text =~ m!^[^$sep]*?$!) {
      $text =~ s!^^[^$sep]*?$!!;
    } elsif($text =~ m!^"[^"]*?"$sep!) {
      $text =~ s!^"[^"]*?"$sep!!;
    } elsif($text =~ m!^'[^']*?'$sep!) {
      $text =~ s!^'[^']*?'$sep!!;
    } elsif($text =~ m!^[^$sep]*?$sep!) {
      $text =~ s!^^[^$sep]*?$sep!!;
    }
  }
  @f = (@f, $text) if $text;
  return @f;
}

sub in {
  my($val, @list) = @_;
  my $i;
  my $stringmode = ($val == "foo" && $val ne "foo");
  for($i=0; $i<=$#list; $i++) {
    return $i if (($stringmode && (uc($list[$i]) eq uc($val))) || (!$stringmode && ($list[$i] == $val)));
  }
  return -1;
}

sub urlize {
  my($s) = @_;  
  $s =~ s!(\`|\@|\!|\#|\$|\%|\^|\&|\(|\)|\=|\\|\+|\||\[|\]|\{|\}|\;|\'|\:|\"|\,|\/|\<|\>|\?)!sprintf("%%%2.2x", ord($1))!eg;
  $s =~ s! !+!g;
  return $s;
}

sub unurlize {
    my($todecode) = @_;
    $todecode =~ tr/+/ /;       # pluses become spaces
    $todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
    return $todecode;
}

sub istrue {
  local($ref) = @_;
  $type = &typeof($ref);
  if($type eq "VALUE") {
    return !!$ref;
  } elsif($type eq "SCALAR") {  
    return !!$$ref;
  } elsif($type eq "ARRAY") {
    local(@a) = @$ref;
    return !!(scalar(@arr));
  } elsif($type eq "HASH") { 
    local(%h) = %$ref;
    return !!(scalar(%h));
  }
}

sub typeof {
  local($ref) = @_;
  local($r) = ref($ref);
  $r = "VALUE" unless $r;
  local($s) = sprintf("%s", $r);
  return $s;
}

sub copyhash {
  local($ref) = @_;
  local(%theirhash) = %$ref;
  local(%myhash);
  foreach $key (keys(%theirhash)) {
    $myhash{$key} = $theirhash{$key};
  }
  return \%myhash;
}

sub makelist {
  my($len) = shift;
  my($value) = 0; $value = shift if @_;
  for(;$len>0;$len--) {
    @list = (@list, $value);
  }
  return @list;
}

sub mapfield {
  my($ref, @fields) = @_;
  my(@v) = ();
  for $field (@fields) {   
    @v=(@v, $$ref{$field});
  }
  return @v;  
}

# Escape XML-invalid characters
sub sgmlify {
    my($todecode) = @_;
    $todecode =~ s/\&/\&amp\;/g;
    $todecode =~ s/\</\&lt\;/g;
    $todecode =~ s/\>/\&gt\;/g;
    return $todecode;
}

# Unescape XML-invalid characters
sub unsgmlify {
    my($todecode) = @_;
    $todecode =~ s/\&gt\;/\>/g;
    $todecode =~ s/\&lt\;/\</g;
    $todecode =~ s/\&amp\;/\&/g;
    return $todecode;
}