view release on metacpan or  search on metacpan

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

}

sub GetId {
  my $id = UnquoteHtml(GetParam('id', GetParam('title', ''))); # id=x or title=x -> x
  if (not $id and $q->keywords) {
    $id = decode_utf8(join('_', $q->keywords)); # script?p+q -> p_q
  }
  if ($UsePathInfo and $q->path_info) {
    my @path = map { decode_utf8($_) } split(/\//, $q->path_info);
    $id ||= pop(@path); # script/p/q -> q
    foreach my $p (@path) {
      SetParam($p, 1);    # script/p/q -> p=1
    }
  }
  return $id;
}

sub DoBrowseRequest {
  # We can use the error message as the HTTP error code
  ReportError(Ts('CGI Internal error: %s', $q->cgi_error), $q->cgi_error) if $q->cgi_error;
  print $q->header(-status=>'304 NOT MODIFIED') and return if PageFresh(); # return value is ignored
  my $id = GetId();
  my $action = lc(GetParam('action', '')); # script?action=foo;id=bar
  $action = 'download' if GetParam('download', '') and not $action; # script/download/id
  if ($Action{$action}) {
    &{$Action{$action}}($id);
  } elsif ($action and defined &MyActions) {
    eval { local $SIG{__DIE__}; MyActions(); };
  } elsif ($action) {
    ReportError(Ts('Invalid action parameter %s', $action), '501 NOT IMPLEMENTED');
  } elsif (GetParam('search', '') ne '') { # allow search for "0"
    SetParam('action', 'search'); # make sure this gets a NOINDEX
    DoSearch();
  } elsif (GetParam('match', '') ne '') {
    SetParam('action', 'index'); # make sure this gets a NOINDEX
    DoIndex();
  } elsif (GetParam('title', '') and not GetParam('Cancel', '')) {
    DoPost(GetParam('title', ''));
  } else {
    BrowseResolvedPage($id || $HomePage);  # default action!
  }
}

sub ValidId { # hack alert: returns error message if invalid, and unfortunately the empty string if valid!
  my $id = FreeToNormal(shift);
  return T('Page name is missing') unless $id;
  require bytes;
  return Ts('Page name is too long: %s', $id) if bytes::length($id) > $PageNameLimit;
  return Ts('Invalid Page %s (must not end with .db)', $id) if $id =~ m|\.db$|;
  return Ts('Invalid Page %s (must not end with .lck)', $id) if $id =~ m|\.lck$|;
  return Ts('Invalid Page %s', $id) if $FreeLinks ? $id !~ m|^$FreeLinkPattern$| : $id !~ m|^$LinkPattern$|;
}

sub ValidIdOrDie {
  my $id = shift;
  my $error = ValidId($id);
  ReportError($error, '400 BAD REQUEST') if $error;
  return 1;
}

sub ResolveId { # return css class, resolved id, title (eg. for popups), exist-or-not
  my $id = shift;
  return ('local', $id, '', 1) if $IndexHash{$id};
  return ('', '', '', '');
}

sub BrowseResolvedPage {
  my $id = FreeToNormal(shift);
  my ($class, $resolved, $title, $exists) = ResolveId($id);
  if ($class and $class eq 'near' and not GetParam('rcclusteronly', 0)) { # nearlink (is url)
    print $q->redirect({-uri=>$resolved});
  } elsif ($class and $class eq 'alias') { # an anchor was found instead of a page
    ReBrowsePage($resolved);
  } elsif (not $resolved and $NotFoundPg and $id !~ /$CommentsPattern/) { # custom page-not-found message
    BrowsePage($NotFoundPg);
  } elsif ($resolved or $id =~ /$CommentsPattern/ and $1 and $IndexHash{$1}) { # an existing page
    BrowsePage(($resolved or $id), GetParam('raw', 0));
  } else {      # new page!
    BrowsePage($id, GetParam('raw', 0), undef, '404 NOT FOUND') if ValidIdOrDie($id);
  }
}

sub NewText { # only if no revision is available
  my $id = shift;
  if ($CommentsPrefix and $id =~ /^($CommentsPrefix)/) {
    return T('There are no comments, yet. Be the first to leave a comment!');
  } elsif ($id eq $HomePage) {
    return T('Welcome!');
  } else {
    return Ts('This page does not exist, but you can %s.',
              '[' . ScriptUrl('action=edit;id=' . UrlEncode($id)) . ' '
              . T('create it now') . ']');
  }
}

sub BrowsePage {
  my ($id, $raw, $comment, $status) = @_;
  OpenPage($id);
  my ($revisionPage, $revision) = GetTextRevision(GetParam('revision', ''));
  my $text    = $revisionPage->{text};
  $text = NewText($id) unless $revision or $Page{revision} or $comment; # new text for new pages
  # handle a single-level redirect
  my $oldId = GetParam('oldid', '');
  if ((substr($text, 0, 10) eq '#REDIRECT ')) {
    if ($oldId) {
      $Message .= $q->p(T('Too many redirections'));
    } elsif ($revision) {
      $Message .= $q->p(T('No redirection for old revisions'));
    } elsif (($FreeLinks and $text =~ /^\#REDIRECT\s+\[\[$FreeLinkPattern\]\]/)
       or ($WikiLinks and $text =~ /^\#REDIRECT\s+$LinkPattern/)) {
      return ReBrowsePage(FreeToNormal($1), $id);
    } else {
      $Message .= $q->p(T('Invalid link pattern for #REDIRECT'));
    }
  }
  # shortcut if we only need the raw text: no caching, no diffs, no html.
  if ($raw) {
    print GetHttpHeader('text/plain', $Page{ts}, $IndexHash{$id} ? undef : '404 NOT FOUND');
    print $Page{ts} . " # Do not delete this line when editing!\n" if $raw == 2;
    print $text;
    return;