view release on metacpan or  search on metacpan

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

}

sub GetRCLink {
  my ($id, $text) = @_;
  return ScriptLink('action=rc;all=1;from=1;showedit=1;rcidonly='
		    . UrlEncode(FreeToNormal($id)), $text, 'rc');
}

sub GetHeader {
  my ($id, $title, $oldId, $nocache, $status) = @_;
  my $embed = GetParam('embed', $EmbedWiki);
  my $result = GetHttpHeader('text/html', $nocache, $status);
  if ($oldId) {
    $Message .= $q->p('(' . Ts('redirected from %s', GetEditLink($oldId, $oldId)) . ')');
  }
  $result .= GetHtmlHeader(Ts('%s:', $SiteName) . ' ' . UnWiki($title), $id);
  if ($embed) {
    $result .= $q->div({-class=>'header'}, $q->div({-class=>'message'}, $Message)) if $Message;
    return $result;
  }
  $result .= GetHeaderDiv($id, $title, $oldId, $embed);
  return $result . $q->start_div({-class=>'wrapper'});
}

sub GetHeaderDiv {
  my ($id, $title, $oldId, $embed) = @_;
  my $result .= '<header>';
  if (not $embed and $LogoUrl) {
    my $url = $IndexHash{$LogoUrl} ? GetDownloadLink($LogoUrl, 2) : $LogoUrl;
    $result .= ScriptLink(UrlEncode($HomePage), $q->img({-src=>$url, -alt=>T('[Home]'), -class=>'logo'}), 'logo');
  }
  $result .= '<nav>';
  if (GetParam('toplinkbar', $TopLinkBar) != 2) {
    $result .= GetGotoBar($id);
    if (%SpecialDays) {
      my ($sec, $min, $hour, $mday, $mon, $year) = gmtime($Now);
      if ($SpecialDays{($mon + 1) . '-' . $mday}) {
	$result .= $q->br() . $q->span({-class=>'specialdays'},
				       $SpecialDays{($mon + 1) . '-' . $mday});
      }
    }
  }
  $result .= GetSearchForm() if GetParam('topsearchform', $TopSearchForm) != 2;
  $result .= '</nav>';
  $result .= $q->div({-class=>'message'}, $Message) if $Message;
  $result .= GetHeaderTitle($id, $title, $oldId);
  $result .= '</header>';
  return $result;
}

sub GetHeaderTitle {
  my ($id, $title, $oldId) = @_;
  return $q->h1($title) if $id eq '';
  return $q->h1(GetSearchLink($id, '', '', T('Click to search for references to this page')));
}

sub GetHttpHeader {
  return if $HeaderIsPrinted; # When calling ReportError, we don't know whether HTTP headers have
  $HeaderIsPrinted = 1;       # already been printed. We want them printed just once.
  my ($type, $ts, $status, $encoding) = @_;
  $q->charset($type =~ m!^(text/|application/xml)! ? 'utf-8' : ''); # text/plain, text/html, application/xml: UTF-8
  my %headers = (-cache_control=>($UseCache < 0 ? 'no-cache' : 'max-age=10'));
  # Set $ts when serving raw content that cannot be modified by cookie
  # parameters; or 'nocache'; or undef. If you provide a $ts, the last-modified
  # header generated will by used by HTTP/1.0 clients. If you provide no $ts,
  # the etag header generated will be used by HTTP/1.1 clients. In this
  # situation, cookie parameters can influence the look of the page and we
  # cannot rely on $LastUpdate. HTTP/1.0 clients will ignore etags. See RFC 2616
  # section 13.3.4.
  if (GetParam('cache', $UseCache) >= 2 and $ts ne 'nocache') {
    $headers{'-last-modified'} = TimeToRFC822($ts) if $ts;
    $headers{-etag} = PageEtag();
  }
  $headers{-type} = GetParam('mime-type', $type);
  $headers{-status} = $status if $status;
  $headers{-Content_Encoding} = $encoding if $encoding;
  my $cookie = Cookie();
  $headers{-cookie} = $cookie if $cookie;
  if ($q->request_method() eq 'HEAD') {
    print $q->header(%headers), "\n\n"; # add newlines for FCGI because of exit()
    exit; # total shortcut -- HEAD never expects anything other than the header!
  }
  return $q->header(%headers);
}

sub CookieData {
  my ($changed, %params);
  foreach my $key (keys %CookieParameters) {
    my $default = $CookieParameters{$key};
    my $value = GetParam($key, $default);
    $params{$key} = $value if $value ne $default;
    # The cookie is considered to have changed under the following
    # condition: If the value was already set, and the new value is
    # not the same as the old value, or if there was no old value, and
    # the new value is not the default.
    my $change = (defined $OldCookie{$key} ? ($value ne $OldCookie{$key}) : ($value ne $default));
    $changed = 1 if $change; # note if any parameter changed and needs storing
  }
  return $changed, %params;
}

sub Cookie {
  my ($changed, %params) = CookieData(); # params are URL encoded
  if ($changed) {
    my $cookie = join(UrlEncode($FS), %params); # no CTL in field values
    return $q->cookie(-name=>$CookieName, -value=>$cookie, -expires=>'+2y', secure=>$ENV{'HTTPS'}, httponly=>1);
  }
  return '';
}

