view release on metacpan or  search on metacpan

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

<docs>http://blogs.law.harvard.edu/tech/rss</docs>
};
  my $title = QuoteHtml($SiteName) . ': ' . GetParam('title', QuoteHtml(NormalToFree($HomePage)));
  $rss .= "<title>$title</title>\n";
  $rss .= "<link>$ScriptName?" . RcSelfAction() . "</link>\n";
  $rss .= qq{<atom:link href="$ScriptName?} . RcSelfAction() . qq{" rel="self" type="application/rss+xml" />\n};
  $rss .= qq{<atom:link href="$ScriptName?} . RcPreviousAction() . qq{" rel="previous" type="application/rss+xml" />\n};
  $rss .= qq{<atom:link href="$ScriptName?} . RcLastAction() . qq{" rel="last" type="application/rss+xml" />\n};
  if ($SiteDescription) {
    $rss .= "<description>" . QuoteHtml($SiteDescription) . "</description>\n"
  }
  $rss .= "<pubDate>$date</pubDate>\n";
  $rss .= "<lastBuildDate>$date</lastBuildDate>\n";
  $rss .= "<generator>Oddmuse</generator>\n";
  $rss .= "<copyright>$RssRights</copyright>\n" if $RssRights;
  if ($RssLicense) {
    $rss .= join('', map {"<cc:license>" . QuoteHtml($_) . "</cc:license>\n"}
		 (ref $RssLicense eq 'ARRAY' ? @$RssLicense : $RssLicense))
  }
  $rss .= "<wiki:interwiki>$InterWikiMoniker</wiki:interwiki>\n" if $InterWikiMoniker;
  if ($RssImageUrl) {
    $rss .= "<image>\n";
    $rss .= "<url>$RssImageUrl</url>\n";
    $rss .= "<title>$title</title>\n";    # the same as the channel
    $rss .= "<link>$ScriptName?" . RcSelfAction() . "</link>\n"; # the same as the channel
    $rss .= "</image>\n";
  }
  my $limit = GetParam("rsslimit", 15); # Only take the first 15 entries
  my $count = 0;
  ProcessRcLines(sub {}, sub {
       my $id = shift;
       return if grep { $id =~ /$_/ } @excluded or ($limit ne 'all' and $count++ >= $limit);
       $rss .= "\n" . RssItem($id, @_);
     });
  $rss .= "</channel>\n</rss>\n";
  return $rss;
}

sub RssItem {
  my ($id, $ts, $host, $username, $summary, $minor, $revision,
      $languages, $cluster, $last) = @_;
  my $name = ItemName($id);
  if (GetParam('full', 0)) { # full page means summary is not shown
    $summary = PageHtml($id, 50 * 1024, T('This page is too big to send over RSS.'));
  } else {
    $summary = QuoteHtml($summary); # page summary must be quoted
  }
  my $date = TimeToRFC822($ts);
  $username = QuoteHtml($username);
  my $rss = "<item>\n";
  $rss .= "<title>$name</title>\n";
  my $link = ScriptUrl(GetParam('all', $cluster)
             ? GetPageParameters('browse', $id, $revision, $cluster, $last)
             : UrlEncode($id));
  $rss .= "<link>$link</link>\n<guid>$link</guid>\n";
  $rss .= "<description>" . QuoteHtml($summary) . "</description>\n" if $summary;
  $rss .= "<pubDate>" . $date . "</pubDate>\n";
  $rss .= "<comments>" . ScriptUrl($CommentsPrefix . UrlEncode($id))
    . "</comments>\n" if $CommentsPattern and $id !~ /$CommentsPattern/;
  $rss .= "<dc:contributor>" . $username . "</dc:contributor>\n" if $username;
  $rss .= "<wiki:status>" . (1 == $revision ? 'new' : 'updated') . "</wiki:status>\n";
  $rss .= "<wiki:importance>" . ($minor ? 'minor' : 'major') . "</wiki:importance>\n";
  $rss .= "<wiki:version>" . $revision . "</wiki:version>\n";
  $rss .= "<wiki:history>" . ScriptUrl("action=history;id=" . UrlEncode($id))
    . "</wiki:history>\n";
  $rss .= "<wiki:diff>" . ScriptUrl("action=browse;diff=1;id=" . UrlEncode($id))
    . "</wiki:diff>\n" if $UseDiff and GetParam('diffrclink', 1);
  return $rss . "</item>\n";
}

