package Pm::Redir;

#/
# Client Redirections
#/

use strict;
use warnings;
use CGI::Carp qw(fatalsToBrowser);
use URI::Escape;
use Exporter;
use vars qw($VERSION @ISA @EXPORT_OK);

use Pm::Bc_chef qw(cookie_set);
use Pm::Html qw(display_debug_one
                display_debug_many
                display_debug_code
                display_debug_large
                pre_html_header
               ); # i'm not using :debug cuz that don't work either!

$VERSION     = 1.00;
@ISA         = qw(Exporter);
@EXPORT_OK      = qw(
                     _tests

                     redir
                     redir3
                     error_redir
                     notice_redir
                    );

##############################
sub redir($$) {
  #*
  # redirects a client browser to a specified URL (may include a msg)
  #*
  my ($url, $msg) = @_; # a url to redirect to && a msg
  my $html = pre_html_header();
  $html =~ s/content-type\: text\/html\n\n//i;
  if ($msg)
    { $html .= "status: 302 $msg\n"; } else
    { $html .= "status: 302 redir ok\n"; }
  $html .= "location: $url\n\n";

  return $html; # a scalar
  #usage print redir("/", "invalid page");
}

##############################
sub redir3($$$) {
  #*
  # redirects a client browser to a specified URL (may include a msg)
  # can add a cookie to the redirect (for errors or msgs or other things you deem necessary)
  # this is NOT version 3 of the redir command.  it's a 3 param command!
  #*
  my ($url, $msg, $type) = @_; # a url to redirect to && a msg && a msg type ('e' or 'n', or whatever else you like)
  my $html = "";
  if ($type) { $html = cookie_set($type, $msg, 0); }
  my $html .= pre_html_header();
  $html =~ s/content-type\: text\/html\n\n//i;
  $msg = uri_escape($msg);
  $html .= "status: 302 $msg\n";
  $html .= "location: $url\n\n";

  return $html; # a scalar
  #usage: print redir3("/", "Access Denied by redir3", 'e')
}

##############################
sub error_redir($$) {
  #*
  # redirects a client browser to a specified URL (may include a msg)
  # adds an 'error' cookie to the redirect
  #*
  my ($url, $msg) = @_; # a url to redirect to && a msg
  my $html = redir3($url, $msg . " by?", 'e');

  return $html; # a scalar
  #usage: print error_redir("/subscribe.pl", "you must subscribe to access this area");
}

##############################
sub notice_redir($$) {
  #*
  # redirects a client browser to a specified URL (may include a msg)
  # adds a 'notice' cookie to the redirect
  #*
  my ($url, $msg) = @_; # a url to redirect to && a msg
  my $html = redir3($url, $msg, 'n');

  return $html; # a scalar
  #usage: print notice_redir("/', "file updated!");
}

##############################
sub _tests(;$) {
  #*
  # to test all <i>Pm::Redir</i> functions
  #*
  my ($extended) = @_; # show extended data (optional)
  my $rv = "";
  my $loggedin = cookie_get("loggedin");
  my $test = "";
  my $test2 = "";
  my $test3 = "";
  
  my $db = sql_connect("ns.db");
  if ($db) {
    $test = "/index.pl";
    $test2 = "Test Redirection";
    $test3 = "n";
    $rv .= display_debug_code("error_redir(\"$test\", \"$test2\")", error_redir($test, $test2));
    $rv .= display_debug_code("notice_redir(\"$test\", \"$test2\")", notice_redir($test, $test2));
    $rv .= display_debug_code("redir(\"$test\", \"$test2\")", redir($test, $test2));
    $rv .= display_debug_code("redir3(\"$test\", \"$test2\", \"$test3\")", redir3($test, $test2, $test3));
  } else {
    $rv .= "DB connection error!<br>\n";
  }

  return $rv; # a scalar of the results of all tests
  #usage: print _tests();
}

##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
1;