sub GetHtmlHeader {   # always HTML!
  my ($title, $id) = @_;
  my $edit_link = $id ? '<link rel="alternate" type="application/wiki" title="'
      . T('Edit this page') . '" href="' . ScriptUrl('action=edit;id=' . UrlEncode($id)) . '" />' : '';
  my $theme = GetParam('theme', 'default');
  return $DocumentHeader
      . $q->head($q->title($title) . $edit_link
		 . GetCss() . GetRobots() . GetFeeds() . $HtmlHeaders
		 . '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />')
      . qq{<body class="$theme" lang="$CurrentLanguage">};
}

sub GetRobots { # NOINDEX for non-browse pages.
  if (GetParam('action', 'browse') eq 'browse' and not GetParam('revision', '')) {
    return '<meta name="robots" content="INDEX,FOLLOW" />';
  } else {
    return '<meta name="robots" content="NOINDEX,FOLLOW" />';
  }
}

sub GetFeeds {      # default for $HtmlHeaders
  my $html = '<link rel="alternate" type="application/rss+xml" title="'
    . QuoteHtml($SiteName) . '" href="' . $ScriptName . '?action=rss" />';
  my $id = GetId(); # runs during Init, not during DoBrowseRequest
  $html .= '<link rel="alternate" type="application/rss+xml" title="'
    . QuoteHtml("$SiteName: $id") . '" href="' . $ScriptName
    . '?action=rss;rcidonly=' . UrlEncode(FreeToNormal($id)) . '" />' if $id;
  my $username = GetParam('username', '');
  $html .= '<link rel="alternate" type="application/rss+xml" '
    . 'title="Follow-ups for ' . NormalToFree($username) . '" '
    . 'href="' . ScriptUrl('action=rss;followup=' . UrlEncode($username))
    . '" />' if $username;
  return $html;
}

sub GetCss {      # prevent javascript injection
  my @css = map { my $x = $_; $x =~ s/\".*//; $x; } split(/\s+/, GetParam('css', ''));
  push (@css, ref $StyleSheet ? @$StyleSheet : $StyleSheet) if $StyleSheet and not @css;
  if ($IndexHash{$StyleSheetPage} and not @css) {
    push (@css, "$ScriptName?action=browse;id=" . UrlEncode($StyleSheetPage) . ";raw=1;mime-type=text/css")
  }
  push (@css, 'https://oddmuse.org/default.css') unless @css;
  return join('', map { qq(<link type="text/css" rel="stylesheet" href="$_" />) } @css);
}

sub PrintPageContent {
  my ($text, $revision, $comment) = @_;
  print $q->start_div({-class=>'content browse', -lang=>GetLanguage($text)});
  # This is a lot like PrintPageHtml except that it also works for older revisions
  if ($revision eq '' and $Page{blocks} and GetParam('cache', $UseCache) > 0) {
    PrintCache();
  } else {
    my $savecache = ($Page{revision} > 0 and $revision eq ''); # new page not cached
    PrintWikiToHTML($text, $savecache, $revision); # unlocked, with anchors, unlocked
  }
  if ($comment) {
    print $q->start_div({-class=>'preview'}), $q->hr();
    print $q->h2(T('Preview:'));
    # no caching, current revision, unlocked
    PrintWikiToHTML(AddComment('', $comment));
    print $q->hr(), $q->h2(T('Preview only, not yet saved')), $q->end_div();
  }
  print $q->end_div();
}

sub PrintFooter {
  my ($id, $rev, $comment, $page) = @_;
  if (GetParam('embed', $EmbedWiki)) {
    print $q->end_html, "\n";

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

      if ($rev) {		# showing old revision
	push(@elements, GetOldPageLink('edit', $id, $rev, Ts('Edit revision %s of this page', $rev)));
      } else {			# showing current revision
	push(@elements, GetEditLink($id, T('Edit this page'), undef, T('e')));
      }
    } else {			# no permission or generated page
      push(@elements, ScriptLink('action=password', T('This page is read-only'), 'password'));
    }
  }
  push(@elements, GetHistoryLink($id, T('View other revisions'))) if $Action{history} and $id and $rev ne 'history';
  push(@elements, GetPageLink($id, T('View current revision')),
       GetRCLink($id, T('View all changes'))) if $Action{history} and $rev ne '';
  if ($Action{contrib} and $id and $rev eq 'history') {
    push(@elements, ScriptLink("action=contrib;id=" . UrlEncode($id), T('View contributors'), 'contrib'));
  }
  if ($Action{admin} and GetParam('action', '') ne 'admin') {
    my $action = 'action=admin';
    $action .= ';id=' . UrlEncode($id) if $id;
    push(@elements, ScriptLink($action, T('Administration'), 'admin'));
  }
  return @elements ? $q->div({-class=>'edit bar'}, @elements) : '';
}

