sub Wrequire ($);
sub Wuse ($@);
our $W;
-our @EXPORT=qw(&Wrequire &Wuse &a_href &a_href_cz &vskip &img ¢erimg &rightimg $W &top_dir &top_dir_disk &Wprint);
+our @EXPORT=qw(&Wrequire &Wuse &a_href &a_href_cz &vskip &img ¢erimg &rightimg $W &top_dir &top_dir_disk &Wprint &input_hidden_persistents);
our @ISA=qw(Exporter Tie::Handle);
BEGIN
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;
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#^/#) {
."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";
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)=@_;
$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);
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