view release on metacpan or  search on metacpan

t/oddmuse-namespaces.pl  view on Meta::CPAN

When redirection form page A to B, you will never see the link "Edit
this page" at the bottom of page A. Therefore Oddmuse adds a link at
the top of page B (if you arrived there via a redirection), linking to
the edit page for A. C<NewNamespaceBrowsePage> has the necessary code
to make this work for redirections between namespaces. This involves
passing namespace and pagename via the C<oldid> parameter to the next
script invokation, where C<ScriptUrl> will be used to create the
appropriate link. This is where C<NewNamespaceScriptUrl> comes into
play.

=cut

*OldNamespaceBrowsePage = \&BrowsePage;
*BrowsePage = \&NewNamespaceBrowsePage;

sub NewNamespaceBrowsePage {
  #REDIRECT into different namespaces
  my ($id, $raw, $comment, $status) = @_;
  OpenPage($id);
  my ($revisionPage, $revision) = GetTextRevision(GetParam('revision', ''), 1);
  my $text = $revisionPage->{text};
  my $oldId = GetParam('oldid', '');
  if (not $oldId and not $revision and (substr($text, 0, 10) eq '#REDIRECT ')
      and (($WikiLinks and $text =~ /^\#REDIRECT\s+(($InterSitePattern:)?$InterLinkPattern)/)
	   or ($FreeLinks and $text =~ /^\#REDIRECT\s+\[\[(($InterSitePattern:)?$FreeInterLinkPattern)\]\]/))) {
    my ($ns, $page) = map { UrlEncode($_) } split(/:/, FreeToNormal($1));
    $oldId = ($NamespaceCurrent || $NamespacesMain) . ':' . $id;
    local $ScriptName = $NamespaceRoot || $ScriptName;
    print GetRedirectPage("action=browse;ns=$ns;oldid=$oldId;id=$page", $id);
  } else {
    return OldNamespaceBrowsePage(@_);
  }
}

=head2 List Namespaces

The namespaces action will link all known namespaces.

=cut

$Action{namespaces} = \&DoNamespacesList;

sub DoNamespacesList {
  if (GetParam('raw', 0)) {
    print GetHttpHeader('text/plain');
    print join("\n", sort keys %Namespaces), "\n";
  } else {
    print GetHeader('', T('Namespaces')),
      $q->start_div({-class=>'content namespaces'}),
	GetFormStart(undef, 'get'), GetHiddenValue('action', 'browse'),
	  GetHiddenValue('id', $HomePage);
    my $new = $q->textfield('ns') . ' ' . $q->submit('donamespace', T('Go!'));
    print $q->ul($q->li([map { $q->a({-href => $Namespaces{$_} . $HomePage},
				     $_); } sort keys %Namespaces]), $q->li($new));
    print $q->end_form() . $q->end_div();
    PrintFooter();
  }
}

push(@MyAdminCode, \&NamespacesMenu);

sub NamespacesMenu {
  my ($id, $menuref, $restref) = @_;
  push(@$menuref,
       ScriptLink('action=namespaces',
		  T('Namespaces'),
		  'namespaces'));
}

*NamespacesOldGetId = \&GetId;
*GetId = \&NamespacesNewGetId;

sub NamespacesNewGetId {
  my $id = NamespacesOldGetId(@_);
  # http://example.org/cgi-bin/wiki.pl?action=browse;ns=Test;id=Test means NamespaceCurrent=Test and id=Test
  # http://example.org/cgi-bin/wiki.pl/Test/Test means NamespaceCurrent=Test and id=Test
  # In this case GetId() will have set the parameter Test to 1.
  # http://example.org/cgi-bin/wiki.pl/Test?rollback-1234=foo
  # This doesn't set the Test parameter.
  return if $id and $UsePathInfo and $id eq $NamespaceCurrent and not GetParam($id) and not GetParam('ns');
  return $id;
}