sub GetCommentForm {
  my ($id, $rev, $comment) = @_;
  if ($CommentsPattern ne '' and $id and $rev ne 'history' and $rev ne 'edit'
      and $id =~ /$CommentsPattern/ and UserCanEdit($id, 0, 1)) {
    my $html = $q->div({-class=>'comment'},
		       GetFormStart(undef, undef, 'comment'),
		       $q->p(GetHiddenValue('title', $id),
			     $q->label({-for=>'aftertext', -accesskey=>T('c')},
				       T('Add your comment here:')), $q->br(),
			     GetTextArea('aftertext', $comment, 10)),
		       $EditNote,
		       $q->p($q->span({-class=>'username'},
				      $q->label({-for=>'username'}, T('Username:')), ' ',
				      $q->textfield(-name=>'username', -id=>'username',
						    -default=>GetParam('username', ''),
						    -override=>1, -size=>20, -maxlength=>50)),
			     $q->span({-class=>'homepage'},
				      $q->label({-for=>'homepage'}, T('Homepage URL:')), ' ',
				      $q->textfield(-name=>'homepage', -id=>'homepage',
						    -default=>GetParam('homepage', ''),
						    -override=>1, -size=>40, -maxlength=>100))),
		       $q->p($q->submit(-name=>'Save', -accesskey=>T('s'), -value=>T('Save')), ' ',
			     $q->submit(-name=>'Preview', -accesskey=>T('p'), -value=>T('Preview'))),
		       $q->end_form());
    foreach my $sub (@MyFormChanges) {
      $html = $sub->($html, 'comment');
    }
    return $html;
  }
  return '';
}

sub GetFormStart {
  my ($ignore, $method, $class) = @_;
  $method ||= 'post';
  $class  ||= 'form';
  return $q->start_multipart_form(-method=>$method, -action=>$FullUrl,
				  -accept_charset=>'utf-8', -class=>$class);
}

sub GetSearchForm {
  my $html = GetFormStart(undef, 'get', 'search') . $q->start_p;
  $html .= $q->label({-for=>'search'}, T('Search:')) . ' '
      . $q->textfield(-name=>'search', -id=>'search', -size=>15, -accesskey=>T('f')) . ' ';
  if (GetParam('search') ne '' and UserIsAdmin()) { # see DoBrowseRequest
    $html .= $q->label({-for=>'replace'}, T('Replace:')) . ' '
	. $q->textfield(-name=>'replace', -id=>'replace', -size=>20) . ' '
        . $q->label({-for=>'delete', -title=>'If you want to replace matches with the empty string'}, T('Delete')) . ' '
	. $q->input({-type=>'checkbox', -name=>'delete'})
	. $q->submit('preview', T('Preview'));
  }
  if (GetParam('matchingpages', $MatchingPages)) {
    $html .= $q->label({-for=>'matchingpage'}, T('Filter:')) . ' '
	. $q->textfield(-name=>'match', -id=>'matchingpage', -size=>15) . ' ';
  }
  if (%Languages) {
    $html .= $q->label({-for=>'searchlang'}, T('Language:')) . ' '
	. $q->textfield(-name=>'lang', -id=>'searchlang', -size=>5, -default=>GetParam('lang', '')) . ' ';
  }
  $html .= $q->submit('dosearch', T('Go!')) . $q->end_p . $q->end_form;
  return $html;
}

sub GetGotoBar { # ignore $id parameter
  return $q->span({-class=>'gotobar bar'}, (map { GetPageLink($_) } @UserGotoBarPages), $UserGotoBar);
}

# return list of summaries between two revisions, assuming the open page is the upper one
sub DiffSummary {
  my ($current, $from, $to) = @_;
  my @summaries = ($current); # the current summary is not in a kept file
  unshift(@summaries, map { GetKeptRevision($_)->{summary} } ($from + 1 .. $to - 1)) if $from and $to;
  my ($last, @result);
  for my $summary (@summaries) {
    $summary =~ s/^\s+//; # squish leading whitespace
    next unless $summary; # not empty
    next if $summary eq $last; # not a repeat
    push(@result, QuoteHtml($summary));
    $last = $summary;
  }
  return '' unless @result;
  return $q->p({-class=>'summary'}, T('Summary:'), $result[0]) if @result == 1;
  return $q->div({-class=>'summary'}, $q->p(T('Summary:')), $q->ul($q->li(\@result)));
}

sub PrintHtmlDiff {
  my ($type, $old, $page, $current) = @_;
  $page //= \%Page;
  $current //= $page->{revision};
  $type = 2 if $old or $page->{revision} != $current; # explicit revisions means minor diffs!
  $old //= $page->{$type == 1 ? 'lastmajor' : 'revision'} - 1; # default diff revision if none given
  my ($diff, $summary);
  my $intro = T('Last edit');
  # use the cached diff and summary if possible
  if ($old == $page->{$type == 1 ? 'lastmajor' : 'revision'} - 1) {
    $diff = GetCacheDiff($type == 1 ? 'major' : 'minor', $page);
    # just add the last diff in the right format
    $summary = DiffSummary($page->{$type == 1 ? 'lastmajorsummary' : 'summary'});