view release on metacpan or  search on metacpan

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

	  }
	  $date .= ' ' while ($lines{$date}); # make sure this is unique
	  $lines{$date} = $line;
	}
      }
    }
  }
  my @lines = sort { $b cmp $a } keys %lines;
  @lines = @lines[0 .. $maxitems-1] if $maxitems and $#lines > $maxitems;
  my $date = '';
  foreach my $key (@lines) {
    my $line = $lines{$key};
    if ($key =~ /(\d\d\d\d(?:-\d?\d)?(?:-\d?\d)?)(?:[T ](\d?\d:\d\d))?/) {
      my ($day, $time) = ($1, $2);
      if ($day ne $date) {
	$str .= '</ul>' if $date; # close ul except for the first time where no open ul exists
	$date = $day;
	$str .= $q->p($q->strong($day)) . '<ul>';
      }
      $line = $q->span({-class=>'time'}, $time . ' UTC ') . $line if $time;
    } elsif (not $date) {
      $str .= '<ul>'; # if the feed doesn't have any dates we need to start the list anyhow
      $date = $Now;   # to ensure the list starts only once
    }
    $str .= $q->li($line);
  }
  $str .= '</ul>' if $date;
  return $q->div({-class=>'rss'}, $str);
}

sub GetRss {
  my %todo = map {$_, GetRssFile($_)} @_;
  my %data = ();
  my $str = '';
  if (GetParam('cache', $UseCache) > 0) {
    foreach my $uri (keys %todo) { # read cached rss files if possible
      if ($Now - Modified($todo{$uri}) < $RssCacheHours * 3600) {
	$data{$uri} = ReadFile($todo{$uri});
	delete($todo{$uri});  # no need to fetch them below
      }
    }
  }
  my @need_cache = keys %todo;
  if (keys %todo > 1) {   # try parallel access if available
    eval { # see code example in LWP::Parallel, not LWP::Parallel::UserAgent (no callbacks here)
      require LWP::Parallel::UserAgent;
      my $pua = LWP::Parallel::UserAgent->new();
      foreach my $uri (keys %todo) {
	if (my $res = $pua->register(HTTP::Request->new('GET', $uri))) {
	  $str .= $res->error_as_HTML;
	}
      }
      %todo = (); # because the uris in the response may have changed due to redirects
      my $entries = $pua->wait();
      foreach (keys %$entries) {
	my $uri = $entries->{$_}->request->uri;
	$data{$uri} = $entries->{$_}->response->decoded_content;
      }
    }
  }
  foreach my $uri (keys %todo) { # default operation: synchronous fetching
    $data{$uri} = GetRaw($uri);
  }
  if (GetParam('cache', $UseCache) > 0) {
    CreateDir($RssDir);
    foreach my $uri (@need_cache) {
      my $data = $data{$uri};
      # possibly a Latin-1 file without encoding attribute will cause a problem?
      $data =~ s/encoding="[^"]*"/encoding="UTF-8"/; # content was converted
      WriteStringToFile(GetRssFile($uri), $data) if $data;
    }
  }
  return $str, %data;
}

sub GetRssFile {
  return $RssDir . '/' . UrlEncode(shift);
}

sub RssInterwikiTranslateInit {
  return unless $RssInterwikiTranslate;
  %RssInterwikiTranslate = ();
  foreach (split(/\n/, GetPageContent($RssInterwikiTranslate))) {
    if (/^ ([^ ]+)[ \t]+([^ ]+)$/) {
      $RssInterwikiTranslate{$1} = $2;
    }
  }
}

sub GetInterSiteUrl {
  my ($site, $page, $quote) = @_;
  return unless $page;
  $page = join('/', map { UrlEncode($_) } split(/\//, $page)) if $quote; # Foo:bar+baz is not quoted, [[Foo:bar baz]] is.
  my $url = $InterSite{$site} or return;
  $url =~ s/\%s/$page/g or $url .= $page;
  return $url;
}

sub BracketLink {   # brackets can be removed via CSS
  return $q->span($q->span({class=>'bracket'}, '[') . (shift) . $q->span({class=>'bracket'}, ']'));
}

sub GetInterLink {
  my ($id, $text, $bracket, $quote) = @_;
  my ($site, $page) = split(/:/, $id, 2);
  $page =~ s/&amp;/&/g;   # Unquote common URL HTML
  my $url = GetInterSiteUrl($site, $page, $quote);
  my $class = 'inter ' . $site;
  return "[$id $text]" if $text and $bracket and not $url;
  return "[$id]" if $bracket and not $url;
  return $id if not $url;
  if ($bracket and not $text) {
    $text = BracketLink(++$FootnoteNumber);
    $class .= ' number';
  } elsif (not $text) {
    $text = $q->span({-class=>'site'}, $site)
      . $q->span({-class=>'separator'}, ':')
      . $q->span({-class=>'interpage'}, $page);
  } elsif ($bracket) {    # and $text is set
    $class .= ' outside';
  }