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

+&http_moved

diff --git a/Web.pm b/Web.pm
index dfd4b48..cdce885 100644 (file)
--- a/Web.pm
+++ b/Web.pm
@@ -27,7 +27,7 @@ use Exporter;
 sub Wrequire ($);
 sub Wuse ($@);
 our $W;
 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
 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 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;
 
 
 #our $W;


@@ -205,12 +208,13 @@ sub top_dir_disk ()
        return $INC[0]; # fallback
 }
 
        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 (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#^/#) {
                        # 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";
                                ."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";
                        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]+://#;
 }
 
        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)=@_;
 sub a_href ($;$%)
 {
 my($url,$contents,%args)=@_;


@@ -421,7 +444,7 @@ my($url,$contents,%args)=@_;
        $contents=~s#<a\b[^>]*>##gi;
        $contents=~s#</a>##gi;
 
        $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);
 
        my $r='<a href="';
        my $urlent=CGI::escapeHTML($url);


@@ -449,6 +472,32 @@ my($url,$contents,%args)=@_;
        return $r;
 }
 
        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
 sub remote_ip ()
 {
        # Do not: PerlModule                 Apache::ForwardedFor