sub DoRss {
  print GetHttpHeader('application/xml');
  print GetRcRss();
}

sub DoHistory {
  my $id = shift;
  ValidIdOrDie($id);
  OpenPage($id);
  if (GetParam('raw', 0)) {
    DoRawHistory($id);
  } else {
    DoHtmlHistory($id);
  }
}

sub DoRawHistory {
  my ($id) = @_;
  print GetHttpHeader('text/plain'),
  RcTextItem('title', Ts('History of %s', NormalToFree($OpenPageName))),
  RcTextItem('date', TimeToText($Now)),
  RcTextItem('link', ScriptUrl("action=history;id=$OpenPageName;raw=1")),
  RcTextItem('generator', 'Oddmuse');
  SetParam('all', 1);
  my @languages = split(/,/, $Page{languages});
  RcTextRevision($id, $Page{ts}, $Page{host}, $Page{username}, $Page{summary},
		 $Page{minor}, $Page{revision}, \@languages, undef, 1);
  foreach my $revision (GetKeepRevisions($OpenPageName)) {
    my $keep = GetKeptRevision($revision);
    @languages = split(/,/, $keep->{languages});
    RcTextRevision($id, $keep->{ts}, $keep->{host}, $keep->{username},
		   $keep->{summary}, $keep->{minor}, $keep->{revision}, \@languages);
  }
}

