package NILab::CGIUtils;

=head1 NAME

NILab::CGIUtils - A functions for CGI.

=head1 SYNOPSIS

  use NILab::CGIUtils;

  my @lines = (
    "abcde",
    "<br> </br> & ' \"",
    "http://www.nilab.info/",
    "xyzhttp://www.nilab.info/",
    "https://www.nilab.info/",
    "xyzhttps://www.nilab.info/",
    "http://www.nilab.info/ http://nilab.info/index.html こんにちは",
    "http://www.nilab.info/redirect.cgi?http://nilab.info/index.html",
    "http://www.nilab.info/wiki?こんにちは",
    "<a href=http://www.nilab.info/>ホームページ</a>",
    "hello http://localhost/test.cgi?C%B8%C0%B8%EC%A4%C8C%A1%DC%A1%DC%B8%C0%B8%EC good-bye",
  );

  foreach(@lines){
    my $x = $_;
    print "src  : $x\n";
    $x = CGIUtils::html_escape($x);
    print "dest : $x\n";
  }

  # FooBar implements do method.
  #$obj = NILab::Skeleton->new('p1', 'p2');
  $obj = FooBar::new->();

  # for debug
  $obj->{debug} = 1;

  # do foreground job
  #$obj->do();

  # do background job for CGI
  NILab::CGIUtils::do_background_job($obj);

=head1 AUTHOR

NI-Lab. http://www.nilab.info/

=head1 LICENSE

Copyright (c) 2004-2006 NI-Lab. All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 HISTORY

Since: 2004-07-05

2006-03-03
  * fix xhtml_escape : translate ' &#39; not &apos : Ref. http://www.w3.org/TR/xhtml1/ (C.16)

2005-05-19
  * add subroutine xhtml_escape
  * add subroutine xhtml_normalize

2005-05-18
  * fix '<br>' to '<br />' in subroutine html_normalize

2005-05-13
  * change module name CGIUtils to NILab::CGIUtils
  * add subroutine do_background_job

2004-07-05
  * add subroutine html_escape
  * add subroutine html_normalize
  * add subroutine url_encode
  * add subroutine url_decode

=cut

###############################################################################

# use strict;
# use vars qw($VERSION @EXPORT_OK @ISA);
# require Exporter;
# @ISA = qw(Exporter);
# @EXPORT_OK = qw(link_mount html_escape url_encode url_decode);
# $VERSION = '1.0';

###############################################################################

sub html_escape {
  my $s = shift;

  # unifying a new line code (carriage return, line feed)
  # This part is taken from Mr. Ohzaki's Perl Memo(http://www.din.or.jp/~ohzaki/perl.htm).
  $s =~ s/\x0D\x0A|\x0D|\x0A/\n/g;

  # $s = HTML:Entities::encode($s); # case by HTML-Parser

  # character entity references
  $s =~ s/&/&amp;/g;   # ampersand
  $s =~ s/>/&gt;/g;    # greater than
  $s =~ s/</&lt;/g;    # less than
  $s =~ s/"/&quot;/g;  # double quote
  $s =~ s/'/&#39;/g;   # single quote  (for html and xhtml)
  # $s =~ s/'/&apos;/g;  # single quote  (for xml)

  return $s;
}

###############################################################################

sub xhtml_escape {
  my $s = shift;

  # unifying a new line code (carriage return, line feed)
  # This part is taken from Mr. Ohzaki's Perl Memo(http://www.din.or.jp/~ohzaki/perl.htm).
  $s =~ s/\x0D\x0A|\x0D|\x0A/\n/g;

  # $s = HTML:Entities::encode($s); # case by HTML-Parser

  # character entity references
  $s =~ s/&/&amp;/g;   # ampersand
  $s =~ s/>/&gt;/g;    # greater than
  $s =~ s/</&lt;/g;    # less than
  $s =~ s/"/&quot;/g;  # double quote
  $s =~ s/'/&#39;/g;   # single quote  (for html and xhtml)
  # $s =~ s/'/&apos;/g;  # single quote  (for xml)

  return $s;
}

###############################################################################

sub html_normalize {
  my ($line) = @_;

  $line = &html_escape($line);

  $line =~ s/\n/<br \/>/g;

  # This part is taken from YukiWiki(http://www.hyuki.com/yukiwiki/).
  $line =~ s/((http|https|ftp):([^\x00-\x20()<>\x7F-\xFF])*)/<a href=\"$1\">$1<\/a>/go;

  return $line;
}

###############################################################################

sub xhtml_normalize {
  my ($line) = @_;

  $line = &xhtml_escape($line);

  $line =~ s/\n/<br \/>/g;

  # This part is taken from YukiWiki(http://www.hyuki.com/yukiwiki/).
  $line =~ s/((http|https|ftp):([^\x00-\x20()<>\x7F-\xFF])*)/<a href=\"$1\">$1<\/a>/go;

  return $line;
}

###############################################################################

sub url_encode {
  my $s = shift;
  # This part is taken from Mr. Ohzaki's Perl Memo(http://www.din.or.jp/~ohzaki/perl.htm).
  $s =~ s/([^\w ])/'%' . unpack('H2', $1)/eg;
  $s =~ tr/ /+/;
  return $s;
}

###############################################################################

sub url_decode {
  my $s = shift;
  # This part is taken from Mr. Ohzaki's Perl Memo(http://www.din.or.jp/~ohzaki/perl.htm).
  $s =~ tr/+/ /;
  $s =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg;
  return $s;
}

###############################################################################

sub do_background_job {
  #my $re_obj = shift;
  #my $obj    = %{re_obj};
  my $obj     = shift;

  $| = 1; # configure buffering output

  if($pid = fork){
    # for parent process
    close(STDOUT); # end of output for http response to web browser
    wait; # wait for end of child's process
    return 1;
  }elsif (defined $pid){
    # for child process
    close(STDOUT); # end of output for http response to web browser
    $obj->do(); # long transaction
    return 2;
  } else {
    # for failed to fork
    return 0;
  }
}

###############################################################################

# interested character entity references memo

# &#9745; checkbox
# &#9760; death's-head

1;