have been migrated to assets
This commit is contained in:
JT Smith
parent
d0cfbd7a8e
commit
87e9e290b2
2 changed files with 0 additions and 659 deletions
|
|
@ -1,297 +0,0 @@
|
|||
package WebGUI::Wobject::Poll;
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2004 Plain Black Corporation.
|
||||
#-------------------------------------------------------------------
|
||||
# Please read the legal notices (docs/legal.txt) and the license
|
||||
# (docs/license.txt) that came with this distribution before using
|
||||
# this software.
|
||||
#-------------------------------------------------------------------
|
||||
# http://www.plainblack.com info@plainblack.com
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
use strict;
|
||||
use Tie::CPHash;
|
||||
use WebGUI::Form;
|
||||
use WebGUI::Grouping;
|
||||
use WebGUI::HTMLForm;
|
||||
use WebGUI::Icon;
|
||||
use WebGUI::International;
|
||||
use WebGUI::Privilege;
|
||||
use WebGUI::Session;
|
||||
use WebGUI::SQL;
|
||||
use WebGUI::URL;
|
||||
use WebGUI::User;
|
||||
use WebGUI::Utility;
|
||||
use WebGUI::Wobject;
|
||||
|
||||
our @ISA = qw(WebGUI::Wobject);
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub _hasVoted {
|
||||
my ($hasVoted) = WebGUI::SQL->quickArray("select count(*) from Poll_answer
|
||||
where wobjectId=".quote($_[0]->get("wobjectId"))." and ((userId=".quote($session{user}{userId})."
|
||||
and userId<>1) or (userId=1 and ipAddress='$session{env}{REMOTE_ADDR}'))");
|
||||
return $hasVoted;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub duplicate {
|
||||
my ($w, $f, $sth, @row);
|
||||
$w = $_[0]->SUPER::duplicate($_[1]);
|
||||
$sth = WebGUI::SQL->read("select * from Poll_answer where wobjectId=".quote($_[0]->get("wobjectId")));
|
||||
while (@row = $sth->array) {
|
||||
WebGUI::SQL->write("insert into Poll_answer values (".quote($w).", ".quote($row[1]).", ".quote($row[2]).", ".quote($row[3]).")");
|
||||
}
|
||||
$sth->finish;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getIndexerParams {
|
||||
my $self = shift;
|
||||
my $now = shift;
|
||||
return {
|
||||
Poll => {
|
||||
sql => "select Poll.wobjectId as wid,
|
||||
Poll.question as question,
|
||||
Poll.a1 as a1, Poll.a2 as a2, Poll.a3 as a3, Poll.a4 as a4, Poll.a5 as a5,
|
||||
Poll.a6 as a6, Poll.a7 as a7, Poll.a8 as a8, Poll.a9 as a9, Poll.a10 as a10,
|
||||
Poll.a11 as a11, Poll.a12 as a12, Poll.a13 as a13, Poll.a14 as a14, Poll.a15 as a15,
|
||||
Poll.a16 as a16, Poll.a17 as a17, Poll.a18 as a18, Poll.a19 as a19, Poll.a20 as a20,
|
||||
wobject.namespace as namespace,
|
||||
wobject.addedBy as ownerId,
|
||||
page.urlizedTitle as urlizedTitle,
|
||||
page.languageId as languageId,
|
||||
page.pageId as pageId,
|
||||
page.groupIdView as page_groupIdView,
|
||||
wobject.groupIdView as wobject_groupIdView,
|
||||
7 as wobject_special_groupIdView
|
||||
from Poll, wobject, page
|
||||
where Poll.wobjectId = wobject.wobjectId
|
||||
and wobject.pageId = page.pageId
|
||||
and wobject.startDate < $now
|
||||
and wobject.endDate > $now
|
||||
and page.startDate < $now
|
||||
and page.endDate > $now",
|
||||
fieldsToIndex => ["question", "a1", "a2", "a3", "a4", "a5", "a6", "a7", "a8", "a9", "a10",
|
||||
"a11", "a12", "a13", "a14", "a15", "a16", "a17", "a18", "a19", "a20"],
|
||||
contentType => 'wobjectDetail',
|
||||
url => 'WebGUI::URL::append($data{urlizedTitle}, "func=view&wid=$data{wid}")',
|
||||
headerShortcut => 'select question from Poll where wobjectId = \'$data{wid}\'',
|
||||
bodyShortcut => 'select a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15,a16,a17,a18,a19,a20
|
||||
from Poll where wobjectId = \'$data{wid}\'',
|
||||
}
|
||||
};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub name {
|
||||
return WebGUI::International::get(1,$_[0]->get("namespace"));
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $property = shift;
|
||||
my $self = WebGUI::Wobject->new(
|
||||
-properties=>$property,
|
||||
-extendedProperties=>{
|
||||
active=>{
|
||||
defaultValue=>1
|
||||
},
|
||||
karmaPerVote=>{
|
||||
defaultValue=>0
|
||||
},
|
||||
graphWidth=>{
|
||||
defaultValue=>150
|
||||
},
|
||||
voteGroup=>{
|
||||
defaultValue=>7
|
||||
},
|
||||
question=>{},
|
||||
randomizeAnswers=>{
|
||||
defaultValue=>1,
|
||||
fieldType=>"yesNo"
|
||||
},
|
||||
a1=>{},
|
||||
a2=>{},
|
||||
a3=>{},
|
||||
a4=>{},
|
||||
a5=>{},
|
||||
a6=>{},
|
||||
a7=>{},
|
||||
a8=>{},
|
||||
a9=>{},
|
||||
a10=>{},
|
||||
a11=>{},
|
||||
a12=>{},
|
||||
a13=>{},
|
||||
a14=>{},
|
||||
a15=>{},
|
||||
a16=>{},
|
||||
a17=>{},
|
||||
a18=>{},
|
||||
a19=>{},
|
||||
a20=>{}
|
||||
},
|
||||
-useTemplate=>1,
|
||||
-useMetaData=>1
|
||||
);
|
||||
bless $self, $class;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub purge {
|
||||
WebGUI::SQL->write("delete from Poll_answer where wobjectId=".quote($_[0]->get("wobjectId")));
|
||||
$_[0]->SUPER::purge();
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_edit {
|
||||
my ($i, $answers);
|
||||
for ($i=1; $i<=20; $i++) {
|
||||
if ($_[0]->get('a'.$i) =~ /\C/) {
|
||||
$answers .= $_[0]->getValue("a".$i)."\n";
|
||||
}
|
||||
}
|
||||
my $privileges = WebGUI::HTMLForm->new;
|
||||
my $layout = WebGUI::HTMLForm->new;
|
||||
my $properties = WebGUI::HTMLForm->new;
|
||||
$privileges->yesNo(
|
||||
-name=>"active",
|
||||
-label=>WebGUI::International::get(3,$_[0]->get("namespace")),
|
||||
-value=>$_[0]->getValue("active")
|
||||
);
|
||||
$privileges->group(
|
||||
-name=>"voteGroup",
|
||||
-label=>WebGUI::International::get(4,$_[0]->get("namespace")),
|
||||
-value=>[$_[0]->getValue("voteGroup")]
|
||||
);
|
||||
if ($session{setting}{useKarma}) {
|
||||
$properties->integer(
|
||||
-name=>"karmaPerVote",
|
||||
-label=>WebGUI::International::get(20,$_[0]->get("namespace")),
|
||||
-value=>$_[0]->getValue("karmaPerVote")
|
||||
);
|
||||
} else {
|
||||
$properties->hidden("karmaPerVote",$_[0]->getValue("karmaPerVote"));
|
||||
}
|
||||
$layout->integer(
|
||||
-name=>"graphWidth",
|
||||
-label=>WebGUI::International::get(5,$_[0]->get("namespace")),
|
||||
-value=>$_[0]->getValue("graphWidth")
|
||||
);
|
||||
$properties->text(
|
||||
-name=>"question",
|
||||
-label=>WebGUI::International::get(6,$_[0]->get("namespace")),
|
||||
-value=>$_[0]->getValue("question")
|
||||
);
|
||||
$properties->textarea(
|
||||
-name=>"answers",
|
||||
-label=>WebGUI::International::get(7,$_[0]->get("namespace")),
|
||||
-subtext=>('<span class="formSubtext"><br>'.WebGUI::International::get(8,$_[0]->get("namespace")).'</span>'),
|
||||
-value=>$answers
|
||||
);
|
||||
$layout->yesNo(
|
||||
-name=>"randomizeAnswers",
|
||||
-label=>WebGUI::International::get(72,$_[0]->get("namespace")),
|
||||
-value=>$_[0]->getValue("randomizeAnswers")
|
||||
);
|
||||
my $output = $_[0]->SUPER::www_edit(
|
||||
-layout=>$layout->printRowsOnly,
|
||||
-properties=>$properties->printRowsOnly,
|
||||
-privileges=>$privileges->printRowsOnly,
|
||||
-headingId=>9,
|
||||
-helpId=>"poll add/edit"
|
||||
);
|
||||
if ($_[0]->get("wobjectId") ne "new") {
|
||||
$output .= '<p>';
|
||||
$output .= '<a href="'.WebGUI::URL::page('func=resetVotes&wid='.$_[0]->get("wobjectId")).'">'
|
||||
.WebGUI::International::get(10,$_[0]->get("namespace")).'</a>';
|
||||
}
|
||||
return $output;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_editSave {
|
||||
my (@answer, $i, $property);
|
||||
@answer = split("\n",$session{form}{answers});
|
||||
for ($i=1; $i<=20; $i++) {
|
||||
$property->{'a'.$i} = $answer[($i-1)];
|
||||
}
|
||||
return $_[0]->SUPER::www_editSave($property);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_resetVotes {
|
||||
return WebGUI::Privilege::insufficient() unless ($_[0]->canEdit);
|
||||
$_[0]->deleteCollateral("Poll_answer","wobjectId",$_[0]->get("wobjectId"));
|
||||
return "";
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_view {
|
||||
$_[0]->logView() if ($session{setting}{passiveProfilingEnabled});
|
||||
my (%var, $answer, @answers, $showPoll, $f);
|
||||
$var{question} = $_[0]->get("question");
|
||||
if ($_[0]->get("active") eq "0") {
|
||||
$showPoll = 0;
|
||||
} elsif (WebGUI::Grouping::isInGroup($_[0]->get("voteGroup"),$session{user}{userId})) {
|
||||
if ($_[0]->_hasVoted()) {
|
||||
$showPoll = 0;
|
||||
} else {
|
||||
$showPoll = 1;
|
||||
}
|
||||
} else {
|
||||
$showPoll = 0;
|
||||
}
|
||||
$var{canVote} = $showPoll;
|
||||
my ($totalResponses) = WebGUI::SQL->quickArray("select count(*) from Poll_answer where wobjectId="
|
||||
.quote($_[0]->get("wobjectId")));
|
||||
$var{"responses.label"} = WebGUI::International::get(12,$_[0]->get("namespace"));
|
||||
$var{"responses.total"} = $totalResponses;
|
||||
$var{"form.start"} = WebGUI::Form::formHeader();
|
||||
$var{"form.start"} .= WebGUI::Form::hidden({name=>'wid',value=>$_[0]->get("wobjectId")});
|
||||
$var{"form.start"} .= WebGUI::Form::hidden({name=>'func',value=>'vote'});
|
||||
$var{"form.submit"} = WebGUI::Form::submit({value=>WebGUI::International::get(11,$_[0]->get("namespace"))});
|
||||
$var{"form.end"} = WebGUI::Form::formFooter();
|
||||
$totalResponses = 1 if ($totalResponses < 1);
|
||||
for (my $i=1; $i<=20; $i++) {
|
||||
if ($_[0]->get('a'.$i) =~ /\C/) {
|
||||
my ($tally) = WebGUI::SQL->quickArray("select count(*) from Poll_answer where answer='a"
|
||||
.$i."' and wobjectId=".quote($_[0]->get("wobjectId"))." group by answer");
|
||||
push(@answers,{
|
||||
"answer.form"=>WebGUI::Form::radio({name=>"answer",value=>"a".$i}),
|
||||
"answer.text"=>$_[0]->get('a'.$i),
|
||||
"answer.graphWidth"=>round($_[0]->get("graphWidth")*$tally/$totalResponses),
|
||||
"answer.number"=>$i,
|
||||
"answer.percent"=>round(100*$tally/$totalResponses),
|
||||
"answer.total"=>($tally+0)
|
||||
});
|
||||
|
||||
}
|
||||
}
|
||||
randomizeArray(\@answers) if ($_[0]->get("randomizeAnswers"));
|
||||
$var{answer_loop} = \@answers;
|
||||
return $_[0]->processTemplate($_[0]->get("templateId"),\%var);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_vote {
|
||||
my $u;
|
||||
if ($session{form}{answer} ne "" && WebGUI::Grouping::isInGroup($_[0]->get("voteGroup"),$session{user}{userId}) && !($_[0]->_hasVoted())) {
|
||||
WebGUI::SQL->write("insert into Poll_answer values (".quote($_[0]->get("wobjectId")).",
|
||||
".quote($session{form}{answer}).", ".quote($session{user}{userId}).", '$session{env}{REMOTE_ADDR}')");
|
||||
if ($session{setting}{useKarma}) {
|
||||
$u = WebGUI::User->new($session{user}{userId});
|
||||
$u->karma($_[0]->get("karmaPerVote"),$_[0]->get("namespace")." (".$_[0]->get("wobjectId").")","Voted on this poll.");
|
||||
}
|
||||
}
|
||||
return "";
|
||||
}
|
||||
|
||||
|
||||
|
||||
1;
|
||||
|
||||
|
|
@ -1,362 +0,0 @@
|
|||
package WebGUI::Wobject::SyndicatedContent;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2004 Plain Black Corporation.
|
||||
#-------------------------------------------------------------------
|
||||
# Please read the legal notices (docs/legal.txt) and the license
|
||||
# (docs/license.txt) that came with this distribution before using
|
||||
# this software.
|
||||
#-------------------------------------------------------------------
|
||||
# http://www.plainblack.com info@plainblack.com
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
use HTML::Entities;
|
||||
use strict;
|
||||
use Storable;
|
||||
use Tie::CPHash;
|
||||
use WebGUI::Cache;
|
||||
use WebGUI::DateTime;
|
||||
use WebGUI::HTMLForm;
|
||||
use WebGUI::HTML;
|
||||
use WebGUI::Icon;
|
||||
use WebGUI::International;
|
||||
use WebGUI::Privilege;
|
||||
use WebGUI::Session;
|
||||
use WebGUI::Wobject;
|
||||
use XML::RSSLite;
|
||||
use LWP::UserAgent;
|
||||
use WebGUI::ErrorHandler;
|
||||
my $hasEncode=1;
|
||||
eval " use Encode qw(from_to); "; $hasEncode=0 if $@;
|
||||
|
||||
our @ISA = qw(WebGUI::Wobject);
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub name {
|
||||
return WebGUI::International::get(2,$_[0]->get("namespace"));
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $property = shift;
|
||||
my $self = WebGUI::Wobject->new(
|
||||
-properties=>$property,
|
||||
-extendedProperties=>{
|
||||
rssUrl=>{},
|
||||
maxHeadlines=>{},
|
||||
},
|
||||
-useTemplate=>1,
|
||||
-useMetaData=>1
|
||||
);
|
||||
bless $self, $class;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub uiLevel {
|
||||
return 6;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_edit {
|
||||
my $properties = WebGUI::HTMLForm->new;
|
||||
$properties->url(
|
||||
-name=>"rssUrl",
|
||||
-label=>WebGUI::International::get(1,$_[0]->get("namespace")),
|
||||
-value=>$_[0]->getValue("rssUrl")
|
||||
);
|
||||
my $layout = WebGUI::HTMLForm->new;
|
||||
$layout->integer(
|
||||
-name=>"maxHeadlines",
|
||||
-label=>WebGUI::International::get(3,$_[0]->get("namespace")),
|
||||
-value=>$_[0]->getValue("maxHeadlines")
|
||||
);
|
||||
return $_[0]->SUPER::www_edit(
|
||||
-properties=>$properties->printRowsOnly,
|
||||
-layout=>$layout->printRowsOnly,
|
||||
-headingId=>4,
|
||||
-helpId=>"syndicated content add/edit"
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
# strip all html tags from the given data structure. This is important to
|
||||
# prevent cross site scripting attacks
|
||||
my $_stripped_html = {};
|
||||
sub _strip_html {
|
||||
#my ($data) = @_;
|
||||
|
||||
if (ref($_[0]) eq 'HASH') {
|
||||
keys(%{$_[0]});
|
||||
while (my ($name, $val) = each (%{$_[0]})) {
|
||||
$_[0]->{$name} = _strip_html($val);
|
||||
}
|
||||
} elsif (ref($_[0]) eq 'ARRAY') {
|
||||
for (my $i = 0; $i < @{$_[0]}; $i++) {
|
||||
$_[0]->[$i] = _strip_html($_[0]->[$i]);
|
||||
}
|
||||
} else {
|
||||
if ($_[0]) {
|
||||
$_[0] =~ s/\</</g;
|
||||
$_[0] =~ s/\>/>/g;
|
||||
$_[0] = WebGUI::HTML::filter($_[0], 'all');
|
||||
}
|
||||
}
|
||||
|
||||
return $_[0];
|
||||
}
|
||||
|
||||
# horrible kludge to find the channel or item record
|
||||
# in the varying kinds of rss structures returned by RSSLite
|
||||
sub _find_record {
|
||||
my ($data, $regex) = @_;
|
||||
|
||||
if (ref($data) eq 'HASH') {
|
||||
# reset the hash before calling each()
|
||||
keys(%{$data});
|
||||
while (my ($name, $val) = each(%{$data})) {
|
||||
if ($name =~ $_[1]) {
|
||||
if ((((ref($val) eq 'HASH') &&
|
||||
($val->{link} || $val->{title} ||
|
||||
$val->{description})) ||
|
||||
((ref($val) eq 'ARRAY') && @{$val} &&
|
||||
(ref($val->[0]) eq 'HASH') &&
|
||||
($val->[0]->{link} ||
|
||||
$val->[0]->{title} ||
|
||||
$val->[0]->{description})))) {
|
||||
return $val;
|
||||
}
|
||||
}
|
||||
if (my $record = _find_record($val, $regex)) {
|
||||
return $record;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
# Copy the guid field to the link field if the guid looks like a link.
|
||||
# This is a kludge that gets around the fact that some folks use the link
|
||||
# field as the link to the story while others use it as the link
|
||||
# to the story about which the story is written. The webuig templates seem
|
||||
# to assume the former, so we should use the guid instead of the link, b/c
|
||||
# the guid, if it is a link, always means the former.
|
||||
# Also copy the first few words of the description into the title if
|
||||
# there is no title
|
||||
sub _normalize_items {
|
||||
#my ($items) = @_;
|
||||
|
||||
# max number of words to take from description to fill in an empty
|
||||
# title
|
||||
my $max_words = 10;
|
||||
|
||||
for my $item (@{$_[0]}) {
|
||||
if ($item->{guid} && ($item->{guid} =~ /^http:\/\//i)) {
|
||||
$item->{link} = $item->{guid};
|
||||
}
|
||||
if (!$item->{title}) {
|
||||
my @description_words = split(/\s/, $item->{description});
|
||||
if (@description_words <= $max_words) {
|
||||
$item->{title} = $item->{description};
|
||||
} else {
|
||||
$item->{title} = join(" ", @description_words[0..$max_words-1]) .
|
||||
" ...";
|
||||
}
|
||||
}
|
||||
|
||||
# IE doesn't recognize '
|
||||
$item->{title} =~ s/'/\'/;
|
||||
$item->{description} =~ s/'/\'/;
|
||||
}
|
||||
}
|
||||
|
||||
sub _get_rss_data {
|
||||
my ($url) = @_;
|
||||
|
||||
my $cache = WebGUI::Cache->new("url:" . $url, "RSS");
|
||||
my $rss_serial = $cache->get;
|
||||
my $rss = {};
|
||||
if ($rss_serial) {
|
||||
$rss = Storable::thaw($rss_serial);
|
||||
} else {
|
||||
my $ua = LWP::UserAgent->new(timeout => 5);
|
||||
my $response = $ua->get($url);
|
||||
if (!$response->is_success()) {
|
||||
WebGUI::ErrorHandler::warn("Error retrieving url '$url': " .
|
||||
$response->status_line());
|
||||
return undef;
|
||||
}
|
||||
my $xml = $response->content();
|
||||
|
||||
# Convert encoding if needed / Perl 5.8.0 or up required.
|
||||
if ($] >= 5.008 && $hasEncode) {
|
||||
$xml =~ /<\?xml.*?encoding=['"](\S+)['"]/i;
|
||||
my $xmlEncoding = $1;
|
||||
my $encoding = "UTF-8";
|
||||
if (lc($xmlEncoding) ne lc($encoding)) {
|
||||
eval { from_to($xml, $xmlEncoding, $encoding) };
|
||||
WebGUI::ErrorHandler::warn($@) if ($@);
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
# there is no encode_entities_numeric that I can find, so I am
|
||||
# commenting this out. -hal
|
||||
# $xml =~ s#(<title>)(.*?)(</title>)#$1.encode_entities_numeric(decode_entities($2)).$3#ges;
|
||||
# $xml =~ s#(<description>)(.*?)(</description>)#$1.encode_entities_numeric(decode_entities($2)).$3#ges;
|
||||
|
||||
my $rss_lite = {};
|
||||
eval {
|
||||
XML::RSSLite::parseXML($rss_lite, \$xml);
|
||||
};
|
||||
if ($@) {
|
||||
WebGUI::ErrorHandler::warn("error parsing rss for url $url");
|
||||
}
|
||||
|
||||
# make sure that the {channel} points to the channel
|
||||
# description record and that {items} points to the list
|
||||
# of items. without this voodoo, different versions of
|
||||
# rss return the data in different places in the data
|
||||
# structure.
|
||||
$rss_lite = {channel => $rss_lite};
|
||||
if (!($rss->{channel} =
|
||||
_find_record($rss_lite, qr/^channel$/))) {
|
||||
WebGUI::ErrorHandler::warn("unable to find channel info for url $url");
|
||||
}
|
||||
if (!($rss->{items} = _find_record($rss_lite, qr/^items?$/))) {
|
||||
WebGUI::ErrorHandler::warn("unable to find item info for url $url");
|
||||
$rss->{items} = [];
|
||||
}
|
||||
|
||||
_strip_html($rss);
|
||||
$rss->{items} = [ $rss->{items} ] unless (ref $rss->{items} eq 'ARRAY');
|
||||
|
||||
_normalize_items($rss->{items});
|
||||
|
||||
$cache->set(Storable::freeze($rss), 3600);
|
||||
}
|
||||
|
||||
return $rss;
|
||||
}
|
||||
|
||||
# rss items don't have a standard date, so timestamp them the first time
|
||||
# we see them and use that timestamp as the date. Periodically nuke the
|
||||
# whole database to keep the thing from growing too large
|
||||
sub _assign_rss_dates {
|
||||
my ($items) = @_;
|
||||
|
||||
for my $item (@{$items}) {
|
||||
my $key = 'dates:' . ($item->{guid} || $item->{title} ||
|
||||
$item->{description} || $item->{link});
|
||||
my $cache = WebGUI::Cache->new($key, "RSS");
|
||||
if (my $date = $cache->get()) {
|
||||
$item->{date} = $date;
|
||||
} else {
|
||||
$item->{date} = time();
|
||||
$cache->set($item->{date}, '1 year');
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub _get_aggregate_items {
|
||||
my ($urls, $obj, $maxHeadlines) = @_;
|
||||
|
||||
my $cache = WebGUI::Cache->new("aggregate:" .
|
||||
$obj->get("rssUrl"), "RSS");
|
||||
my $items = Storable::thaw($cache->get());
|
||||
if (!$items) {
|
||||
$items = [];
|
||||
my $items_remain = 1;
|
||||
|
||||
my @rsss;
|
||||
for my $url (@{$urls}) {
|
||||
push(@rsss, _get_rss_data($url));
|
||||
}
|
||||
|
||||
while ((@{$items} < $maxHeadlines) && $items_remain) {
|
||||
$items_remain = 0;
|
||||
for my $rss (@rsss) {
|
||||
if ($rss->{items} &&
|
||||
(my $item = shift(@{$rss->{items}}))) {
|
||||
push(@{$items},
|
||||
{site_title => $rss->{channel}->{title},
|
||||
site_link => $rss->{channel}->{link},
|
||||
link => $item->{link},
|
||||
title => $item->{title},
|
||||
description => $item->{description},
|
||||
});
|
||||
if (@{$rss->{items}}) {
|
||||
$items_remain = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
_assign_rss_dates($items);
|
||||
|
||||
@{$items} = sort { $b->{date} <=> $a->{date} } @{$items};
|
||||
|
||||
#if (@{$items} > $_aggregate_size) {
|
||||
# @{$items} = @{$items}[0..($_aggregate_size-1)];
|
||||
#}
|
||||
|
||||
$cache->set(Storable::freeze($items), 3600);
|
||||
}
|
||||
|
||||
return $items;
|
||||
}
|
||||
|
||||
# interleave stories from each feed, up to a total of $_aggregate_size
|
||||
sub _view_aggregate_feed {
|
||||
my ($urls, $obj, $maxHeadlines) = @_;
|
||||
|
||||
my %var;
|
||||
$var{'channel.title'} = $obj->get("title");
|
||||
$var{'channel.description'} = $obj->get("description");
|
||||
$var{item_loop} = _get_aggregate_items($urls, $obj, $maxHeadlines);
|
||||
|
||||
return $obj->processTemplate($obj->get("templateId"),\%var);
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub _view_single_feed {
|
||||
my $maxHeadlines = $_[1];
|
||||
my $rss = _get_rss_data($_[0]->get("rssUrl"));
|
||||
my %var;
|
||||
$var{"channel.title"} = $rss->{channel}->{title};
|
||||
$var{"channel.link"} = $rss->{channel}->{link};
|
||||
$var{"channel.description"} = $rss->{channel}->{description};
|
||||
my @items;
|
||||
$rss->{items} ||= [];
|
||||
for (my $i = 0; ($i < @{$rss->{items}}) && ($i < $maxHeadlines);$i++) {
|
||||
my $item = $rss->{items}->[$i];
|
||||
push (@items,{
|
||||
link=>$item->{link},
|
||||
title=>$item->{title},
|
||||
description=>$item->{description}
|
||||
});
|
||||
}
|
||||
$var{item_loop} = \@items;
|
||||
return $_[0]->processTemplate($_[0]->get("templateId"),\%var);
|
||||
}
|
||||
|
||||
sub www_view {
|
||||
$_[0]->logView() if ($session{setting}{passiveProfilingEnabled});
|
||||
my $maxHeadlines = $_[0]->get("maxHeadlines") || 1000000;
|
||||
|
||||
my @urls = split(/\s+/,$_[0]->get("rssUrl"));
|
||||
if (@urls == 1) {
|
||||
return _view_single_feed($_[0], $maxHeadlines);
|
||||
} else {
|
||||
return _view_aggregate_feed(\@urls, $_[0], $maxHeadlines);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
Loading…
Add table
Add a link
Reference in a new issue