sub DoHtmlHistory {
  my ($id) = @_;
  print GetHeader('', Ts('History of %s', NormalToFree($id)));
  my $row = 0;
  my $rollback = UserCanEdit($id, 0) && (GetParam('username', '') or UserIsEditor());
  my $date = CalcDay($Page{ts});
  my @html = (GetFormStart(undef, 'get', 'history'));
  push(@html, $q->p({-class => 'documentation'}, T('Using the ï½¢rollbackï½£ button on this page will reset the page to that particular point in time, undoing any later changes to this page.'))) if $rollback;
  push(@html, $q->p(# don't use $q->hidden here!
		    $q->input({-type=>'hidden', -name=>'action', -value=>'browse'}),
		    $q->input({-type=>'hidden', -name=>'diff', -value=>'1'}),
		    $q->input({-type=>'hidden', -name=>'id', -value=>$id})));
  # list of rows with revisions, starting with current revision
  push(@html, $q->p($q->submit({-name=>T('Compare')}))) if $UseDiff;
  my @rows = (GetHistoryLine($id, \%Page, $row++, $rollback, $date, 1));
  foreach my $revision (GetKeepRevisions($OpenPageName)) {

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

  my ($string, @pages) = @_;
  my $match = GetParam('match', '');
  @pages = grep /$match/i, @pages if $match;
  return @pages;
}

sub SearchString {
  my ($string, $data) = @_;
  my @strings = grep /./, $string =~ /\"([^\"]+)\"|(\S+)/g; # skip null entries
  foreach my $str (@strings) {
    return 0 unless ($data =~ /$str/i);
  }
  return 1;
}

sub SearchRegexp {
  my $regexp = join '|', map { index($_, '|') == -1 ? $_ : "($_)" }
    grep /./, shift =~ /\"([^\"]+)\"|(\S+)/g; # this acts as OR
  $regexp =~ s/\\s/[[:space:]]/g;
  return $regexp;
}

sub PrintSearchResult {
  my ($name, $regex) = @_;
  return PrintPage($name) if not GetParam('context', 1);
  OpenPage($name);     # should be open already, just making sure!
  my $text = $Page{text};
  my ($type) = TextIsFile($text); # MIME type if an uploaded file
  my %entry;
  #  get the page, filter it, remove all tags
  $text =~ s/$FS//g;   # Remove separators (paranoia)
  $text =~ s/[\s]+/ /g;   #  Shrink whitespace
  $text =~ s/([-_=\\*\\.]){10,}/$1$1$1$1$1/g ; # e.g. shrink "----------"
  $entry{title} = $name;
  $entry{description} =  $type || SearchHighlight(QuoteHtml(SearchExtract($text, $regex)), QuoteHtml($regex));
  $entry{size} = int((length($text) / 1024) + 1) . 'K';
  $entry{'last-modified'} = TimeToText($Page{ts});
  $entry{username} = $Page{username};
  PrintSearchResultEntry(\%entry);
}

sub PrintSearchResultEntry {
  my %entry = %{(shift)}; # get value from reference
  if (GetParam('raw', 0)) {
    $entry{generator} = GetAuthor($entry{username});
    foreach my $key (qw(title description size last-modified generator username)) {
      print RcTextItem($key, $entry{$key});
    }
    print RcTextItem('link', "$ScriptName?$entry{title}"), "\n";
  } else {
    my $author = GetAuthorLink($entry{username});
    $author ||= $entry{generator};
    my $id = $entry{title};
    my ($class, $resolved, $title, $exists) = ResolveId($id);
    my $text = NormalToFree($id);
    my $result = $q->span({-class=>'result'}, ScriptLink(UrlEncode($resolved), $text, $class, undef, $title));
    my $description = $entry{description};
    $description = $q->br() . $description if $description;
    my $info = $entry{size};
    $info .= ' - ' if $info;
    $info .= T('last updated') . ' ' . $entry{'last-modified'} if $entry{'last-modified'};
    $info .= ' ' . T('by') . ' ' . $author if $author;
    $info = $q->br() . $q->span({-class=>'info'}, $info) if $info;
    print $q->p($result, $description, $info);
  }
}

sub SearchHighlight {
  my ($data, $regex) = @_;
  $data =~ s/($regex)/<strong>$1<\/strong>/gi unless GetParam('raw');
  return $data;
}

sub SearchExtract {
  my ($data, $regex) = @_;
  my ($snippetlen, $maxsnippets) = (100, 4); #  these seem nice.
  # show a snippet from the beginning of the document
  my $j = index($data, ' ', $snippetlen); # end on word boundary
  my $t = substr($data, 0, $j);
  my $result = $t . ' . . .';
  $data = substr($data, $j);  # to avoid rematching
  my $jsnippet = 0 ;
  while ($jsnippet < $maxsnippets and $data =~ m/($regex)/i) {
    $jsnippet++;
    if (($j = index($data, $1)) > -1 ) {
      # get substr containing (start of) match, ending on word boundaries
      my $start = index($data, ' ', $j - $snippetlen / 2);
      $start = 0 if $start == -1;
      my $end = index($data, ' ', $j + $snippetlen / 2);
      $end = length($data) if $end == -1;
      $t = substr($data, $start, $end - $start);
      $result .= $t . ' . . .';
      # truncate text to avoid rematching the same string.
      $data = substr($data, $end);
    }
  }
  return $result;
}

sub ReplaceAndSave {
  my ($from, $to) = @_;
  RequestLockOrError();   # fatal
  my @result = Replace($from, $to, 1, sub {
    my ($id, $new) = @_;
    Save($id, $new, $from . ' → ' . $to, 1);
  });
  ReleaseLock();
  return @result;
}

sub ReplaceAndDiff {
  my ($from, $to) = @_;
  my @found = Replace($from, $to, 0, sub {
    my ($id, $new) = @_;
    print $q->h2(GetPageLink($id)), $q->div({-class=>'diff'}, ImproveDiff(DoDiff($Page{text}, $new)));
		      });
  if (@found > GetParam('offset', 0) + GetParam('num', 10)) {
    my $more = "search=" . UrlEncode($from) . ";preview=1"
	. ";offset=" . (GetParam('num', 10) + GetParam('offset', 0))
	. ";num=" . GetParam('num', 10);
    $more .= ";replace=" . UrlEncode($to) if $to;