From 7390497e1f0bfe24ed8df97e2212ee8557b4e34a Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Mon, 12 Apr 2010 11:46:36 -0700 Subject: [PATCH 01/10] Change how the locked flag is displayed, so that it isn't inline with the content, but just above it. Fixes bug #11520 --- docs/changelog/7.x.x.txt | 1 + .../packages-7.9.3/default-wiki-page.wgpkg | Bin 0 -> 2337 bytes 2 files changed, 1 insertion(+) create mode 100644 docs/upgrades/packages-7.9.3/default-wiki-page.wgpkg diff --git a/docs/changelog/7.x.x.txt b/docs/changelog/7.x.x.txt index 542abdaa5..5df039484 100644 --- a/docs/changelog/7.x.x.txt +++ b/docs/changelog/7.x.x.txt @@ -2,6 +2,7 @@ - added #11477: No synopsis in asset now means no synopsis in search index - added #11007: Added drag'n'drop sorting in Gallery Album Edit View (Bernd Kalbfuß-Zimmermann) - added Better comment rating icons. + - fixed #11520: Wiki Locked 7.9.2 - added: Workflow to extend recurring Calendar events 2 years from the diff --git a/docs/upgrades/packages-7.9.3/default-wiki-page.wgpkg b/docs/upgrades/packages-7.9.3/default-wiki-page.wgpkg new file mode 100644 index 0000000000000000000000000000000000000000..c31c59df3e96cf96214e5356c3e13a3f371bddc9 GIT binary patch literal 2337 zcmV++3EuV}iwFP!00000|Lt0BQyV!F=JWmv9s2=8VUNw5bGG9uHpwnjB^!1_j!nf` zN}dt6U@XmzWQ>pFzhAdB@@U3mND@Jej9Th$wOUU zz2C%lv$eOkwni3DbFJ0dJ!l>r>^Jvz*GQ|?+-a^681nqjRB4)mOQDRpxLR#*s#vO4 zi*Zu$n8}&HJc$~e_JPKl}^qZSRrXW2uW5hI$7h>3j+UQ?Tro))4F^lrCg3Zpj zh~&&DZRP?s7cx#SXJx>_4 zX&4xUN&^GfdbZdq1smx7gWxg>uZK!XlUy>i;<7S3H4@(}3)$3wjL+L)>Q)b3$*2 zGL2Z;X(cyAK?RD)kARllyVWBhiW+8{4XkUKlm}at^`X>SPRhc2G=qPnp&*JOY*BO# zw#_J&QxQSh#WL*-V`%Bx&$BVttXnWupYceKJI!uFqlk-<=Rx&^(D^(Z1=A)fPQha| zx-d;>I^x2FsSZK*9I=*NKj*WFCz~wI0h;pAkwz>jPSKAMpTI(QrfFRBA%opefL6AE ziGWW=K{mQE;uo9U&8`>dL@JJ(r4zy$vy|AE-y>xSAZ$m-y8Tq;7TLOuxB^6 z380LD1oCc??2B6FG0Mv zImpKK0a3?0UN_A()c;-pjfi!)=X(*qCOm@kfupH#Uc7o(60j3}PFs;n@O zEt$Z^DieML(Fi`hU>bY2P2AiBF;4k3@<5q!O95Wh)AV-JvH4?Ic;DDEr4iQT0(hhD zqzIaLIQ#P$DWagr7inCJC7yD(5Ajrb?$Ud++Y7)8tH=2~8`Z;@(G-JXrC!>gEB=EX zcuSMbARAbmFAjs;EctcC<}*NLWj)*Mc8E>hSOWWZ!ng2;w|04Y!#?bzpC&kv?*owy zF&m#jU^%0NSnTug;If7do0USenvI-uVE3w9cLN#KHod^$XO|Goid zxDnHhQ!A=%xQK1QeSq*?I7Bew3Np|OdZw`RHpjE)yl z+crDAqkZyUQZafUCQ|7WnM`AvF6r=O4=I8RHaxh#8dEW1s;p@s3gQQqVG16}2`lR% zPLOM`dnK=_TmY}+8b?Oepw8^9bo%#?T>N5SRPuTq2g&=e6f(vt&3PEWtaI)-p+E@9Vc0vE&A z{^hM>Lhue9n{56s{nQ-4(&=bdFBnyUt7NXSK$Yj?ue6oz z?CiW~?(Vm}E9I13b7WkwudT;bYXT)2sO=&z@?fj6oE?jwWje9p@S+J{AlZv(cP(vP z@GJ|+8 z3Z$V(@sn~tg8pq( z#{zZs`+=*tez4X1$LCkC4^Iz2Zw0lS&)g!3p)ae*0s>)yywD0x;%TCAxVndV#CRC# ztfm)^L@f8fqP4M|GX*3HKnw2R2MT|%_2o-{D}ckQ`5vc8_n*Dq6R)H%6<1G|*Vk&^ zaDTZkN*~naiu#g6PLOLTS9>PHbe?Ea8BM+Ru#=9mga04HvyW}@?{_D|PnQ?s_nXPl zhfn&qyeC&5=D=zvWpp-mVe!SLhwD&Z&DWY$71n$kS|}#1gZ;e&{C^O+MJR$mOEUL< z+nfGz{%U`}P1Dol;Pv_C?5EbH=iZ` Date: Tue, 13 Apr 2010 10:55:09 -0700 Subject: [PATCH 02/10] Add missing template help for the WikiPage view template. --- docs/changelog/7.x.x.txt | 1 + lib/WebGUI/Help/Asset_WikiPage.pm | 10 ++++++++++ lib/WebGUI/i18n/English/Asset_WikiPage.pm | 18 ++++++++++++++++++ 3 files changed, 29 insertions(+) diff --git a/docs/changelog/7.x.x.txt b/docs/changelog/7.x.x.txt index 5df039484..c3ce30712 100644 --- a/docs/changelog/7.x.x.txt +++ b/docs/changelog/7.x.x.txt @@ -3,6 +3,7 @@ - added #11007: Added drag'n'drop sorting in Gallery Album Edit View (Bernd Kalbfuß-Zimmermann) - added Better comment rating icons. - fixed #11520: Wiki Locked + - fixed Missing Template variables for the Wiki Page view template. 7.9.2 - added: Workflow to extend recurring Calendar events 2 years from the diff --git a/lib/WebGUI/Help/Asset_WikiPage.pm b/lib/WebGUI/Help/Asset_WikiPage.pm index f0f61076f..eda94eba5 100644 --- a/lib/WebGUI/Help/Asset_WikiPage.pm +++ b/lib/WebGUI/Help/Asset_WikiPage.pm @@ -78,6 +78,16 @@ our $HELP = { }, { 'name' => 'editContent', }, { 'name' => 'content', }, + { 'name' => 'keywordsLoop', + 'variables' => [ + { 'name' => 'keyword', + 'description' => 'keyword title', + }, + { 'name' => 'url', + 'description' => 'keyword url', + }, + ], + }, { name => 'isSubscribed', description => 'help isSubscribed', diff --git a/lib/WebGUI/i18n/English/Asset_WikiPage.pm b/lib/WebGUI/i18n/English/Asset_WikiPage.pm index e49d21113..58c43ac6a 100644 --- a/lib/WebGUI/i18n/English/Asset_WikiPage.pm +++ b/lib/WebGUI/i18n/English/Asset_WikiPage.pm @@ -291,6 +291,24 @@ our $I18N = context => q{Help for template variable}, }, + 'keywordsLoop' => { + message => q{A loop containing all keywords for this page is tagged with.}, + lastUpdated => 0, + context => q{Help for template variable}, + }, + + 'keyword title' => { + message => q{The name of this keyword.}, + lastUpdated => 0, + context => q{Help for template variable}, + }, + + 'keyword url' => { + message => q{The URL to view all pages tagged with this keyword.}, + lastUpdated => 0, + context => q{Help for template variable}, + }, + 'help owner' => { message => q{The username of the owner of the page}, lastUpdated => 0, From 1395fcc411fd4c9859abc95a1aad97dc473fe219 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 13 Apr 2010 11:05:29 -0700 Subject: [PATCH 03/10] Add RFE #10944, keyword pages. Keyword pages are any page where the title is exactly the same as any keyword for any page in the wiki. Keyword pages work the same as any wiki page, but also may display a list of pages that are tagged with the keyword. --- docs/changelog/7.x.x.txt | 1 + lib/WebGUI/Asset/WikiPage.pm | 54 ++++++++++++++++++-- lib/WebGUI/Help/Asset_WikiPage.pm | 14 ++++++ lib/WebGUI/i18n/English/Asset_WikiPage.pm | 26 +++++++++- t/Asset/WikiPage.t | 61 +++++++++++++++++++++-- 5 files changed, 147 insertions(+), 9 deletions(-) diff --git a/docs/changelog/7.x.x.txt b/docs/changelog/7.x.x.txt index c3ce30712..f41265ec2 100644 --- a/docs/changelog/7.x.x.txt +++ b/docs/changelog/7.x.x.txt @@ -4,6 +4,7 @@ - added Better comment rating icons. - fixed #11520: Wiki Locked - fixed Missing Template variables for the Wiki Page view template. + - added #10944: Wiki Keyword Page 7.9.2 - added: Workflow to extend recurring Calendar events 2 years from the diff --git a/lib/WebGUI/Asset/WikiPage.pm b/lib/WebGUI/Asset/WikiPage.pm index eb99c9de5..7a086fb46 100644 --- a/lib/WebGUI/Asset/WikiPage.pm +++ b/lib/WebGUI/Asset/WikiPage.pm @@ -265,13 +265,17 @@ Get the common template vars for this asset sub getTemplateVars { my ( $self ) = @_; - my $i18n = WebGUI::International->new($self->session, "Asset_WikiPage"); - my $wiki = $self->getWiki; - my $owner = WebGUI::User->new( $self->session, $self->get('ownerUserId') ); - my $keywords = WebGUI::Keyword->new($self->session)->getKeywordsForAsset({ + my $session = $self->session; + my $i18n = WebGUI::International->new($session, "Asset_WikiPage"); + my $wiki = $self->getWiki; + my $owner = WebGUI::User->new( $session, $self->get('ownerUserId') ); + my $keyObj = WebGUI::Keyword->new($session); + + my $keywords = $keyObj->getKeywordsForAsset({ asset => $self, asArrayRef => 1, }); + my @keywordsLoop = (); foreach my $word (@{$keywords}) { push @keywordsLoop, { @@ -305,11 +309,35 @@ sub getTemplateVars { $self->scrubContent, {skipTitles => [$self->get('title')]}, ), + isKeywordPage => $self->isKeywordPage, isSubscribed => $self->isSubscribed, subscribeUrl => $self->getSubscribeUrl, unsubscribeUrl => $self->getUnsubscribeUrl, owner => $owner->get('alias'), }; + my @keyword_pages = (); + if ($var->{isKeywordPage}) { + my $paginator = $keyObj->getMatchingAssets({ + startAsset => $self->getWiki, + keyword => $self->get('title'), + usePaginator => 1, + }); + PAGE: foreach my $assetId (@{ $paginator->getPageData }) { + next PAGE if $assetId->{assetId} eq $self->getId; + my $asset = WebGUI::Asset->newByDynamicClass($session, $assetId->{assetId}); + next PAGE unless $asset; + push @keyword_pages, { + title => $asset->getTitle, + url => $asset->getUrl, + }; + } + $paginator->appendTemplateVariables($var); + @keyword_pages = map { $_->[1] } + sort + map { [ lc $_->{title}, $_ ] } + @keyword_pages; + } + $var->{keyword_page_loop} = \@keyword_pages; return $var; } @@ -359,6 +387,24 @@ sub isProtected { #------------------------------------------------------------------- +=head2 isKeywordPage + +Returns a boolean indicating whether or not the name of this WikiPage matches any keyword in the Wiki that +contains it. + +=cut + +sub isKeywordPage { + my $self = shift; + my $keywords = WebGUI::Keyword->new($self->session)->getMatchingAssets({ + asset => $self->getWiki, + keyword => $self->get('title'), + }); + return scalar @{ $keywords }; +} + +#------------------------------------------------------------------- + =head2 preparePageTemplate This is essentially prepareView, but is smart and will only do the template diff --git a/lib/WebGUI/Help/Asset_WikiPage.pm b/lib/WebGUI/Help/Asset_WikiPage.pm index eda94eba5..dc11d5976 100644 --- a/lib/WebGUI/Help/Asset_WikiPage.pm +++ b/lib/WebGUI/Help/Asset_WikiPage.pm @@ -48,6 +48,9 @@ our $HELP = { { tag => 'wiki page asset template variables', namespace => 'Asset_WikiPage' }, + { tag => 'pagination template variables', + namespace => 'WebGUI' + }, ], variables => [ { name => 'viewLabel', @@ -104,6 +107,17 @@ our $HELP = { name => 'owner', description => 'help owner', }, + { 'name' => 'isKeywordPage', }, + { 'name' => 'keyword_page_loop', + 'variables' => [ + { 'name' => 'title', + 'description' => 'keyword page title', + }, + { 'name' => 'url', + 'description' => 'keyword page url', + }, + ], + }, ], related => [], }, diff --git a/lib/WebGUI/i18n/English/Asset_WikiPage.pm b/lib/WebGUI/i18n/English/Asset_WikiPage.pm index 58c43ac6a..4d0eae3de 100644 --- a/lib/WebGUI/i18n/English/Asset_WikiPage.pm +++ b/lib/WebGUI/i18n/English/Asset_WikiPage.pm @@ -327,12 +327,36 @@ our $I18N = context => 'Body text for help page', }, - 'isFeatured label' => { message => q{Feature this on the front page}, lastUpdated => 0, context => 'Label for asset property', }, + + 'isKeywordPage' => { + message => q{A boolean that is true if this page is a keyword page.}, + lastUpdated => 0, + context => 'template variable help', + }, + + 'keyword_page_loop' => { + message => q{If this page is a keyword page, then this loop will contain a list of all pages tagged with this page's keyword. The pagination variables will apply to the list of pages in this loop. If this page is not a keyword page, the loop will be blank, and the pagination variables will not be present.}, + lastUpdated => 0, + context => 'template variable help', + }, + + 'keyword page title' => { + message => q{The title of a page that has this keyword.}, + lastUpdated => 0, + context => 'template variable help', + }, + + 'keyword page url' => { + message => q{The URL to a page that has this keyword.}, + lastUpdated => 0, + context => 'template variable help', + }, + }; 1; diff --git a/t/Asset/WikiPage.t b/t/Asset/WikiPage.t index 85b923bda..3a92d7e00 100644 --- a/t/Asset/WikiPage.t +++ b/t/Asset/WikiPage.t @@ -16,7 +16,8 @@ use lib "$FindBin::Bin/../lib"; use WebGUI::Test; use WebGUI::Session; -use Test::More tests => 17; # increment this value for each test you create +use Test::More tests => 29; # increment this value for each test you create +use Test::Deep; use WebGUI::Asset::Wobject::WikiMaster; use WebGUI::Asset::WikiPage; @@ -27,12 +28,12 @@ my $versionTag = WebGUI::VersionTag->getWorking($session); $versionTag->set({name=>"Wiki Test"}); addToCleanup($versionTag); -my $wiki = $node->addChild({className=>'WebGUI::Asset::Wobject::WikiMaster'}); +my $wiki = $node->addChild({className=>'WebGUI::Asset::Wobject::WikiMaster', title => 'Wiki Test', url => 'wikitest'}); +my @autoCommitCoda = (undef, undef, {skipAutoCommitWorkflows => 1, skipNotification => 1}); $versionTag->commit; my $wikipage = $wiki->addChild( {className=>'WebGUI::Asset::WikiPage'}, - undef, undef, - {skipAutoCommitWorkflows => 1, skipNotification => 1} + @autoCommitCoda, ); # Wikis create and autocommit a version tag when a child is added. Lets get the name so we can roll it back. @@ -90,3 +91,55 @@ $comments = $wikipage->get('comments'); is($comments->[0]{comment}, $secondComment, "you can delete a comment"); is($wikipage->get('averageCommentRating'), 1, 'average rating is adjusted after deleting a comment'); + +################## +# This section tests hierarchical keywords support +################## + +# +## setup some more wiki pages +my $properties = { + className=>'WebGUI::Asset::WikiPage', + content => 'Now is the time for all good men to come to the aid of their country', + title => 'Keyword', + keywords => 'keyword' +}; +my $wikipage2 = $wiki->addChild($properties, @autoCommitCoda); +isa_ok($wikipage2, 'WebGUI::Asset::WikiPage'); + +$properties = { + className=>'WebGUI::Asset::WikiPage', + content => 'The quick brown fox jumps over the lazy dog.', + title => 'Fox', + keywords => 'keyword' +}; +my $wikipage3 = $wiki->addChild($properties, @autoCommitCoda); +isa_ok($wikipage3, 'WebGUI::Asset::WikiPage'); + +# Test keywords support +my $keywords = $wikipage2->get('keywords'); +is($keywords,$properties->{'keywords'}, 'Keywords match'); + +# Test isKeywordPage() +ok $wikipage2->isKeywordPage(), "'".$wikipage2->get('title')."' is a keyword page"; +my $templateVars = $wikipage2->getTemplateVars; +ok $templateVars->{isKeywordPage}, 'isKeywordPage template var, true'; +cmp_deeply + $templateVars->{keyword_page_loop}, + [ + { title => 'Fox', url => '/wikitest/fox', }, + ], + 'populated keyword_page_loop, sorted by title'; +ok ! $wikipage3->isKeywordPage(), "'".$wikipage3->get('title')."' is not a keyword page"; +$templateVars = $wikipage3->getTemplateVars; +ok ! $templateVars->{isKeywordPage}, 'isKeywordPage template var, false'; +cmp_deeply $templateVars->{keyword_page_loop}, [], 'empty keyword_page_loop'; + +$wikipage3->update({keywords => $wikipage3->get('keywords').',Fox'}); +ok $wikipage3->isKeywordPage(), "'".$wikipage3->get('title')."' is now a keyword page"; +$templateVars = $wikipage3->getTemplateVars; +ok $templateVars->{isKeywordPage}, 'isKeywordPage template var, false'; +cmp_deeply + $templateVars->{keyword_page_loop}, + [ ], + 'empty keyword_page_loop, self is not put into the loop'; From 7fe81165ed83c5544a7ca36d17eadaaf495c3230 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 13 Apr 2010 11:28:31 -0700 Subject: [PATCH 04/10] Bug fixes, changes to default wikipage template for keyword pages, and template var clarifications. --- .../packages-7.9.3/default-wiki-page.wgpkg | Bin 2337 -> 2434 bytes lib/WebGUI/Asset/WikiPage.pm | 2 +- lib/WebGUI/i18n/English/Asset_WikiPage.pm | 4 ++-- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/docs/upgrades/packages-7.9.3/default-wiki-page.wgpkg b/docs/upgrades/packages-7.9.3/default-wiki-page.wgpkg index c31c59df3e96cf96214e5356c3e13a3f371bddc9..54846118b40196987e0a46e66953d2f2156c14df 100644 GIT binary patch literal 2434 zcmV-|34Qh-iwFP!00000|Lt0BbK5o&_UHZzocqDD#}XyKDJMCaag+3tyEJhxcHCZ+ zdLR;(kWc`RfTZYr{_nR75F|)ZcE_=M{Sans%2;4`u~?asl$#s2%uof+3Ip%#@}nxD?8mi_h!r%@j-3dNEE4 z9y2-fzNPD*No2h46u%D-%;&?_Cnd!LISLw&j$pm(*T2&}=yogXf3UxIut6Z2kN-T@ z`nMk6^@p%<{T*z=P0glBOf|ctTGMbcWkRb>(jy-}?i#t$GNohYHzlb|SgJWQ9gP~) z6jP;Nd`V=gS#)AVViw0n3yQ;(ftl!sC92xo-^>ND3$@X|naoBpR}&T$LctanTtsqV zMzsq8`=V3&lF{glj@2m*Kf@?ge2jaUq%3|q+*EoQGtkHMaFgg|!k|sVz#vo#S|%yG zf|lQ2peof^&Ui4I@i+=J9nCpg1XL-emHV>=qqh4nE*LzXk!C1U=37!>$`f7k{u7;3 z+YHXAG_0M&l1`*-MsnI@b6C@$@;7X9oXg-iu$l(P_catsAy}xn6hZN^IpyNvOt6?? zUIy9wVU@eZ&faU3VkMyM1?k6;gxEOmL)K3VVFTznWZKC27+()Ae)0C!TE=-u3 z5M<90YuWX4KAU*5>B=0SsR$iu#ggI_{TT5nEOc*{#tk1b*cS>2%5sIq1Y7rovkFe$iJMVMhCWJ+~7Arr>O6HVk5k$M792mao%9Bb=E z9+^tn__MfM$)IXYLN_Zx#C3~lQj?ygvgIc3V(qFIv5V-M-4Z|%0}13^p6q!gbDF$b zbpL{urBIQlYs%V6zm?)v-JFHLJI>=$rOW!edN&kB#ghxc(sMYhzp_UG?~DOO+f=%U zUC~*rA>BXoCi1pov?2T1$O{mkg7ge3JFqqTbc()Qou*PtJW^E8C0xDaQN%>G9eGyr zDtZxdZA6{DLY+H<8NsmzqnG@OD5ew;h1Q&=EgAu#ek%sY$-v5?(I8zaV+AB0nuBcI z0Kj&#=XKLu12H%bpb=pZ;ovypbHXDyI5_?aCy5Xaa0;3VCJW~S+uw|t#nmn)x#rD6&L?ied2ea6-ZQ|x8h;b^WQ3T42TM6*Go~E~(j?F7W&j-eqshY4RS3oFrFGW1X zQ`>K^kUI*BM3TmhSmN<__XLltmo9g=`^N!zVf8ql7vp9aGn!&htkg>zbj5$r18-@v z8Ds;?^TlC#;&Sy5wp;*G;}-IwSJj=Tic7-Jb{L$^*NiHe$$DSnHolCdggpR@Wxc>Z z$!dpHr%OJSlBn2c03HJjm{}#iY;$^$Uwt8U&l4ltpT4=#>2 zBewg!Y;F9gsMjW9`OYk6SDo%qWct8+I)E)<;*iZLsdE;SKhL=AfE>!Hxmzj)(lyrR zlugibEUcFRj`_w%TO}lOdp=(+YSX!_RN=M`&r6J-cTgIvvoxe#e=yAp&%K8TW&XO!3B-*T{yuaz!mI#FX%w3P-9Dq z##XjN{|UEZ%dOotZn$)F1K}tSrW(*|0;oLBM zM^w{yX;?S-9JbnRLqoWtWY1xIkLYy9R&CsDW7M3r8xukg;;;bTY&UFkcJl>6_Ii|H zH=|cQ@&qmxFmr3Rivl@G!cvlR%_V?Q!TgE9{jT)hBH zqNCW($&(lo`i}p{3XTrDo@t!e%v|Se(gg0{=l(r8VC(D*iQZklB{T(wYwouUfU)DLR};B-C4Q9Y)CSKBw}2c}2@S1TT*>l6G7+ZBM4LvFeT7-a z*{yA3Gso)tGWWH--GEZ5%B|z;K!Nhon-O`0rAOoC`JD5DTq039-*;8HME0@KA&F1+ z3p_Ub+sxkai8AY64NSqaQRb1hGJSn)(&WfzJ!dM-2r(5otRq9EGU6I@=2A@R;aHHx z@a*>;7pH?@=lCxlo;^P~JNd8^GzzM7jr@i_t>Y00q$OTMYv_uniNbmJ7E%)9`LMU1 zc{qNt+5_v^)^0%}kV61txPgDb34)!E9|t=DTrHUI+{!1gN2dbBtM)5(*OR#ovyM{S z&IHQRJ9W8wzv7S+6dI~TK+|z{o3fzezrOkV`SUaiPyhYPdGlWv@8AErD4>+9cS~Tk z(<*R7nKWM~*A+@rGh8j&^dQ}Q&0H!bouk8pBmDm-g+(ZWKua?BempFzhAdB@@U3mND@Jej9Th$wOUU zz2C%lv$eOkwni3DbFJ0dJ!l>r>^Jvz*GQ|?+-a^681nqjRB4)mOQDRpxLR#*s#vO4 zi*Zu$n8}&HJc$~e_JPKl}^qZSRrXW2uW5hI$7h>3j+UQ?Tro))4F^lrCg3Zpj zh~&&DZRP?s7cx#SXJx>_4 zX&4xUN&^GfdbZdq1smx7gWxg>uZK!XlUy>i;<7S3H4@(}3)$3wjL+L)>Q)b3$*2 zGL2Z;X(cyAK?RD)kARllyVWBhiW+8{4XkUKlm}at^`X>SPRhc2G=qPnp&*JOY*BO# zw#_J&QxQSh#WL*-V`%Bx&$BVttXnWupYceKJI!uFqlk-<=Rx&^(D^(Z1=A)fPQha| zx-d;>I^x2FsSZK*9I=*NKj*WFCz~wI0h;pAkwz>jPSKAMpTI(QrfFRBA%opefL6AE ziGWW=K{mQE;uo9U&8`>dL@JJ(r4zy$vy|AE-y>xSAZ$m-y8Tq;7TLOuxB^6 z380LD1oCc??2B6FG0Mv zImpKK0a3?0UN_A()c;-pjfi!)=X(*qCOm@kfupH#Uc7o(60j3}PFs;n@O zEt$Z^DieML(Fi`hU>bY2P2AiBF;4k3@<5q!O95Wh)AV-JvH4?Ic;DDEr4iQT0(hhD zqzIaLIQ#P$DWagr7inCJC7yD(5Ajrb?$Ud++Y7)8tH=2~8`Z;@(G-JXrC!>gEB=EX zcuSMbARAbmFAjs;EctcC<}*NLWj)*Mc8E>hSOWWZ!ng2;w|04Y!#?bzpC&kv?*owy zF&m#jU^%0NSnTug;If7do0USenvI-uVE3w9cLN#KHod^$XO|Goid zxDnHhQ!A=%xQK1QeSq*?I7Bew3Np|OdZw`RHpjE)yl z+crDAqkZyUQZafUCQ|7WnM`AvF6r=O4=I8RHaxh#8dEW1s;p@s3gQQqVG16}2`lR% zPLOM`dnK=_TmY}+8b?Oepw8^9bo%#?T>N5SRPuTq2g&=e6f(vt&3PEWtaI)-p+E@9Vc0vE&A z{^hM>Lhue9n{56s{nQ-4(&=bdFBnyUt7NXSK$Yj?ue6oz z?CiW~?(Vm}E9I13b7WkwudT;bYXT)2sO=&z@?fj6oE?jwWje9p@S+J{AlZv(cP(vP z@GJ|+8 z3Z$V(@sn~tg8pq( z#{zZs`+=*tez4X1$LCkC4^Iz2Zw0lS&)g!3p)ae*0s>)yywD0x;%TCAxVndV#CRC# ztfm)^L@f8fqP4M|GX*3HKnw2R2MT|%_2o-{D}ckQ`5vc8_n*Dq6R)H%6<1G|*Vk&^ zaDTZkN*~naiu#g6PLOLTS9>PHbe?Ea8BM+Ru#=9mga04HvyW}@?{_D|PnQ?s_nXPl zhfn&qyeC&5=D=zvWpp-mVe!SLhwD&Z&DWY$71n$kS|}#1gZ;e&{C^O+MJR$mOEUL< z+nfGz{%U`}P1Dol;Pv_C?5EbH=iZ` $asset->getUrl, }; } - $paginator->appendTemplateVariables($var); + $paginator->appendTemplateVars($var); @keyword_pages = map { $_->[1] } sort map { [ lc $_->{title}, $_ ] } diff --git a/lib/WebGUI/i18n/English/Asset_WikiPage.pm b/lib/WebGUI/i18n/English/Asset_WikiPage.pm index 4d0eae3de..0c1663dbe 100644 --- a/lib/WebGUI/i18n/English/Asset_WikiPage.pm +++ b/lib/WebGUI/i18n/English/Asset_WikiPage.pm @@ -304,7 +304,7 @@ our $I18N = }, 'keyword url' => { - message => q{The URL to view all pages tagged with this keyword.}, + message => q{The URL to view all pages tagged with this keyword. The URL will have the gateway URL prepended to it.}, lastUpdated => 0, context => q{Help for template variable}, }, @@ -352,7 +352,7 @@ our $I18N = }, 'keyword page url' => { - message => q{The URL to a page that has this keyword.}, + message => q{The URL to a page that has this keyword. The URL will have the gateway URL prepended to it.}, lastUpdated => 0, context => 'template variable help', }, From 5282a12d47035761bcd20ba711ab152249f5842d Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 14 Apr 2010 09:34:34 -0700 Subject: [PATCH 05/10] Note Test::Deep is required due to usage in Survey::Test and Asset::Event. --- docs/gotcha.txt | 9 ++++++++- sbin/testEnvironment.pl | 2 +- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/docs/gotcha.txt b/docs/gotcha.txt index 2c8f419df..70d6bfe3e 100644 --- a/docs/gotcha.txt +++ b/docs/gotcha.txt @@ -7,9 +7,16 @@ upgrading from one version to the next, or even between multiple versions. Be sure to heed the warnings contained herein as they will save you many hours of grief. +7.9.3 +-------------------------------------------------------------------- + * Test:Deep, which had been an optional dependency for testing, has been used + in components of the core for a while, since the release of the new Survey. + Test::Deep version 0.095 or higher is now required. + + 7.9.2 -------------------------------------------------------------------- - * new dependency: DateTime::Event::ICal + * new dependency: DateTime::Event::ICal 0.10 or higher 7.9.0 -------------------------------------------------------------------- diff --git a/sbin/testEnvironment.pl b/sbin/testEnvironment.pl index 624498e98..3205eb8e2 100755 --- a/sbin/testEnvironment.pl +++ b/sbin/testEnvironment.pl @@ -65,7 +65,7 @@ checkModule("HTTP::Request", 1.40 ); checkModule("HTTP::Headers", 1.61 ); checkModule("Test::More", 0.82, 2 ); checkModule("Test::MockObject", 1.02, 2 ); -checkModule("Test::Deep", 0.095, 2 ); +checkModule("Test::Deep", 0.095, ); checkModule("Test::Exception", 0.27, 2 ); checkModule("Test::Class", 0.31, 2 ); checkModule("Pod::Coverage", 0.19, 2 ); From 1cd7d8fbc7810ea813b2dcf5789cb3595261efb3 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 14 Apr 2010 11:41:20 -0700 Subject: [PATCH 06/10] Remove dead END blocks from some tests. --- t/Asset/Wobject/WikiMaster/featured.t | 4 ---- t/Macro/PageUrl.t | 4 ---- 2 files changed, 8 deletions(-) diff --git a/t/Asset/Wobject/WikiMaster/featured.t b/t/Asset/Wobject/WikiMaster/featured.t index c070bfb44..ef0d98bab 100644 --- a/t/Asset/Wobject/WikiMaster/featured.t +++ b/t/Asset/Wobject/WikiMaster/featured.t @@ -69,9 +69,5 @@ cmp_deeply( "appendFeaturedPageVars returns correct variables, prefixed with 'featured_'", ); -#---------------------------------------------------------------------------- -# Cleanup -END { -} #vim:ft=perl diff --git a/t/Macro/PageUrl.t b/t/Macro/PageUrl.t index dd6853b64..97d9cb4df 100644 --- a/t/Macro/PageUrl.t +++ b/t/Macro/PageUrl.t @@ -65,7 +65,3 @@ $output = WebGUI::Macro::PageUrl::process($session, '/sub/page', 'query=this'); like($output, qr{/sub/page\?noCache=\d+:\d+;query=this$}, 'checking that the query arg works with preventProxyCache'); } - -END { - # See note in the Slash_gateway macro test about this. -} From 8206aeaec5656bab36b6b9bdd25d5f93dc4187c0 Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Tue, 16 Feb 2010 10:42:56 -0600 Subject: [PATCH 07/10] enhance format of .wgaccess files to provide security for Gallery files --- lib/WebGUI/Asset/File.pm | 11 +++- lib/WebGUI/Asset/File/GalleryFile.pm | 5 ++ lib/WebGUI/Storage.pm | 45 +++++++++++++-- lib/WebGUI/URL/Uploads.pm | 82 +++++++++++++++++----------- t/Storage.t | 20 +++++-- 5 files changed, 121 insertions(+), 42 deletions(-) diff --git a/lib/WebGUI/Asset/File.pm b/lib/WebGUI/Asset/File.pm index 6ffaf9bc1..d1eca73bd 100644 --- a/lib/WebGUI/Asset/File.pm +++ b/lib/WebGUI/Asset/File.pm @@ -78,10 +78,19 @@ A hash reference of optional parameters. None at this time. sub applyConstraints { my $self = shift; - $self->getStorageLocation->setPrivileges($self->get('ownerUserId'), $self->get('groupIdView'), $self->get('groupIdEdit')); + $self->setPrivileges; $self->setSize; } +sub setPrivileges { + my $self = shift; + $self->getStorageLocation->setPrivileges( + $self->get('ownerUserId'), + $self->get('groupIdView'), + $self->get('groupIdEdit'), + ); +} + #------------------------------------------------------------------- diff --git a/lib/WebGUI/Asset/File/GalleryFile.pm b/lib/WebGUI/Asset/File/GalleryFile.pm index 0c1abe0f0..835fa3281 100644 --- a/lib/WebGUI/Asset/File/GalleryFile.pm +++ b/lib/WebGUI/Asset/File/GalleryFile.pm @@ -1196,5 +1196,10 @@ sub www_view { return "chunked"; } +sub setPrivileges { + my $self = shift; + $self->getStorageLocation->setPrivileges($self); +} + 1; # Who knew the truth would be so obvious? diff --git a/lib/WebGUI/Storage.pm b/lib/WebGUI/Storage.pm index 3303228ed..91a5e0f84 100644 --- a/lib/WebGUI/Storage.pm +++ b/lib/WebGUI/Storage.pm @@ -26,6 +26,7 @@ use Image::Magick; use Path::Class::Dir; use Storable (); use WebGUI::Utility qw(isIn); +use JSON (); =head1 NAME @@ -1665,10 +1666,42 @@ The groupId that is allowed to edit the files in this storage location. =cut sub setPrivileges { - my $self = shift; - my $owner = shift; - my $viewGroup = shift; - my $editGroup = shift; + my $self = shift; + my %privs = ( + users => [], + groups => [], + assets => [], + ); + if (@_ == 3 && !ref $_[0] && !ref $_[1] && !ref $_[0]) { + push @{ $privs{users} }, $_[0]; + push @{ $privs{groups} }, @_[1,2]; + } + else { + for my $object (@_) { + if ($object->isa('WebGUI::User')) { + push @{ $privs{users} }, $object->getId; + } + elsif ($object->isa('WebGUI::Group')) { + push @{ $privs{groups} }, $object->getId; + } + elsif ($object->isa('WebGUI::Asset')) { + push @{ $privs{assets} }, $object->getId; + } + } + } + + my $public; + for my $user (@{ $privs{users} }) { + if ($user eq '1') { + $public = 1; + } + } + for my $group (@{ $privs{groups} }) { + if ($group eq '1' || $group eq '7') { + $public = 1; + } + } + my $accessFile = JSON->new->encode( \%privs ); my $dirObj = $self->getPathClassDir(); return undef if ! defined $dirObj; @@ -1678,11 +1711,11 @@ sub setPrivileges { return unless $obj->is_dir; my $rel = $obj->relative($dirObj); - if ($owner eq '1' || $viewGroup eq '1' || $viewGroup eq '7' || $editGroup eq '1' || $editGroup eq '7') { + if ($public) { $self->deleteFile($rel->file('.wgaccess')->stringify); } else { - $self->addFileFromScalar($rel->file('.wgaccess')->stringify,$owner."\n".$viewGroup."\n".$editGroup); + $self->addFileFromScalar($rel->file('.wgaccess')->stringify, $accessFile); } } ); diff --git a/lib/WebGUI/URL/Uploads.pm b/lib/WebGUI/URL/Uploads.pm index 36ca8470a..aa6138bbd 100644 --- a/lib/WebGUI/URL/Uploads.pm +++ b/lib/WebGUI/URL/Uploads.pm @@ -47,38 +47,58 @@ The Apache request handler for this package. sub handler { my ($request, $server, $config) = @_; - $request->push_handlers(PerlAccessHandler => sub { - if (-e $request->filename) { - my $path = $request->filename; - $path =~ s/^(\/.*\/).*$/$1/; - if (-e $path.".wgaccess") { - my $fileContents; - open(my $FILE, "<" ,$path.".wgaccess"); - while (my $line = <$FILE>) { - $fileContents .= $line; - } - close($FILE); - my @privs = split("\n", $fileContents); - unless ($privs[1] eq "7" || $privs[1] eq "1") { - my $session = $request->pnotes('wgSession'); - unless (defined $session) { - $session = WebGUI::Session->open($server->dir_config('WebguiRoot'), $config->getFilename, $request, $server); - } - my $hasPrivs = ($session->var->get("userId") eq $privs[0] || $session->user->isInGroup($privs[1]) || $session->user->isInGroup($privs[2])); - $session->close(); - if ($hasPrivs) { - return Apache2::Const::OK; - } - else { - return Apache2::Const::AUTH_REQUIRED; - } - } - } - return Apache2::Const::OK; - } + $request->push_handlers(PerlAccessHandler => sub { + my $path = $request->filename; + return Apache2::Const::NOT_FOUND + unless -e $path; + $path =~ s{[^/]*$}{}; + return Apache2::Const::OK + unless -e $path . '.wgaccess'; + + my $fileContents; + open my $FILE, '<' , $path . '.wgaccess'; + my $fileContents = do { local $/; <$FILE> }; + close($FILE); + my @users; + my @groups; + my @assets; + if ($fileContents =~ /\A(?:\d+|[A-Za-z0-9_-]{22})\n(?:\d+|[A-Za-z0-9_-]{22})\n(?:\d+|[A-Za-z0-9_-]{22})/) { + my @privs = split("\n", $fileContents); + push @users, $privs[0]; + push @groups, @privs[1,2]; + } else { - return Apache2::Const::NOT_FOUND; - } + my $privs = JSON->new->decode($fileContents); + @users = @{ $privs->{users} }; + @groups = @{ $privs->{groups} }; + @assets = @{ $privs->{assets} }; + } + + return Apache2::Const::OK + if grep { $_ eq '1' } @users; + + return Apache2::Const::OK + if grep { $_ eq '1' || $_ eq '7' } @groups; + + my $session = $request->pnotes('wgSession'); + unless (defined $session) { + $session = WebGUI::Session->open($server->dir_config('WebguiRoot'), $config->getFilename, $request, $server); + } + + my $userId = $session->var->get('userId'); + + return Apache2::Const::OK + if grep { $_ eq $userId } @users; + + my $user = $session->user; + + return Apache2::Const::OK + if grep { $user->isInGroup($_) } @groups; + + return Apache2::Const::OK + if grep { WebGUI::Asset->new($session, $_)->canView } @assets; + + return Apache2::Const::AUTH_REQUIRED; } ); return Apache2::Const::OK; } diff --git a/t/Storage.t b/t/Storage.t index 5264622a1..37c726f9a 100644 --- a/t/Storage.t +++ b/t/Storage.t @@ -32,7 +32,7 @@ my $cwd = Cwd::cwd(); my ($extensionTests, $fileIconTests) = setupDataDrivenTests($session); -my $numTests = 134; # increment this value for each test you create +my $numTests = 136; # increment this value for each test you create plan tests => $numTests + scalar @{ $extensionTests } + scalar @{ $fileIconTests }; my $uploadDir = $session->config->get('uploadsPath'); @@ -508,7 +508,7 @@ my $shallowDir = $shallowStorage->getPathClassDir(); ok(-e $shallowDir->file('.wgaccess')->stringify, 'setPrivilege: .wgaccess file created in shallow storage'); my $privs; $privs = $shallowStorage->getFileContentsAsScalar('.wgaccess'); -is ($privs, "3\n3\n3", '... correct group contents'); +is ($privs, '{"assets":[],"groups":["3","3"],"users":["3"]}', '... correct group contents'); $shallowStorage->deleteFile('.wgaccess'); my $deepStorage = WebGUI::Storage->create($session); @@ -524,9 +524,21 @@ ok(-e $deepDir->file('.wgaccess')->stringify, '.wgaccess file created in dee ok(-e $deepDeepDir->file('.wgaccess')->stringify, '.wgaccess file created in deep storage subdir'); $privs = $deepStorage->getFileContentsAsScalar('.wgaccess'); -is ($privs, "3\n3\n3", '... correct group contents, deep storage'); +is ($privs, '{"assets":[],"groups":["3","3"],"users":["3"]}', '... correct group contents, deep storage'); $privs = $deepStorage->getFileContentsAsScalar('deep/.wgaccess'); -is ($privs, "3\n3\n3", '... correct group contents, deep storage subdir'); +is ($privs, '{"assets":[],"groups":["3","3"],"users":["3"]}', '... correct group contents, deep storage subdir'); + +{ + my $storage = WebGUI::Storage->create($session); + addToCleanup($storage); + my $asset = WebGUI::Asset->getRoot($session); + $storage->setPrivileges( $asset ); + my $accessFile = $storage->getPathClassDir->file('.wgaccess'); + ok(-e $accessFile, 'setPrivilege: .wgaccess file created for asset permissions'); + my $privs = $accessFile->slurp; + is ($privs, '{"assets":["' . $asset->getId . '"],"groups":[],"users":[]}', '... correct asset contents'); +} + #################################################### # From aaa0924dc7523cd7a918f1c5aa5b46b8b93499f1 Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Thu, 15 Apr 2010 14:02:39 -0500 Subject: [PATCH 08/10] allow running sbin scripts from any directory --- sbin/_utility.skeleton | 14 +- sbin/changeIobStatus.pl | 372 ++++++++++++++++++++-------------------- sbin/diskUsage.pl | 10 +- sbin/fileImport.pl | 15 +- sbin/galleryImport.pl | 12 +- sbin/generateContent.pl | 12 +- sbin/installClass.pl | 10 +- sbin/maintenanceMode.pl | 11 +- sbin/purgeWGAccess.pl | 10 +- sbin/rebuildLineage.pl | 13 +- sbin/search.pl | 10 +- sbin/spectre.pl | 10 +- sbin/syncToCdn.pl | 12 +- sbin/testCodebase.pl | 14 +- sbin/testEnvironment.pl | 11 +- sbin/thumbnailer.pl | 9 +- sbin/upgrade.pl | 10 +- sbin/userImport.pl | 10 +- 18 files changed, 310 insertions(+), 255 deletions(-) mode change 100644 => 100755 sbin/syncToCdn.pl diff --git a/sbin/_utility.skeleton b/sbin/_utility.skeleton index 18c08945e..7c8d45b11 100644 --- a/sbin/_utility.skeleton +++ b/sbin/_utility.skeleton @@ -10,15 +10,19 @@ # http://www.plainblack.com info@plainblack.com #------------------------------------------------------------------- -$|++; # disable output buffering -our ($webguiRoot, $configFile, $help, $man); +use strict; +use File::Basename (); +use File::Spec; +my $webguiRoot; BEGIN { - $webguiRoot = ".."; - unshift (@INC, $webguiRoot."/lib"); + $webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir)); + unshift @INC, File::Spec->catdir($webguiRoot, 'lib'); } -use strict; +$|++; # disable output buffering + +our ($configFile, $help, $man); use Pod::Usage; use Getopt::Long; use WebGUI::Session; diff --git a/sbin/changeIobStatus.pl b/sbin/changeIobStatus.pl index e42b76b6a..3769e333a 100755 --- a/sbin/changeIobStatus.pl +++ b/sbin/changeIobStatus.pl @@ -1,185 +1,187 @@ -#!/usr/bin/env perl - -#------------------------------------------------------------------- -# WebGUI is Copyright 2001-2009 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 -#------------------------------------------------------------------- - -our ($webguiRoot); - -BEGIN { - $webguiRoot = ".."; - unshift (@INC, $webguiRoot."/lib"); -} - -use Getopt::Long; -use Pod::Usage; -use strict; -use WebGUI::Session; -use WebGUI::User; -use WebGUI::Inbox; - -$|=1; - -my $configFile; -my $help; -my $quiet; -my $whatsHappening = "Automatically signed out."; -my $newStatus = "Out"; -my $currentStatus = "In"; -my $userMessage = "You were logged out of the In/Out Board automatically."; -my $userMessageFile; - - -GetOptions( - 'configfile=s'=>\$configFile, - 'help'=>\$help, - 'quiet'=>\$quiet, - 'whatsHappening:s'=>\$whatsHappening, - 'userMessage:s'=>\$userMessage, - 'userMessageFile:s'=>\$userMessageFile, - 'currentStatus:s'=>\$currentStatus, - 'newStatus:s'=>\$newStatus -); - -pod2usage( verbose => 2 ) if $help; -pod2usage() unless $configFile; - -print "Starting up...\n" unless ($quiet); -my $session = WebGUI::Session->open($webguiRoot,$configFile); - -if ($userMessageFile) { - print "Opening message file.." unless ($quiet); - if (open(FILE,"<".$userMessageFile)) { - print "OK\n" unless ($quiet); - my $contents; - while () { - $contents .= $_; - } - close(FILE); - if (length($contents) == 0) { - print "Message file empty, reverting to original message.\n"; - } else { - $userMessage = $contents; - } - } else { - print "Failed to open message file.\n"; - } -} - -print "Searching for users with a status of $currentStatus ...\n" unless ($quiet); -my $userList; -my $now = time(); -my $inbox = WebGUI::Inbox->new($session); -my $sth = $session->db->read("select userId,assetId from InOutBoard_status where status=?",[$currentStatus]); -while (my ($userId,$assetId) = $sth->array) { - my $user = WebGUI::User->new($session, $userId); - print "\tFound user ".$user->username."\n" unless ($quiet); - $userList .= $user->username." (".$userId.")\n"; - $session->db->write("update InOutBoard_status set dateStamp=?, message=?, status=? where userId=? and assetId=?",[$now, $whatsHappening, $newStatus, $userId, $assetId]); - $session->db->write("insert into InOutBoard_statusLog (userId, createdBy, dateStamp, message, status, assetId) values (?,?,?,?,?,?)", - [$userId,3,$now, $whatsHappening, $newStatus, $assetId]); - $inbox->addMessage({ - userId=>$userId, - subject=>"IOB Update", - message=>$userMessage - }); -} - -if (length($userList) > 0) { - print "Alerting admins of changes\n" unless ($quiet); - my $message = "The following users had their status changed:\n\n".$userList; - $inbox->addMessage({ - groupId=>3, - subject=>"IOB Update", - message=>$userMessage - }); -} - -print "Cleaning up..." unless ($quiet); -$session->var->end; -$session->close; -print "OK\n" unless ($quiet); - -__END__ - -=head1 NAME - -changeIobStatus - Automate WebGUI's InOut Board User status switching. - -=head1 SYNOPSIS - - changeIobStatus --configFile config.conf - [--currentStatus status] - [--newStatus status] - [--userMessage text|--userMessageFile pathname] - [--whatsHappening text] - [--quiet] - - changeIobStatus --help - -=head1 DESCRIPTION - -This WebGUI utility script helps you switch one or more user status -in the InOut Board (IOB). For instance, you might want to run it -from cron each night to automatically mark out all users that haven't -already marked out. - -=over - -=item B<--configFile config.conf> - -The WebGUI config file to use. Only the file name needs to be specified, -since it will be looked up inside WebGUI's configuration directory. -This parameter is required. - -=item B<--currentStatus status> - -Check users in the IOB having B status. If left unspecified, -it will default to C. - -=item B<--newStatus status> - -Change users status in the IOB to B status. If left unspecified, -it will default to C. - -=item B<--userMessage msg> - -Text of the message to be sent to the user after changing the status. -If left unspecified it will default to - - You were logged out of the In/Out Board automatically. - -=item B<--userMessageFile pathname> - -Pathname to a file whose contents will be sent to the user after changing -the status. Using this option overrides whatever messages is set -with B<--userMessage> (see above). - -=item B<--whatsHappening text> - -The message attached to the InOut Board when changing status. If left -unspecified it defaults to - - Automatically signed out. - -=item B<--quiet> - -Disable all output unless there's an error. - -=item B<--help> - -Shows this documentation, then exits. - -=back - -=head1 AUTHOR - -Copyright 2001-2009 Plain Black Corporation. - -=cut +#!/usr/bin/env perl + +#------------------------------------------------------------------- +# WebGUI is Copyright 2001-2009 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 File::Basename (); +use File::Spec; + +my $webguiRoot; +BEGIN { + $webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir)); + unshift @INC, File::Spec->catdir($webguiRoot, 'lib'); +} + +use Getopt::Long; +use Pod::Usage; +use WebGUI::Session; +use WebGUI::User; +use WebGUI::Inbox; + +$|=1; + +my $configFile; +my $help; +my $quiet; +my $whatsHappening = "Automatically signed out."; +my $newStatus = "Out"; +my $currentStatus = "In"; +my $userMessage = "You were logged out of the In/Out Board automatically."; +my $userMessageFile; + + +GetOptions( + 'configfile=s'=>\$configFile, + 'help'=>\$help, + 'quiet'=>\$quiet, + 'whatsHappening:s'=>\$whatsHappening, + 'userMessage:s'=>\$userMessage, + 'userMessageFile:s'=>\$userMessageFile, + 'currentStatus:s'=>\$currentStatus, + 'newStatus:s'=>\$newStatus +); + +pod2usage( verbose => 2 ) if $help; +pod2usage() unless $configFile; + +print "Starting up...\n" unless ($quiet); +my $session = WebGUI::Session->open($webguiRoot,$configFile); + +if ($userMessageFile) { + print "Opening message file.." unless ($quiet); + if (open(FILE,"<".$userMessageFile)) { + print "OK\n" unless ($quiet); + my $contents; + while () { + $contents .= $_; + } + close(FILE); + if (length($contents) == 0) { + print "Message file empty, reverting to original message.\n"; + } else { + $userMessage = $contents; + } + } else { + print "Failed to open message file.\n"; + } +} + +print "Searching for users with a status of $currentStatus ...\n" unless ($quiet); +my $userList; +my $now = time(); +my $inbox = WebGUI::Inbox->new($session); +my $sth = $session->db->read("select userId,assetId from InOutBoard_status where status=?",[$currentStatus]); +while (my ($userId,$assetId) = $sth->array) { + my $user = WebGUI::User->new($session, $userId); + print "\tFound user ".$user->username."\n" unless ($quiet); + $userList .= $user->username." (".$userId.")\n"; + $session->db->write("update InOutBoard_status set dateStamp=?, message=?, status=? where userId=? and assetId=?",[$now, $whatsHappening, $newStatus, $userId, $assetId]); + $session->db->write("insert into InOutBoard_statusLog (userId, createdBy, dateStamp, message, status, assetId) values (?,?,?,?,?,?)", + [$userId,3,$now, $whatsHappening, $newStatus, $assetId]); + $inbox->addMessage({ + userId=>$userId, + subject=>"IOB Update", + message=>$userMessage + }); +} + +if (length($userList) > 0) { + print "Alerting admins of changes\n" unless ($quiet); + my $message = "The following users had their status changed:\n\n".$userList; + $inbox->addMessage({ + groupId=>3, + subject=>"IOB Update", + message=>$userMessage + }); +} + +print "Cleaning up..." unless ($quiet); +$session->var->end; +$session->close; +print "OK\n" unless ($quiet); + +__END__ + +=head1 NAME + +changeIobStatus - Automate WebGUI's InOut Board User status switching. + +=head1 SYNOPSIS + + changeIobStatus --configFile config.conf + [--currentStatus status] + [--newStatus status] + [--userMessage text|--userMessageFile pathname] + [--whatsHappening text] + [--quiet] + + changeIobStatus --help + +=head1 DESCRIPTION + +This WebGUI utility script helps you switch one or more user status +in the InOut Board (IOB). For instance, you might want to run it +from cron each night to automatically mark out all users that haven't +already marked out. + +=over + +=item B<--configFile config.conf> + +The WebGUI config file to use. Only the file name needs to be specified, +since it will be looked up inside WebGUI's configuration directory. +This parameter is required. + +=item B<--currentStatus status> + +Check users in the IOB having B status. If left unspecified, +it will default to C. + +=item B<--newStatus status> + +Change users status in the IOB to B status. If left unspecified, +it will default to C. + +=item B<--userMessage msg> + +Text of the message to be sent to the user after changing the status. +If left unspecified it will default to + + You were logged out of the In/Out Board automatically. + +=item B<--userMessageFile pathname> + +Pathname to a file whose contents will be sent to the user after changing +the status. Using this option overrides whatever messages is set +with B<--userMessage> (see above). + +=item B<--whatsHappening text> + +The message attached to the InOut Board when changing status. If left +unspecified it defaults to + + Automatically signed out. + +=item B<--quiet> + +Disable all output unless there's an error. + +=item B<--help> + +Shows this documentation, then exits. + +=back + +=head1 AUTHOR + +Copyright 2001-2009 Plain Black Corporation. + +=cut diff --git a/sbin/diskUsage.pl b/sbin/diskUsage.pl index d15f3a69c..a8990359f 100755 --- a/sbin/diskUsage.pl +++ b/sbin/diskUsage.pl @@ -10,16 +10,18 @@ # http://www.plainblack.com info@plainblack.com #------------------------------------------------------------------- -our ($webguiRoot); +use strict; +use File::Basename (); +use File::Spec; +my $webguiRoot; BEGIN { - $webguiRoot = ".."; - unshift (@INC, $webguiRoot."/lib"); + $webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir)); + unshift @INC, File::Spec->catdir($webguiRoot, 'lib'); } use Getopt::Long; use Pod::Usage; -use strict; use WebGUI::Session; use WebGUI::Asset; diff --git a/sbin/fileImport.pl b/sbin/fileImport.pl index 29bdfbd92..f0bfe1606 100755 --- a/sbin/fileImport.pl +++ b/sbin/fileImport.pl @@ -10,15 +10,17 @@ # http://www.plainblack.com info@plainblack.com #------------------------------------------------------------------- -our ($webguiRoot, @nailable); +use strict; +use File::Basename (); +use File::Spec; -BEGIN { - $webguiRoot = ".."; - @nailable = qw(jpg jpeg png gif); - unshift (@INC, $webguiRoot."/lib"); +my $webguiRoot; +BEGIN { + $webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir)); + unshift @INC, File::Spec->catdir($webguiRoot, 'lib'); } - +my @nailable = qw(jpg jpeg png gif); $| = 1; use File::Path; @@ -27,7 +29,6 @@ use FileHandle; use Getopt::Long; use POSIX; use Pod::Usage; -use strict; use WebGUI::Asset::File; use WebGUI::Asset::File::Image; use WebGUI::Session; diff --git a/sbin/galleryImport.pl b/sbin/galleryImport.pl index 7f6570274..6b4fa3ff7 100755 --- a/sbin/galleryImport.pl +++ b/sbin/galleryImport.pl @@ -10,9 +10,17 @@ # http://www.plainblack.com info@plainblack.com # ------------------------------------------------------------------- -$|=1; -use lib '../lib'; use strict; +use File::Basename (); +use File::Spec; + +my $webguiRoot; +BEGIN { + $webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir)); + unshift @INC, File::Spec->catdir($webguiRoot, 'lib'); +} + +$|=1; use Carp qw( carp croak ); use File::Find; use Getopt::Long; diff --git a/sbin/generateContent.pl b/sbin/generateContent.pl index 9a58208e6..85182248c 100755 --- a/sbin/generateContent.pl +++ b/sbin/generateContent.pl @@ -10,19 +10,21 @@ # http://www.plainblack.com info@plainblack.com #------------------------------------------------------------------- - -our $webguiRoot; +use strict; +use File::Basename (); +use File::Spec; +my $webguiRoot; BEGIN { - $webguiRoot = ".."; - unshift (@INC, $webguiRoot."/lib"); + $webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir)); + unshift @INC, File::Spec->catdir($webguiRoot, 'lib'); } use DBI; use FileHandle; use Getopt::Long; use Pod::Usage; -use strict qw(subs vars); +no strict 'refs'; use WebGUI::Session; use WebGUI::Asset; diff --git a/sbin/installClass.pl b/sbin/installClass.pl index 6105cfefe..60e3dc095 100755 --- a/sbin/installClass.pl +++ b/sbin/installClass.pl @@ -11,8 +11,16 @@ # http://www.plainblack.com info@plainblack.com #------------------------------------------------------------------- -use lib "../lib"; use strict; +use File::Basename (); +use File::Spec; + +my $webguiRoot; +BEGIN { + $webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir)); + unshift @INC, File::Spec->catdir($webguiRoot, 'lib'); +} + use Getopt::Long; use Pod::Usage; use WebGUI::Pluggable; diff --git a/sbin/maintenanceMode.pl b/sbin/maintenanceMode.pl index e757056f5..820d6624b 100755 --- a/sbin/maintenanceMode.pl +++ b/sbin/maintenanceMode.pl @@ -10,17 +10,18 @@ # http://www.plainblack.com info@plainblack.com #------------------------------------------------------------------- +use strict; +use File::Basename (); +use File::Spec; -our ($webguiRoot); - +my $webguiRoot; BEGIN { - $webguiRoot = ".."; - unshift (@INC, $webguiRoot."/lib"); + $webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir)); + unshift @INC, File::Spec->catdir($webguiRoot, 'lib'); } use Getopt::Long; use Pod::Usage; -use strict; use WebGUI::Session; my $help; diff --git a/sbin/purgeWGAccess.pl b/sbin/purgeWGAccess.pl index 9ea4312fd..1f1b15d09 100755 --- a/sbin/purgeWGAccess.pl +++ b/sbin/purgeWGAccess.pl @@ -10,14 +10,16 @@ # http://www.plainblack.com info@plainblack.com #------------------------------------------------------------------- -our ($webguiRoot); +use strict; +use File::Basename (); +use File::Spec; +my $webguiRoot; BEGIN { - $webguiRoot = ".."; - unshift (@INC, $webguiRoot."/lib"); + $webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir)); + unshift @INC, File::Spec->catdir($webguiRoot, 'lib'); } -use strict; use Getopt::Long; use Pod::Usage; use WebGUI::Config; diff --git a/sbin/rebuildLineage.pl b/sbin/rebuildLineage.pl index 355d55ff9..aed1f0f90 100755 --- a/sbin/rebuildLineage.pl +++ b/sbin/rebuildLineage.pl @@ -10,19 +10,20 @@ # http://www.plainblack.com info@plainblack.com #------------------------------------------------------------------- -our ($webguiRoot); +use strict; +use File::Basename (); +use File::Spec; -BEGIN { - $webguiRoot = ".."; - unshift (@INC, $webguiRoot."/lib"); +my $webguiRoot; +BEGIN { + $webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir)); + unshift @INC, File::Spec->catdir($webguiRoot, 'lib'); } - $| = 1; use Getopt::Long; use Pod::Usage; -use strict; use WebGUI::Session; use WebGUI::Utility; diff --git a/sbin/search.pl b/sbin/search.pl index 12e188345..d086e0fa3 100755 --- a/sbin/search.pl +++ b/sbin/search.pl @@ -10,14 +10,16 @@ # http://www.plainblack.com info@plainblack.com #------------------------------------------------------------------- -our ($webguiRoot); +use strict; +use File::Basename (); +use File::Spec; +my $webguiRoot; BEGIN { - $webguiRoot = ".."; - unshift (@INC, $webguiRoot."/lib"); + $webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir)); + unshift @INC, File::Spec->catdir($webguiRoot, 'lib'); } -use strict; use Getopt::Long; use WebGUI::Asset; use WebGUI::Config; diff --git a/sbin/spectre.pl b/sbin/spectre.pl index 99d88217a..309467008 100755 --- a/sbin/spectre.pl +++ b/sbin/spectre.pl @@ -10,15 +10,17 @@ # http://www.plainblack.com info@plainblack.com #------------------------------------------------------------------- -our ($webguiRoot); +use strict; +use File::Basename (); +use File::Spec; +my $webguiRoot; BEGIN { - $webguiRoot = ".."; - unshift (@INC, $webguiRoot."/lib"); + $webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir)); + unshift @INC, File::Spec->catdir($webguiRoot, 'lib'); } use Pod::Usage; -use strict; use warnings; use Getopt::Long; use POE::Component::IKC::ClientLite; diff --git a/sbin/syncToCdn.pl b/sbin/syncToCdn.pl old mode 100644 new mode 100755 index 4f3ef30ac..822a984db --- a/sbin/syncToCdn.pl +++ b/sbin/syncToCdn.pl @@ -1,3 +1,5 @@ +#!/usr/bin/env perl + #------------------------------------------------------------------- # WebGUI is Copyright 2001-2009 Plain Black Corporation. #------------------------------------------------------------------- @@ -8,14 +10,16 @@ # http://www.plainblack.com info@plainblack.com #------------------------------------------------------------------- -our $webguiRoot; +use strict; +use File::Basename (); +use File::Spec; +my $webguiRoot; BEGIN { - $webguiRoot = ".."; - unshift( @INC, $webguiRoot . "/lib" ); + $webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir)); + unshift @INC, File::Spec->catdir($webguiRoot, 'lib'); } -use strict; use Fcntl ':flock'; use Getopt::Long; use WebGUI::Session; diff --git a/sbin/testCodebase.pl b/sbin/testCodebase.pl index 7a24fa501..9b1d2dad0 100755 --- a/sbin/testCodebase.pl +++ b/sbin/testCodebase.pl @@ -10,9 +10,18 @@ # http://www.plainblack.com info@plainblack.com #------------------------------------------------------------------- +use strict; +use File::Basename (); +use File::Spec; + +my $webguiRoot; +BEGIN { + $webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir)); + unshift @INC, File::Spec->catdir($webguiRoot, 'lib'); +} + $|=1; -use strict; use FindBin; use File::Spec qw[]; use Getopt::Long; @@ -48,14 +57,13 @@ if (! -e $configFile) { ##Probably given the name of the config file with no path, ##attempt to prepend the path to it. warn "Config file $configFile does not exist, assuming that you supplied a bare config and are running from inside the sbin directory\n"; - $configFile = File::Spec->canonpath($FindBin::Bin.'/../etc/'.$configFile); + $configFile = File::Spec->canonpath($webguiRoot . '/etc/' . $configFile); } die "Unable to use $configFile as a WebGUI config file\n" unless(-e $configFile and -f _); my (undef, $directories, $file) = File::Spec->splitpath($configFile); -my $webguiRoot = File::Spec->canonpath(File::Spec->catdir($directories, File::Spec->updir)); my $webguiTest = File::Spec->catdir($webguiRoot, 't'); my $prefix = "WEBGUI_CONFIG=".$configFile; diff --git a/sbin/testEnvironment.pl b/sbin/testEnvironment.pl index 3205eb8e2..2f23c263d 100755 --- a/sbin/testEnvironment.pl +++ b/sbin/testEnvironment.pl @@ -10,15 +10,16 @@ # http://www.plainblack.com info@plainblack.com #------------------------------------------------------------------- +use strict; +use File::Basename (); +use File::Spec; -our $webguiRoot; - +my $webguiRoot; BEGIN { - $webguiRoot = ".."; - unshift (@INC, $webguiRoot."/lib"); + $webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir)); + unshift @INC, File::Spec->catdir($webguiRoot, 'lib'); } -use strict; use CPAN; use Getopt::Long; use Pod::Usage; diff --git a/sbin/thumbnailer.pl b/sbin/thumbnailer.pl index 88ac1013f..881f1d85c 100755 --- a/sbin/thumbnailer.pl +++ b/sbin/thumbnailer.pl @@ -10,11 +10,14 @@ # http://www.plainblack.com info@plainblack.com #------------------------------------------------------------------- -our ($webguiRoot); +use strict; +use File::Basename (); +use File::Spec; +my $webguiRoot; BEGIN { - $webguiRoot = ".."; - unshift (@INC, $webguiRoot."/lib"); + $webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir)); + unshift @INC, File::Spec->catdir($webguiRoot, 'lib'); } #----------------------------------------- diff --git a/sbin/upgrade.pl b/sbin/upgrade.pl index 7e1e9a332..5c3941d83 100755 --- a/sbin/upgrade.pl +++ b/sbin/upgrade.pl @@ -10,14 +10,16 @@ # http://www.plainblack.com info@plainblack.com #------------------------------------------------------------------- -our ($webguiRoot); +use strict; +use File::Basename (); +use File::Spec; +my $webguiRoot; BEGIN { - $webguiRoot = ".."; - unshift (@INC, $webguiRoot."/lib"); + $webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir)); + unshift @INC, File::Spec->catdir($webguiRoot, 'lib'); } -use strict; use Cwd (); use File::Path (); use Getopt::Long (); diff --git a/sbin/userImport.pl b/sbin/userImport.pl index 55c9719bb..ccad6badc 100755 --- a/sbin/userImport.pl +++ b/sbin/userImport.pl @@ -10,14 +10,16 @@ # http://www.plainblack.com info@plainblack.com #------------------------------------------------------------------- -our ($webguiRoot); +use strict; +use File::Basename (); +use File::Spec; +my $webguiRoot; BEGIN { - $webguiRoot = ".."; - unshift (@INC, $webguiRoot."/lib"); + $webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir)); + unshift @INC, File::Spec->catdir($webguiRoot, 'lib'); } -use strict; use Digest::MD5; use Getopt::Long; use Pod::Usage; From 7c7136f02a834e614b7e3083a7495c2fa755abf3 Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Thu, 15 Apr 2010 14:03:09 -0500 Subject: [PATCH 09/10] remove useless variable declaration --- lib/WebGUI/URL/Uploads.pm | 1 - 1 file changed, 1 deletion(-) diff --git a/lib/WebGUI/URL/Uploads.pm b/lib/WebGUI/URL/Uploads.pm index aa6138bbd..000b3c3c1 100644 --- a/lib/WebGUI/URL/Uploads.pm +++ b/lib/WebGUI/URL/Uploads.pm @@ -55,7 +55,6 @@ sub handler { return Apache2::Const::OK unless -e $path . '.wgaccess'; - my $fileContents; open my $FILE, '<' , $path . '.wgaccess'; my $fileContents = do { local $/; <$FILE> }; close($FILE); From 1a77fce84357957e5714ca3c91dab9c4a37d86c0 Mon Sep 17 00:00:00 2001 From: Paul Driver Date: Fri, 16 Apr 2010 15:24:34 -0700 Subject: [PATCH 10/10] make it impossible to have a locked working tag --- lib/WebGUI/VersionTag.pm | 31 +++++++++++++++++++++---------- t/VersionTag.t | 26 ++++++++++++++++++++++++-- 2 files changed, 45 insertions(+), 12 deletions(-) diff --git a/lib/WebGUI/VersionTag.pm b/lib/WebGUI/VersionTag.pm index d440f2963..917177795 100644 --- a/lib/WebGUI/VersionTag.pm +++ b/lib/WebGUI/VersionTag.pm @@ -438,15 +438,15 @@ sub getWorking { #First see if there is already a version tag $tag = $stow->get(q{versionTag}); - return $tag if $tag; + return $tag if ($tag && !$tag->isLocked); $tagId = $session->scratch()->get(q{versionTag}); if ($tagId) { $tag = $class->new($session, $tagId); - - $stow->set(q{versionTag}, $tag); - - return $tag; + unless ($tag->isLocked) { + $stow->set(q{versionTag}, $tag); + return $tag; + } } #No tag found. Create or reclaim one? @@ -475,10 +475,10 @@ sub getWorking { # For now, we only reclaim if 1 tag open. if (scalar @openTags == 1) { $tag = $openTags[0]; - - $tag->setWorking(); - - return $tag; + unless ($tag->isLocked) { + $tag->setWorking(); + return $tag; + } } } elsif ($mode eq q{siteWide}) { @@ -486,7 +486,7 @@ sub getWorking { OPENTAG: foreach my $openTag (@{WebGUI::VersionTag->getOpenTags($session)}) { - if ($openTag->get(q{isSiteWide})) { + if ($openTag->get(q{isSiteWide}) && !$openTag->isLocked) { $tag = $openTag; @@ -515,6 +515,16 @@ sub getWorking { #------------------------------------------------------------------- +=head2 isLocked ( ) + +Returns boolean value indicating whether tag is locked + +=cut + +sub isLocked { $_[0]{_data}{isLocked} } + +#------------------------------------------------------------------- + =head2 leaveTag ( ) Make the user leave their current tag. @@ -734,6 +744,7 @@ Sets this tag as the working tag for the current user. sub setWorking { my $self = shift; + return if $self->isLocked; $self->session->scratch->set("versionTag",$self->getId); $self->session->stow->set("versionTag", $self); } diff --git a/t/VersionTag.t b/t/VersionTag.t index 368393a96..0a981e896 100644 --- a/t/VersionTag.t +++ b/t/VersionTag.t @@ -14,7 +14,7 @@ use lib "$FindBin::Bin/lib"; use WebGUI::Test; use WebGUI::Session; use WebGUI::VersionTag; -use Test::More tests => 74; # increment this value for each test you create +use Test::More tests => 81; # increment this value for each test you create my $session = WebGUI::Test->session; @@ -105,14 +105,36 @@ $tag->clearWorking; ok(!defined getWorking(1), 'working tag unset'); ok(!scalar $tag->get('isLocked'), 'tag is initially unlocked'); +ok(!$tag->isLocked,'accessor for isLocked works on false'); $tag->lock; ok(scalar $tag->get('isLocked'), 'tag is locked'); +ok($tag->isLocked, 'accessor for isLocked works on true'); ok_open($tag->getId, 0, 'locked tag'); $tag->unlock; ok(!scalar $tag->get('isLocked'), 'tag is again unlocked'); ok_open($tag->getId, 1, 'unlocked tag'); -# TODO: test interaction between lock/unlock and working tags +# test interaction between lock/unlock and working tags +my $locker = WebGUI::VersionTag->create($session); +$locker->setWorking(); +is getWorking(1), $locker, 'working tag is the one we are about to lock'; + +$locker->lock(); +ok !defined getWorking(1), 'lock clears working'; + +my $unlocked = WebGUI::VersionTag->create($session); +$unlocked->setWorking(); +is getWorking(1), $unlocked, 'working tag is fresh'; +$locker->setWorking(); +is getWorking(1), $unlocked, 'setWorking on locked tag does nothing'; +$unlocked->clearWorking; +$unlocked->rollback; + +$session->stow->set(versionTag => $locker); +$session->scratch->set(versionTag => $locker->getId); +isnt getWorking(1), $locker, 'getWorking never returns locked tag'; +$locker->clearWorking; +$locker->rollback; my $tagAgain1 = WebGUI::VersionTag->new($session, $tag->getId); isa_ok($tagAgain1, 'WebGUI::VersionTag', 'tag retrieved again while valid');