From: short <>
Date: Mon, 3 Jan 2005 01:26:33 +0000 (+0000)
Subject: +&input_hidden_persistents: Implement: %{$W->{"args_persistent"}}
X-Git-Url: http://git.jankratochvil.net/?p=MyWeb.git;a=commitdiff_plain;h=c3e69d62653ccc3f6b18428f2dc36b6d4dbb0d16

+&input_hidden_persistents: Implement: %{$W->{"args_persistent"}}
+&http_moved
---

diff --git a/Web.pm b/Web.pm
index dfd4b48..cdce885 100644
--- a/Web.pm
+++ b/Web.pm
@@ -27,7 +27,7 @@ use Exporter;
 sub Wrequire ($);
 sub Wuse ($@);
 our $W;
-our @EXPORT=qw(&Wrequire &Wuse &a_href &a_href_cz &vskip &img &centerimg &rightimg $W &top_dir &top_dir_disk &Wprint);
+our @EXPORT=qw(&Wrequire &Wuse &a_href &a_href_cz &vskip &img &centerimg &rightimg $W &top_dir &top_dir_disk &Wprint &input_hidden_persistents);
 our @ISA=qw(Exporter Tie::Handle);
 
 BEGIN
@@ -77,6 +77,9 @@ my $have_Geo_IP; BEGIN { $have_Geo_IP=eval { require Geo::IP; 1; }; }
 use ModPerl::Util qw(exit);
 use POSIX qw(strftime);
 use Tie::Handle;
+use Apache::Const qw(HTTP_MOVED_TEMPORARILY);
+use URI;
+use URI::QueryParam;
 
 
 #our $W;
@@ -205,12 +208,13 @@ sub top_dir_disk ()
 	return $INC[0];	# fallback
 }
 
-sub top_dir (;$)
+# $args{"abs"}
+sub top_dir (;$%)
 {
-my($in)=@_;
+my($in,%args)=@_;
 
 	if (my $uri=$W->{"r"}->unparsed_uri()) {
-		if ($W->{"args"}{"Wabs"}) {
+		if ($W->{"args"}{"Wabs"} || $args{"abs"}) {
 			# FIXME: $in may not be defined here!
 			# to prevent: Use of uninitialized value in ...
 			if ($in=~m#^/#) {
@@ -306,6 +310,7 @@ sub footer (;$)
 				."this.elements['msghtml'].value='';"
 				."this.submit();"
 				.'">'."\n";
+			Wprint input_hidden_persistents()."\n";
 			Wprint '<p align="right">'."\n";
 				Wprint '<input name="msgscript" type="hidden" />'."\n";
 				Wprint '<input name="msghtml" type="text" size="32" alt="Message" />'."\n";
@@ -408,6 +413,24 @@ my($url)=@_;
 	return $url!~m#^[a-z]+://#;
 }
 
+sub url_out($%)
+{
+my($url,%args)=@_;
+
+	return if !url_is_local $url;
+	$url=top_dir($url,%args) if $url=~m#^/# || $args{"abs"};
+
+	my $uri=URI->new($url);
+	for my $key (keys(%{$W->{"args_persistent"}})) {
+		my $val=$W->{"args"}{$key};
+		next if !defined $val;
+		$uri->query_param_append($key=>$val);
+		}
+	$url="".$uri;
+
+	return $url;
+}
+
 sub a_href ($;$%)
 {
 my($url,$contents,%args)=@_;
@@ -421,7 +444,7 @@ my($url,$contents,%args)=@_;
 	$contents=~s#<a\b[^>]*>##gi;
 	$contents=~s#</a>##gi;
 
-	$url=top_dir($url) if url_is_local $url && $url=~m#^/#;
+	$url=url_out($url);
 
 	my $r='<a href="';
 	my $urlent=CGI::escapeHTML($url);
@@ -449,6 +472,32 @@ my($url,$contents,%args)=@_;
 	return $r;
 }
 
+sub input_hidden_persistents()
+{
+	return join("",map({
+		my $key=$_;
+		my $val=$W->{"args"}{$key};
+		(!defined $val ? () : '<input type="hidden"'
+				.' name="'.CGI::escapeHTML($key).'"'
+				.' value="'.CGI::escapeHTML($val).'"'
+				.' />'."\n");
+		} (keys(%{$W->{"args_persistent"}}))));
+}
+
+sub http_moved($$;$)
+{
+my($self,$url,$status)=@_;
+
+	$url=url_out($url,"abs"=>1);
+	$status||=Apache::HTTP_MOVED_TEMPORARILY;
+	$W->{"r"}->status($status);
+	$W->{"r"}->header_out("Location"=>$url);
+	$W->{"header_only"}=1;
+	My::Web->heading();
+	exit;
+	die "NOTREACHED";
+}
+
 sub remote_ip ()
 {
 	# Do not: PerlModule                 Apache::ForwardedFor