view release on metacpan or  search on metacpan

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

	    } else {
	      $line .= ' ' . $title;
	    }
	  }
	  my $contributor = $i->{dc}->{contributor};
	  $contributor ||= $i->{$wikins}->{username};
	  $contributor =~ s/^\s+//;
	  $contributor =~ s/\s+$//;
	  $contributor ||= $i->{$rdfns}->{value};
	  $line .= $q->span({-class=>'contributor'}, $q->span(T(' . . . .') . ' ') . $contributor) if $contributor;
	  if ($description) {
	    if ($description =~ /</) {
	      $line .= $q->div({-class=>'description'}, $description);
	    } else {
	      $line .= $q->span({class=>'dash'}, ' &#8211; ') . $q->strong({-class=>'description'}, $description);
	    }
	  }
	  $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);