1 rizwank 1.1 # Module of TWiki Collaboration Platform, http://TWiki.org/
2 #
3 # Copyright (C) 2000-2004 Peter Thoeny, Peter@Thoeny.com
4 #
5 # For licensing info read license.txt file in the TWiki root.
6 # This program is free software; you can redistribute it and/or
7 # modify it under the terms of the GNU General Public License
8 # as published by the Free Software Foundation; either version 2
9 # of the License, or (at your option) any later version.
10 #
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details, published at
15 # http://www.gnu.org/copyleft/gpl.html
16 #
17 # Notes:
18 # - Latest version at http://twiki.org/
19 # - Installation instructions in $dataDir/TWiki/TWikiDocumentation.txt
20 # - Customize variables in TWiki.cfg when installing TWiki.
21 # - Upgrading TWiki is easy as long as you use Plugins.
22 rizwank 1.1 # - Check web server error logs for errors, i.e. % tail /var/log/httpd/error_log
23 #
24 # Note: Use the TWiki:Plugins/PerlDocPlugin to extract the documentation
25 # Unlike in other modules, do not use a ---+ level one heading
26
27 =begin twiki
28
29 ---++ Description
30
31 This module defines official funtions that [[%TWIKIWEB%.TWikiPlugins][Plugins]]
32 and add-on scripts can use to interact with the TWiki engine and content.
33
34 Plugins should *only* use functions published in this module. If you use
35 functions in other TWiki libraries you might impose a security hole and
36 you will likely need to change your Plugin when you upgrade TWiki.
37
38 The version of the TWiki::Func module is defined by the VERSION number of the
39 TWiki::Plugins module, currently %PLUGINVERSION{}%. This can be shown by the
40 =%<nop>PLUGINVERSION{}%= variable. The "Since" field in the function documentation
41 refers to the VERSION number and the date that the function was addded.
42
43 rizwank 1.1 =cut
44
45 package TWiki::Func;
46
47 use strict;
48
49 # =========================
50 =pod
51
52 ---++ Functions: CGI Environment
53
54 ---+++ getSessionValue( $key ) ==> $value
55
56 | Description: | Get a session value from the Session Plugin (if installed) |
57 | Parameter: =$key= | Session key |
58 | Return: =$value= | Value associated with key; empty string if not set; undef if session plugin is not installed |
59 | Since: | TWiki::Plugins::VERSION 1.000 (27 Feb 2001) |
60
61 =cut
62 # -------------------------
63 sub getSessionValue
64 rizwank 1.1 {
65 # my( $theKey ) = @_;
66 return &TWiki::getSessionValue( @_ );
67 }
68
69
70 # =========================
71 =pod
72
73 ---+++ setSessionValue( $key, $value ) ==> $result
74
75 | Description: | Set a session value via the Session Plugin (if installed) |
76 | Parameter: =$key= | Session key |
77 | Parameter: =$value= | Value associated with key |
78 | Return: =$result= | ="1"= if success; undef if session plugin is not installed |
79 | Since: | TWiki::Plugins::VERSION 1.000 (17 Aug 2001) |
80
81 =cut
82 # -------------------------
83 sub setSessionValue
84 {
85 rizwank 1.1 # my( $theKey, $theValue ) = @_;
86 &TWiki::setSessionValue( @_ );
87 }
88
89 # =========================
90 =pod
91
92 ---+++ getSkin( ) ==> $skin
93
94 | Description: | Get the name of the skin, set by the =SKIN= preferences variable or the =skin= CGI parameter |
95 | Return: =$skin= | Name of skin, e.g. ="gnu"=. Empty string if none |
96 | Since: | TWiki::Plugins::VERSION 1.000 (29 Jul 2001) |
97
98 =cut
99 # -------------------------
100 sub getSkin
101 {
102 return &TWiki::getSkin();
103 }
104
105 # =========================
106 rizwank 1.1 =pod
107
108 ---+++ getUrlHost( ) ==> $host
109
110 | Description: | Get protocol, domain and optional port of script URL |
111 | Return: =$host= | URL host, e.g. ="http://example.com:80"= |
112 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
113
114 =cut
115 # -------------------------
116 sub getUrlHost
117 {
118 return $TWiki::urlHost;
119 }
120
121 # =========================
122 =pod
123
124 ---+++ getScriptUrl( $web, $topic, $script ) ==> $url
125
126 | Description: | Compose fully qualified URL |
127 rizwank 1.1 | Parameter: =$web= | Web name, e.g. ="Main"= |
128 | Parameter: =$topic= | Topic name, e.g. ="WebNotify"= |
129 | Parameter: =$script= | Script name, e.g. ="view"= |
130 | Return: =$url= | URL, e.g. ="http://example.com:80/cgi-bin/view.pl/Main/WebNotify"= |
131 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
132
133 =cut
134 # -------------------------
135 sub getScriptUrl
136 {
137 # my( $web, $topic, $script ) = @_;
138 return &TWiki::getScriptUrl( @_ );
139 }
140
141 # =========================
142 =pod
143
144 ---+++ getScriptUrlPath( ) ==> $path
145
146 | Description: | Get script URL path |
147 | Return: =$path= | URL path of TWiki scripts, e.g. ="/cgi-bin"= |
148 rizwank 1.1 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
149
150 =cut
151 # -------------------------
152 sub getScriptUrlPath
153 {
154 return $TWiki::scriptUrlPath;
155 }
156
157 # =========================
158 =pod
159
160 ---+++ getViewUrl( $web, $topic ) ==> $url
161
162 | Description: | Compose fully qualified view URL |
163 | Parameter: =$web= | Web name, e.g. ="Main"=. The current web is taken if empty |
164 | Parameter: =$topic= | Topic name, e.g. ="WebNotify"= |
165 | Return: =$url= | URL, e.g. ="http://example.com:80/cgi-bin/view.pl/Main/WebNotify"= |
166 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
167
168 =cut
169 rizwank 1.1 # -------------------------
170 sub getViewUrl
171 {
172 # my( $web, $topic ) = @_;
173 return &TWiki::getViewUrl( @_ );
174 }
175
176 # =========================
177 =pod
178
179 ---+++ getOopsUrl( $web, $topic, $template, $param1, $param2, $param3, $param4 ) ==> $url
180
181 | Description: | Compose fully qualified "oops" dialog URL |
182 | Parameter: =$web= | Web name, e.g. ="Main"=. The current web is taken if empty |
183 | Parameter: =$topic= | Topic name, e.g. ="WebNotify"= |
184 | Parameter: =$template= | Oops template name, e.g. ="oopslocked"= |
185 | Parameter: =$param1= ... =$param4= | Parameter values for %<nop>PARAM1% ... %<nop>PARAM4% variables in template, optional |
186 | Return: =$url= | URL, e.g. ="http://example.com:80/cgi-bin/oops.pl/ Main/WebNotify?template=oopslocked&param1=joe"= |
187 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
188
189 =cut
190 rizwank 1.1 # -------------------------
191 sub getOopsUrl
192 {
193 # my( $web, $topic, $template, @params ) = @_;
194 # up to 4 parameters in @theParams
195 return &TWiki::getOopsUrl( @_ );
196 }
197
198 # =========================
199 =pod
200
201 ---+++ getPubUrlPath( ) ==> $path
202
203 | Description: | Get pub URL path |
204 | Return: =$path= | URL path of pub directory, e.g. ="/pub"= |
205 | Since: | TWiki::Plugins::VERSION 1.000 (14 Jul 2001) |
206
207 =cut
208 # -------------------------
209 sub getPubUrlPath
210 {
211 rizwank 1.1 return &TWiki::getPubUrlPath();
212 }
213
214 # =========================
215 =pod
216
217 ---+++ getCgiQuery( ) ==> $query
218
219 | Description: | Get CGI query object. Important: Plugins cannot assume that scripts run under CGI, Plugins must always test if the CGI query object is set |
220 | Return: =$query= | CGI query object; or 0 if script is called as a shell script |
221 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
222
223 =cut
224 # -------------------------
225 sub getCgiQuery
226 {
227 return &TWiki::getCgiQuery();
228 }
229
230 # =========================
231 =pod
232 rizwank 1.1
233 ---+++ writeHeader( $query )
234
235 | Description: | Prints a basic content-type HTML header for text/html to standard out |
236 | Parameter: =$query= | CGI query object |
237 | Return: | none |
238 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
239
240 =cut
241 # -------------------------
242 sub writeHeader
243 {
244 # my( $theQuery ) = @_;
245 return &TWiki::writeHeader( @_ );
246 }
247
248 # =========================
249 =pod
250
251 ---+++ redirectCgiQuery( $query, $url )
252
253 rizwank 1.1 | Description: | Redirect to URL |
254 | Parameter: =$query= | CGI query object |
255 | Parameter: =$url= | URL to redirect to |
256 | Return: | none, never returns |
257 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
258
259 =cut
260 # -------------------------
261 sub redirectCgiQuery
262 {
263 # my( $theQuery, $theUrl ) = @_;
264 return &TWiki::redirect( @_ );
265 }
266
267 # =========================
268 =pod
269
270 ---++ Functions: Preferences
271
272 ---+++ extractParameters( $attr ) ==> %params
273
274 rizwank 1.1 | Description: | Extract all parameters from a variable string and returns a hash of parameters |
275 | Parameter: =$attr= | Attribute string |
276 | Return: =%params= | Hash containing all parameters. The nameless parameter is stored in key =_DEFAULT= |
277 | Since: | TWiki::Plugins::VERSION 1.025 (26 Aug 2004) |
278
279 * Example:
280 * Variable: =%<nop>TEST{ "nameless" name1="val1" name2="val2" }%=
281 * First extract text between ={...}= to get: ="nameless" name1="val1" name2="val2"=
282 * Then call this on the text: <br />
283 =my %params = TWiki::Func::extractParameters( $text );=
284 * The =%params= hash contains now: <br />
285 =_DEFAULT => "nameless"= <br />
286 =name1 => "val1"= <br />
287 =name2 => "val2"=
288
289 =cut
290 # -------------------------
291 sub extractParameters
292 {
293 # my( $theAttr ) = @_;
294 return &TWiki::extractParameters( @_ );
295 rizwank 1.1 }
296
297 # =========================
298 =pod
299
300 ---+++ extractNameValuePair( $attr, $name ) ==> $value
301
302 | Description: | Extract a named or unnamed value from a variable parameter string |
303 | Note: | Function TWiki::Func::extractParameters is more efficient for extracting several parameters |
304 | Parameter: =$attr= | Attribute string |
305 | Parameter: =$name= | Name, optional |
306 | Return: =$value= | Extracted value |
307 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
308
309 * Example:
310 * Variable: =%<nop>TEST{ "nameless" name1="val1" name2="val2" }%=
311 * First extract text between ={...}= to get: ="nameless" name1="val1" name2="val2"=
312 * Then call this on the text: <br />
313 =my $noname = TWiki::Func::extractNameValuePair( $text );= <br />
314 =my $val1 = TWiki::Func::extractNameValuePair( $text, "name1" );= <br />
315 =my $val2 = TWiki::Func::extractNameValuePair( $text, "name2" );=
316 rizwank 1.1
317 =cut
318 # -------------------------
319 sub extractNameValuePair
320 {
321 # my( $theAttr, $theName ) = @_;
322 return &TWiki::extractNameValuePair( @_ );
323 }
324
325 # =========================
326 =pod
327
328 ---+++ getPreferencesValue( $key, $web ) ==> $value
329
330 | Description: | Get a preferences value from TWiki or from a Plugin |
331 | Parameter: =$key= | Preferences key |
332 | Parameter: =$web= | Name of web, optional. Current web if not specified; does not apply to settings of Plugin topics |
333 | Return: =$value= | Preferences value; empty string if not set |
334 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
335
336 * Example for Plugin setting:
337 rizwank 1.1 * MyPlugin topic has: =* Set COLOR = red=
338 * Use ="MYPLUGIN_COLOR"= for =$key=
339 * =my $color = TWiki::Func::getPreferencesValue( "MYPLUGIN_COLOR" );=
340
341 * Example for preferences setting:
342 * WebPreferences topic has: =* Set WEBBGCOLOR = #FFFFC0=
343 * =my $webColor = TWiki::Func::getPreferencesValue( "WEBBGCOLOR", "Sandbox" );=
344
345 =cut
346 # -------------------------
347 sub getPreferencesValue
348 {
349 # my( $theKey, $theWeb ) = @_;
350 return &TWiki::Prefs::getPreferencesValue( @_ );
351 }
352
353 =pod
354
355 ---+++ getPluginPreferencesValue( $key ) ==> $value
356
357 | Description: | Get a preferences value from your Plugin |
358 rizwank 1.1 | Parameter: =$key= | Plugin Preferences key w/o PLUGINNAME_ prefix. |
359 | Return: =$value= | Preferences value; empty string if not set |
360 | Since: | TWiki::Plugins::VERSION 1.021 (27 Mar 2004) |
361
362 =cut
363
364 sub getPluginPreferencesValue
365 {
366 my( $theKey ) = @_;
367 my $package = caller;
368 $package =~ s/.*:://; # strip off TWiki::Plugins:: prefix
369 return TWiki::Prefs::getPreferencesValue( "\U$package\E_$theKey" );
370 }
371
372 # =========================
373 =pod
374
375 ---+++ getPreferencesFlag( $key, $web ) ==> $value
376
377 | Description: | Get a preferences flag from TWiki or from a Plugin |
378 | Parameter: =$key= | Preferences key |
379 rizwank 1.1 | Parameter: =$web= | Name of web, optional. Current web if not specified; does not apply to settings of Plugin topics |
380 | Return: =$value= | Preferences flag ="1"= (if set), or ="0"= (for preferences values ="off"=, ="no"= and ="0"=) |
381 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
382
383 * Example for Plugin setting:
384 * MyPlugin topic has: =* Set SHOWHELP = off=
385 * Use ="MYPLUGIN_SHOWHELP"= for =$key=
386 * =my $showHelp = TWiki::Func::getPreferencesFlag( "MYPLUGIN_SHOWHELP" );=
387
388 =cut
389 # -------------------------
390 sub getPreferencesFlag
391 {
392 # my( $theKey, $theWeb ) = @_;
393 return &TWiki::Prefs::getPreferencesFlag( @_ );
394 }
395
396 =pod
397
398 ---+++ getPluginPreferencesFlag( $key ) ==> $flag
399
400 rizwank 1.1 | Description: | Get a preferences flag from your Plugin |
401 | Parameter: =$key= | Plugin Preferences key w/o PLUGINNAME_ prefix. |
402 | Return: =$flag= | Preferences flag ="1"= (if set), or ="0"= (for preferences values ="off"=, ="no"= and ="0"=, or values not set at all) |
403 | Since: | TWiki::Plugins::VERSION 1.021 (27 Mar 2004) |
404
405 =cut
406
407 sub getPluginPreferencesFlag
408 {
409 my( $theKey ) = @_;
410 my $package = caller;
411 $package =~ s/.*:://; # strip off TWiki::Plugins:: prefix
412 return TWiki::Prefs::getPreferencesFlag( "\U$package\E_$theKey" );
413 }
414
415 # =========================
416 =pod
417
418 ---+++ getWikiToolName( ) ==> $name
419
420 | Description: | Get toolname as defined in TWiki.cfg |
421 rizwank 1.1 | Return: =$name= | Name of tool, e.g. ="TWiki"= |
422 | Since: | TWiki::Plugins::VERSION 1.000 (27 Feb 2001) |
423
424 =cut
425 # -------------------------
426 sub getWikiToolName
427 {
428 return $TWiki::wikiToolName;
429 }
430
431 # =========================
432 =pod
433
434 ---+++ getMainWebname( ) ==> $name
435
436 | Description: | Get name of Main web as defined in TWiki.cfg |
437 | Return: =$name= | Name, e.g. ="Main"= |
438 | Since: | TWiki::Plugins::VERSION 1.000 (27 Feb 2001) |
439
440 =cut
441 # -------------------------
442 rizwank 1.1 sub getMainWebname
443 {
444 return $TWiki::mainWebname;
445 }
446
447 # =========================
448 =pod
449
450 ---+++ getTwikiWebname( ) ==> $name
451
452 | Description: | Get name of TWiki documentation web as defined in TWiki.cfg |
453 | Return: =$name= | Name, e.g. ="TWiki"= |
454 | Since: | TWiki::Plugins::VERSION 1.000 (27 Feb 2001) |
455
456 =cut
457 # -------------------------
458 sub getTwikiWebname
459 {
460 return $TWiki::twikiWebname;
461 }
462
463 rizwank 1.1 # =========================
464 =pod
465
466 ---++ Functions: User Handling and Access Control
467
468 ---+++ getDefaultUserName( ) ==> $loginName
469
470 | Description: | Get default user name as defined in TWiki.cfg's =$defaultUserName= |
471 | Return: =$loginName= | Default user name, e.g. ="guest"= |
472 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
473
474 =cut
475 # -------------------------
476 sub getDefaultUserName
477 {
478 return $TWiki::defaultUserName;
479 }
480
481 # =========================
482 =pod
483
484 rizwank 1.1 ---+++ getWikiName( ) ==> $wikiName
485
486 | Description: | Get Wiki name of logged in user |
487 | Return: =$wikiName= | Wiki Name, e.g. ="JohnDoe"= |
488 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
489
490 =cut
491 # -------------------------
492 sub getWikiName
493 {
494 return $TWiki::wikiName;
495 }
496
497 # =========================
498 =pod
499
500 ---+++ getWikiUserName( $text ) ==> $wikiName
501
502 | Description: | Get Wiki name of logged in user with web prefix |
503 | Return: =$wikiName= | Wiki Name, e.g. ="Main.JohnDoe"= |
504 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
505 rizwank 1.1
506 =cut
507 # -------------------------
508 sub getWikiUserName
509 {
510 return $TWiki::wikiUserName;
511 }
512
513 # =========================
514 =pod
515
516 ---+++ wikiToUserName( $wikiName ) ==> $loginName
517
518 | Description: | Translate a Wiki name to a login name based on [[%MAINWEB%.TWikiUsers]] topic |
519 | Parameter: =$wikiName= | Wiki name, e.g. ="Main.JohnDoe"= or ="JohnDoe"= |
520 | Return: =$loginName= | Login name of user, e.g. ="jdoe"= |
521 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
522
523 =cut
524 # -------------------------
525 sub wikiToUserName
526 rizwank 1.1 {
527 # my( $wiki ) = @_;
528 return &TWiki::wikiToUserName( @_ );
529 }
530
531 # =========================
532 =pod
533
534 ---+++ userToWikiName( $loginName, $dontAddWeb ) ==> $wikiName
535
536 | Description: | Translate a login name to a Wiki name based on [[%MAINWEB%.TWikiUsers]] topic |
537 | Parameter: =$loginName= | Login name, e.g. ="jdoe"= |
538 | Parameter: =$dontAddWeb= | Do not add web prefix if ="1"= |
539 | Return: =$wikiName= | Wiki name of user, e.g. ="Main.JohnDoe"= or ="JohnDoe"= |
540 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
541
542 =cut
543 # -------------------------
544 sub userToWikiName
545 {
546 # my( $loginName, $dontAddWeb ) = @_;
547 rizwank 1.1 return &TWiki::userToWikiName( @_ );
548 }
549
550 # =========================
551 =pod
552
553 ---+++ isGuest( ) ==> $flag
554
555 | Description: | Test if logged in user is a guest |
556 | Return: =$flag= | ="1"= if yes, ="0"= if not |
557 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
558
559 =cut
560 # -------------------------
561 sub isGuest
562 {
563 return &TWiki::isGuest();
564 }
565
566 # =========================
567 =pod
568 rizwank 1.1
569 ---+++ permissionsSet( $web ) ==> $flag
570
571 | Description: | Test if any access restrictions are set for this web, ignoring settings on individual pages |
572 | Parameter: =$web= | Web name, required, e.g. ="Sandbox"= |
573 | Return: =$flag= | ="1"= if yes, ="0"= if no |
574 | Since: | TWiki::Plugins::VERSION 1.000 (27 Feb 2001) |
575
576 =cut
577 # -------------------------
578 sub permissionsSet
579 {
580 # my( $web ) = @_;
581 return &TWiki::Access::permissionsSet( @_ );
582 }
583
584 # =========================
585 =pod
586
587 ---+++ checkAccessPermission( $type, $wikiName, $text, $topic, $web ) ==> $flag
588
589 rizwank 1.1 | Description: | Check access permission for a topic based on the [[%TWIKIWEB%.TWikiAccessControl]] rules |
590 | Parameter: =$type= | Access type, e.g. ="VIEW"=, ="CHANGE"=, ="CREATE"= |
591 | Parameter: =$wikiName= | WikiName of remote user, i.e. ="Main.PeterThoeny"= |
592 | Parameter: =$text= | Topic text, optional. If empty, topic =$web.$topic= is consulted |
593 | Parameter: =$topic= | Topic name, required, e.g. ="PrivateStuff"= |
594 | Parameter: =$web= | Web name, required, e.g. ="Sandbox"= |
595 | Return: =$flag= | ="1"= if access may be granted, ="0"= if not |
596 | Since: | TWiki::Plugins::VERSION 1.000 (27 Feb 2001) |
597
598 =cut
599 # -------------------------
600 sub checkAccessPermission
601 {
602 # my( $type, $user, $text, $topic, $web ) = @_;
603 return &TWiki::Access::checkAccessPermission( @_ );
604 }
605
606 # =========================
607 =pod
608
609 ---++ Functions: Content Handling
610 rizwank 1.1
611 ---+++ webExists( $web ) ==> $flag
612
613 | Description: | Test if web exists |
614 | Parameter: =$web= | Web name, required, e.g. ="Sandbox"= |
615 | Return: =$flag= | ="1"= if web exists, ="0"= if not |
616 | Since: | TWiki::Plugins::VERSION 1.000 (14 Jul 2001) |
617
618 =cut
619 # -------------------------
620 sub webExists
621 {
622 # my( $theWeb ) = @_;
623 return &TWiki::Store::webExists( @_ );
624 }
625
626 # =========================
627 =pod
628
629 ---+++ topicExists( $web, $topic ) ==> $flag
630
631 rizwank 1.1 | Description: | Test if topic exists |
632 | Parameter: =$web= | Web name, optional, e.g. ="Main"= |
633 | Parameter: =$topic= | Topic name, required, e.g. ="TokyoOffice"=, or ="Main.TokyoOffice"= |
634 | Return: =$flag= | ="1"= if topic exists, ="0"= if not |
635 | Since: | TWiki::Plugins::VERSION 1.000 (14 Jul 2001) |
636
637 =cut
638 # -------------------------
639 sub topicExists
640 {
641 # my( $web, $topic ) = @_;
642 return &TWiki::Store::topicExists( @_ );
643 }
644
645 # =========================
646 =pod
647
648 ---+++ getRevisionInfo($theWebName, $theTopic, $theRev, $attachment ) ==> ( $date, $user, $rev, $comment )
649 | Description: | Get revision info of a topic |
650 | Parameter: =$theWebName= | Web name, optional, e.g. ="Main"= |
651 | Parameter: =$theTopic= | Topic name, required, e.g. ="TokyoOffice"= |
652 rizwank 1.1 | Parameter: =$theRev= | revsion number, or tag name (can be in the format 1.2, or just the minor number) |
653 | Parameter: =$attachment= |attachment filename |
654 | Return: =( $date, $user, $rev, $comment )= | List with: ( last update date, login name of last user, minor part of top revision number ), e.g. =( 1234561, "phoeny", "5" )= |
655 | $date | in epochSec |
656 | $user | |
657 | $rev | |
658 | $comment | WHAT COMMENT? |
659 | Since: | TWiki::Plugins::VERSION 1.000 (29 Jul 2001) |
660
661 =cut
662 # -------------------------
663 sub getRevisionInfo
664 {
665 return TWiki::Store::getRevisionInfo( @_ );
666 }
667
668 # =========================
669 =pod
670
671 ---+++ checkTopicEditLock( $web, $topic ) ==> ( $oopsUrl, $loginName, $unlockTime )
672
673 rizwank 1.1 | Description: | Check if topic has an edit lock by a user |
674 | Parameter: =$web= | Web name, e.g. ="Main"=, or empty |
675 | Parameter: =$topic= | Topic name, e.g. ="MyTopic"=, or ="Main.MyTopic"= |
676 | Return: =( $oopsUrl, $loginName, $unlockTime )= | The =$oopsUrl= for calling redirectCgiQuery(), user's =$loginName=, and estimated =$unlockTime= in minutes. The =$oopsUrl= and =$loginName= is empty if topic has no edit lock. |
677 | Since: | TWiki::Plugins::VERSION 1.010 (31 Dec 2002) |
678
679 =cut
680 # -------------------------
681 sub checkTopicEditLock
682 {
683 my( $web, $topic ) = @_;
684 my( $loginName, $lockTime ) = TWiki::Store::topicIsLockedBy( $web, $topic );
685 my $oopsUrl = "";
686 if( $loginName ) {
687 use integer;
688 $lockTime = ( $lockTime / 60 ) + 1; # convert to minutes
689 my $editLockTime = $TWiki::editLockTime / 60; # max lock time
690 my $wikiUser = TWiki::Func::userToWikiName( $loginName );
691 $oopsUrl = &TWiki::Func::getOopsUrl( $web, $topic, "oopslocked", $wikiUser, $editLockTime, $lockTime );
692 }
693 return( $oopsUrl, $loginName, $lockTime );
694 rizwank 1.1 }
695
696 # =========================
697 =pod
698
699 ---+++ setTopicEditLock( $web, $topic, $lock ) ==> $oopsUrl
700
701 | Description: | Lock topic for editing, or unlock when done |
702 | Parameter: =$web= | Web name, e.g. ="Main"=, or empty |
703 | Parameter: =$topic= | Topic name, e.g. ="MyTopic"=, or ="Main.MyTopic"= |
704 | Parameter: =$lock= | Set to =1= to lock topic, =0= to unlock |
705 | Return: =$oopsUrl= | Empty string if OK; the =$oopsUrl= for calling redirectCgiQuery() in case lock is already taken when trying to lock topic |
706 | Since: | TWiki::Plugins::VERSION 1.010 (31 Dec 2002) |
707
708 =cut
709 # -------------------------
710 sub setTopicEditLock
711 {
712 my( $web, $topic, $lock ) = @_;
713 if( $lock ) {
714 my( $oopsUrl ) = checkTopicEditLock( $web, $topic );
715 rizwank 1.1 return $oopsUrl if( $oopsUrl );
716 }
717 TWiki::Store::lockTopicNew( $web, $topic, ! $lock ); # reverse $lock parameter is correct!
718 return "";
719 }
720
721 # =========================
722 =pod
723
724 ---+++ readTopicText( $web, $topic, $rev, $ignorePermissions ) ==> $text
725
726 | Description: | Read topic text, including meta data |
727 | Parameter: =$web= | Web name, e.g. ="Main"=, or empty |
728 | Parameter: =$topic= | Topic name, e.g. ="MyTopic"=, or ="Main.MyTopic"= |
729 | Parameter: =$rev= | Topic revision to read, optional. Specify the minor part of the revision, e.g. ="5"=, not ="1.5"=; the top revision is returned if omitted or empty. |
730 | Parameter: =$ignorePermissions= | Set to ="1"= if checkAccessPermission() is already performed and OK; an oops URL is returned if user has no permission |
731 | Return: =$text= | Topic text with embedded meta data; an oops URL for calling redirectCgiQuery() is returned in case of an error |
732 | Since: | TWiki::Plugins::VERSION 1.010 (31 Dec 2002) |
733
734 =cut
735 # -------------------------
736 rizwank 1.1 sub readTopicText
737 {
738 my( $web, $topic, $rev, $ignorePermissions ) = @_;
739
740 my $text = TWiki::Store::readTopicRaw( $web, $topic, $rev, $ignorePermissions );
741 # FIXME: The following breaks if spec of readTopicRaw() changes
742 if( $text =~ /^No permission to read topic/ ) {
743 $text = TWiki::getOopsUrl( $web, $topic, "oopsaccessview" );
744 }
745 return $text;
746 }
747
748 # =========================
749 =pod
750
751 ---+++ saveTopicText( $web, $topic, $text, $ignorePermissions, $dontNotify ) ==> $oopsUrl
752
753 | Description: | Save topic text, typically obtained by readTopicText(). Topic data usually includes meta data; the file attachment meta data is replaced by the meta data from the topic file if it exists. |
754 | Parameter: =$web= | Web name, e.g. ="Main"=, or empty |
755 | Parameter: =$topic= | Topic name, e.g. ="MyTopic"=, or ="Main.MyTopic"= |
756 | Parameter: =$text= | Topic text to save, assumed to include meta data |
757 rizwank 1.1 | Parameter: =$ignorePermissions= | Set to ="1"= if checkAccessPermission() is already performed and OK |
758 | Parameter: =$dontNotify= | Set to ="1"= if not to notify users of the change |
759 | Return: =$oopsUrl= | Empty string if OK; the =$oopsUrl= for calling redirectCgiQuery() in case of error |
760 | Since: | TWiki::Plugins::VERSION 1.010 (31 Dec 2002) |
761
762 * Example: <br />
763 =my $oopsUrl = TWiki::Func::setTopicEditLock( $web, $topic, 1 );= <br />
764 =if( $oopsUrl ) {= <br />
765 = TWiki::Func::redirectCgiQuery( $query, $oopsUrl ); # assuming valid query= <br />
766 = return;= <br />
767 =}= <br />
768 =my $text = TWiki::Func::readTopicText( $web, $topic ); # read topic text= <br />
769 =# check for oops URL in case of error:= <br />
770 =if( $text =~ /^http.*?\/oops/ ) {= <br />
771 = TWiki::Func::redirectCgiQuery( $query, $text );= <br />
772 = return;= <br />
773 =}= <br />
774 =# do topic text manipulation like:= <br />
775 =$text =~ s/old/new/g;= <br />
776 =# do meta data manipulation like:= <br />
777 =$text =~ s/(META\:FIELD.*?name\=\"TopicClassification\".*?value\=\")[^\"]*/$1BugResolved/;= <br />
778 rizwank 1.1 =$oopsUrl = TWiki::Func::saveTopicText( $web, $topic, $text ); # save topic text= <br />
779 =TWiki::Func::setTopicEditLock( $web, $topic, 0 ); # unlock topic= <br />
780 =if( $oopsUrl ) {= <br />
781 = TWiki::Func::redirectCgiQuery( $query, $oopsUrl );= <br />
782 = return;= <br />
783 =}=
784
785 =cut
786 # -------------------------
787 sub saveTopicText
788 {
789 my( $web, $topic, $text, $ignorePermissions, $dontNotify ) = @_;
790
791 my( $mirrorSite, $mirrorViewURL ) = TWiki::readOnlyMirrorWeb( $web );
792 return TWiki::getOopsUrl( $web, $topic, "oopsmirror", $mirrorSite, $mirrorViewURL ) if( $mirrorSite );
793
794 # check access permission
795 unless( $ignorePermissions ||
796 TWiki::Access::checkAccessPermission( "change", $TWiki::wikiUserName, "", $topic, $web )
797 ) {
798 return TWiki::getOopsUrl( $web, $topic, "oopsaccesschange" );
799 rizwank 1.1 }
800
801 return TWiki::getOopsUrl( $web, $topic, "oopssave" ) unless( defined $text );
802 return TWiki::getOopsUrl( $web, $topic, "oopsempty" ) unless( $text ); # empty topic not allowed
803
804 # extract meta data and merge old attachment meta data
805 my $meta = "";
806 ( $meta, $text ) = TWiki::Store::_extractMetaData( $web, $topic, $text );
807 my( $oldMeta, $oldText ) = TWiki::Store::readTopic( $web, $topic );
808 $meta->copyFrom( $oldMeta, "FILEATTACHMENT" );
809
810 # save topic
811 my $error = TWiki::Store::saveTopic( $web, $topic, $text, $meta, "", 0, $dontNotify );
812 return TWiki::getOopsUrl( $web, $topic, "oopssaveerr", $error ) if( $error );
813 return "";
814 }
815
816 # =========================
817 =pod
818
819 ---+++ getPublicWebList( ) ==> @webs
820 rizwank 1.1
821 | Description: | Get list of all public webs, e.g. all webs that do not have the =NOSEARCHALL= flag set in the WebPreferences |
822 | Return: =@webs= | List of all public webs, e.g. =( "Main", "Know", "TWiki" )= |
823 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
824
825 =cut
826 # -------------------------
827 sub getPublicWebList
828 {
829 return &TWiki::getPublicWebList();
830 }
831
832 # =========================
833 =pod
834
835 ---+++ getTopicList( $web ) ==> @topics
836
837 | Description: | Get list of all topics in a web |
838 | Parameter: =$web= | Web name, required, e.g. ="Sandbox"= |
839 | Return: =@topics= | Topic list, e.g. =( "WebChanges", "WebHome", "WebIndex", "WebNotify" )= |
840 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
841 rizwank 1.1
842 =cut
843 # -------------------------
844 sub getTopicList
845 {
846 # my( $web ) = @_;
847 return &TWiki::Store::getTopicNames ( @_ );
848 }
849
850 # =========================
851 # (undocumented feature of Cairo since RcsLite is not implemented yet)
852 #=pod
853 #
854 #---+++ setTopicRevisionTag( $web, $topic, $rev, $tag ) ==> $success
855 #
856 #| Description: | Sets a names tag on the specified revision |
857 #| Parameter: =$web= | Web name |
858 #| Parameter: =$topic= | Topic name |
859 #| Parameter: =$rev= | The revision to tag |
860 #| Parameter: =$tag= | The string to tag with |
861 #| Return: =$success= | (CODE_SMELL: Other functions return error string, or empty if OK) |
862 rizwank 1.1 #| TODO: | we _need_ an error mechanism! |
863 #| Since: | TWiki::Plugins::VERSION 1.022 (20 April 2004) |
864 #
865 #=cut
866
867 sub setTopicRevisionTag
868 {
869 # my ( $web, $topic, $rev, $tag ) = @_;
870
871 return TWiki::Store::setTopicRevisionTag( @_ );
872 }
873
874 =pod
875
876 ---++ Functions: Rendering
877
878 ---+++ expandCommonVariables( $text, $topic, $web ) ==> $text
879
880 | Description: | Expand all common =%<nop>VARIABLES%= |
881 | Parameter: =$text= | Text with variables to expand, e.g. ="Current user is %<nop>WIKIUSER%"= |
882 | Parameter: =$topic= | Current topic name, e.g. ="WebNotify"= |
883 rizwank 1.1 | Parameter: =$web= | Web name, optional, e.g. ="Main"=. The current web is taken if missing |
884 | Return: =$text= | Expanded text, e.g. ="Current user is <nop>TWikiGuest"= |
885 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
886
887 =cut
888 # -------------------------
889 sub expandCommonVariables
890 {
891 # my( $text, $topic, $web ) = @_;
892 return &TWiki::handleCommonTags( @_ );
893 }
894
895 # =========================
896 =pod
897
898 ---+++ renderText( $text, $web ) ==> $text
899
900 | Description: | Render text from TWiki markup into XHTML as defined in [[%TWIKIWEB%.TextFormattingRules]] |
901 | Parameter: =$text= | Text to render, e.g. ="*bold* text and =fixed font="= |
902 | Parameter: =$web= | Web name, optional, e.g. ="Main"=. The current web is taken if missing |
903 | Return: =$text= | XHTML text, e.g. ="<b>bold</b> and <code>fixed font</code>"= |
904 rizwank 1.1 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
905
906 =cut
907 # -------------------------
908 sub renderText
909 {
910 # my( $text, $web ) = @_;
911 return &TWiki::Render::getRenderedVersion( @_ );
912 }
913
914 # =========================
915 =pod
916
917 ---+++ internalLink( $pre, $web, $topic, $label, $anchor, $createLink ) ==> $text
918
919 | Description: | Render topic name and link label into an XHTML link. Normally you do not need to call this funtion, it is called internally by =renderText()= |
920 | Parameter: =$pre= | Text occuring before the TWiki link syntax, optional |
921 | Parameter: =$web= | Web name, required, e.g. ="Main"= |
922 | Parameter: =$topic= | Topic name to link to, required, e.g. ="WebNotify"= |
923 | Parameter: =$label= | Link label, required. Usually the same as =$topic=, e.g. ="notify"= |
924 | Parameter: =$anchor= | Anchor, optional, e.g. ="#Jump"= |
925 rizwank 1.1 | Parameter: =$createLink= | Set to ="1"= to add question linked mark after topic name if topic does not exist;<br /> set to ="0"= to suppress link for non-existing topics |
926 | Return: =$text= | XHTML anchor, e.g. ="<a href="/cgi-bin/view/Main/WebNotify#Jump">notify</a>"= |
927 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
928
929 =cut
930 # -------------------------
931 sub internalLink
932 {
933 # my( $pre, $web, $topic, $label, $anchor, $anchor, $createLink ) = @_;
934 return TWiki::Render::internalLink( @_ );
935 }
936
937 # =========================
938 =pod
939
940 ---+++ search text( $text ) ==> $text
941
942 | Description: | This is not a function, just a how-to note. Use: =expandCommonVariables("%<nop>SEARCH{...}%" );= |
943 | Parameter: =$text= | Search variable |
944 | Return: =$text= | Search result in [[%TWIKIWEB%.FormattedSearch]] format |
945
946 rizwank 1.1 =cut
947
948 # =========================
949 =pod
950
951 ---+++ formatTime( $time, $format, $timezone ) ==> $text
952
953 | Description: | Format the time in seconds into the desired time string |
954 | Parameter: =$time= | Time in epoc seconds |
955 | Parameter: =$format= | Format type, optional. Default e.g. ="31 Dec 2002 - 19:30"=. Can be ='$iso'= (e.g. ="2002-12-31T19:30Z"=), ='$rcs'= (e.g. ="2001/12/31 23:59:59"=, ='$http'= for HTTP header format (e.g. ="Thu, 23 Jul 1998 07:21:56 GMT"=), or any string with tokens ='$seconds, $minutes, $hours, $day, $wday, $month, $mo, $year, $ye, $tz'= for seconds, minutes, hours, day of month, day of week, 3 letter month, 2 digit month, 4 digit year, 2 digit year, timezone string, respectively |
956 | Parameter: =$timezone= | either not defined (uses the displaytime setting), "gmtime", or "servertime" |
957 | Return: =$text= | Formatted time string |
958 | Note: | if you used the removed formatGmTime, add a third parameter "gmtime" |
959 | Since: | TWiki::Plugins::VERSION 1.020 (26 Feb 2004) |
960
961 =cut
962 # -------------------------
963 sub formatTime
964 {
965 # my ( $epSecs, $format, $timezone ) = @_;
966 return &TWiki::formatTime( @_ );
967 rizwank 1.1 }
968
969 # =========================
970 =pod
971
972 ---+++ formatGmTime( $time, $format ) ==> $text
973
974 | NOTE: | <b>This function is deprecated and should not be used. Use formatTime() instead</b> |
975 | Description: | Format the time to GM time |
976 | Parameter: =$time= | Time in epoc seconds |
977 | Parameter: =$format= | Format type, optional. Default e.g. ="31 Dec 2002 - 19:30"=, can be ="iso"= (e.g. ="2002-12-31T19:30Z"=), ="rcs"= (e.g. ="2001/12/31 23:59:59"=, ="http"= for HTTP header format (e.g. ="Thu, 23 Jul 1998 07:21:56 GMT"=) |
978 | Return: =$text= | Formatted time string |
979 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
980
981 =cut
982 # -------------------------
983 sub formatGmTime
984 {
985 # my ( $epSecs, $format ) = @_;
986
987 # FIXME: Write warning based on flag (disabled for now); indicate who is calling this function
988 rizwank 1.1 ## writeWarning( "deprecated use of Func::formatGmTime" );
989
990 return &formatTime( @_, "gmtime" );
991 }
992
993
994 # =========================
995 =pod
996
997 ---++ Functions: File I/O
998
999 ---+++ getDataDir( ) ==> $dir
1000
1001 | Description: | Get data directory (topic file root) |
1002 | Return: =$dir= | Data directory, e.g. ="/twiki/data"= |
1003 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
1004
1005 =cut
1006 # -------------------------
1007 sub getDataDir
1008 {
1009 rizwank 1.1 return &TWiki::getDataDir();
1010 }
1011
1012 # =========================
1013 =pod
1014
1015 ---+++ getPubDir( ) ==> $dir
1016
1017 | Description: | Get pub directory (file attachment root). Attachments are in =$dir/Web/TopicName= |
1018 | Return: =$dir= | Pub directory, e.g. ="/htdocs/twiki/pub"= |
1019 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
1020
1021 =cut
1022 # -------------------------
1023 sub getPubDir
1024 {
1025 return &TWiki::getPubDir();
1026 }
1027
1028 # =========================
1029 =pod
1030 rizwank 1.1
1031 ---+++ readTopic( $web, $topic ) ==> ( $meta, $text )
1032
1033 | NOTE: | <b>The following function is deprecated and should not be used. Use readTopicText() instead</b> |
1034 | Description: | Read topic text and meta data, regardless of access permissions. |
1035 | Parameter: =$web= | Web name, required, e.g. ="Main"= |
1036 | Parameter: =$topic= | Topic name, required, e.g. ="TokyoOffice"= |
1037 | Return: =( $meta, $text )= | Meta data object and topic text |
1038 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
1039
1040 =cut
1041 # -------------------------
1042 sub readTopic
1043 {
1044 # my( $web, $topic ) = @_;
1045
1046 # FIXME: Write warning based on flag (disabled for now); indicate who is calling this function
1047 ## writeWarning( "deprecated use of Func::readTopic" );
1048
1049 return &TWiki::Store::readTopic( @_ );
1050 }
1051 rizwank 1.1
1052 # =========================
1053 =pod
1054
1055 ---+++ readTemplate( $name, $skin ) ==> $text
1056
1057 | Description: | Read a template or skin file. Embedded [[%TWIKIWEB%.TWikiTemplates][template directives]] get expanded |
1058 | Parameter: =$name= | Template name, e.g. ="view"= |
1059 | Parameter: =$skin= | Skin name, optional, e.g. ="print"= |
1060 | Return: =$text= | Template text |
1061 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
1062
1063 =cut
1064 # -------------------------
1065 sub readTemplate
1066 {
1067 # my( $name, $skin ) = @_;
1068 return &TWiki::Store::readTemplate( @_ );
1069 }
1070
1071 # =========================
1072 rizwank 1.1 =pod
1073
1074 ---+++ readFile( $filename ) ==> $text
1075
1076 | Description: | Read text file, low level. NOTE: For topics use readTopicText() |
1077 | Parameter: =$filename= | Full path name of file |
1078 | Return: =$text= | Content of file |
1079 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
1080
1081 =cut
1082 # -------------------------
1083 sub readFile
1084 {
1085 # my( $filename ) = @_;
1086 return &TWiki::Store::readFile( @_ );
1087 }
1088
1089 # =========================
1090 =pod
1091
1092 ---+++ saveFile( $filename, $text )
1093 rizwank 1.1
1094 | Description: | Save text file, low level. NOTE: For topics use saveTopicText() |
1095 | Parameter: =$filename= | Full path name of file |
1096 | Parameter: =$text= | Text to save |
1097 | Return: | none |
1098 | Since: | TWiki::Plugins::VERSION 1.000 (7 Dec 2002) |
1099 | TODO: | This should return an error for the different failure modes. |
1100
1101 =cut
1102 # -------------------------
1103 sub saveFile
1104 {
1105 # my( $filename, $text ) = @_;
1106 return &TWiki::Store::saveFile( @_ );
1107 }
1108
1109 # =========================
1110 =pod
1111
1112 ---+++ writeWarning( $text )
1113
1114 rizwank 1.1 | Description: | Log Warning that may require admin intervention to data/warning.txt |
1115 | Parameter: =$text= | Text to write; timestamp gets added |
1116 | Return: | none |
1117 | Since: | TWiki::Plugins::VERSION 1.020 (16 Feb 2004) |
1118
1119 =cut
1120 # -------------------------
1121 sub writeWarning
1122 {
1123 # my( $theText ) = @_;
1124 return &TWiki::writeWarning( @_ );
1125 }
1126
1127 # =========================
1128 =pod
1129
1130 ---+++ writeDebug( $text )
1131
1132 | Description: | Log debug message to data/debug.txt |
1133 | Parameter: =$text= | Text to write; timestamp gets added |
1134 | Return: | none |
1135 rizwank 1.1 | Since: | TWiki::Plugins::VERSION 1.020 (16 Feb 2004) |
1136
1137 =cut
1138 # -------------------------
1139 sub writeDebug
1140 {
1141 # my( $theText ) = @_;
1142 return &TWiki::writeDebug( @_ );
1143 }
1144
1145 # =========================
1146 =pod
1147
1148 ---++ Functions: System and I18N related
1149
1150 ---+++ getRegularExpression( $regexName ) ==> $pattern
1151
1152 | Description: | Retrieves a TWiki predefined regular expression |
1153 | Parameter: =$regexName= | Name of the regular expression to retrieve. See notes below |
1154 | Return: | String or precompiled regular expression matching as described below |
1155 | Since: | TWiki::Plugins::VERSION 1.020 (9 Feb 2004) |
1156 rizwank 1.1
1157 __Notes:__ TWiki internally precompiles several regular expressions to represent various string entities
1158 in an I18N-compatible manner. Plugins are encouraged to use these in matching where appropriate.
1159 The following are guaranteed to be present; others may exist, but their use is unsupported and
1160 they may be removed in future TWiki versions. Those which are marked "CC" are for use within
1161 character classes and may not produce the desired results outside of them.
1162
1163 | *Name* | *Matches* | *CC* |
1164 | upperAlpha | Upper case characters | Y |
1165 | lowerAlpha | Lower case characters | Y |
1166 | mixedAlpha | Alphabetic characters | Y |
1167 | mixedAlphaNum | Alphanumeric charactecs | Y |
1168 | wikiWordRegex | WikiWords | N |
1169
1170 Example:
1171 <pre>
1172 my $upper = TWiki::Func::getRegularExpression("upperAlpha");
1173 my $alpha = TWiki::Func::getRegularExpression("mixedAlpha");
1174 my $capitalized = qr/[$upper][$alpha]+/;
1175 </pre>
1176
1177 rizwank 1.1 =cut
1178
1179 sub getRegularExpression
1180 {
1181 my ( $regexName ) = @_;
1182 return $TWiki::regex{$regexName};
1183 }
1184
1185 =pod
1186
1187 ---+++ checkDependencies( $moduleName, $dependenciesRef ) ==> $error
1188
1189 | Description: | Checks a list of Perl dependencies at runtime |
1190 | Parameter: =$moduleName= | Context description e.g. name of the module being checked |
1191 | Parameter: =$dependenciesRef= | Reference of list of hashes containing dependency information; see notes below |
1192 | Return: =$error= | undef if dependencies are OK, an error message otherwise |
1193 | Since: | TWiki::Plugins::VERSION 1.025 (01 Aug 2004) |
1194
1195 The dependencies are expressed as a list of hashes. Each hash contains
1196 the name of a package and (optionally) a boolean constraint on the VERSION
1197 variable in that package. It is usually used from the =initPlugin= method
1198 rizwank 1.1 like this:
1199 <verbatim>
1200 if( $TWiki::Plugins::VERSION >= 1.025 ) {
1201 my @deps = (
1202 { package => 'TWiki::Plugins::CalendarPlugin', constraint => '>= 5.030' },
1203 { package => 'Time::ParseDate' },
1204 { package => 'Apache::VMonitor' }
1205 );
1206 my $err = TWiki::Func::checkDependencies( $pluginName, \@deps );
1207 if( $err ) {
1208 TWiki::Func::writeWarning( $err );
1209 print STDERR $err; # print to webserver log file
1210 return 0; # plugin initialisation failed
1211 }
1212 }
1213 </verbatim>
1214
1215 =cut
1216
1217 sub checkDependencies {
1218 my ( $context, $deps ) = @_;
1219 rizwank 1.1 my $report = "";
1220 my $depsOK = 1;
1221 foreach my $dep ( @$deps ) {
1222 my ( $ok, $ver ) = ( 1, 0 );
1223 my $msg = "";
1224 my $const = "";
1225
1226 eval "use $dep->{package}";
1227 if ( $@ ) {
1228 $msg .= "it could not be found: $@";
1229 $ok = 0;
1230 } else {
1231 if ( defined( $dep->{constraint} ) ) {
1232 $const = $dep->{constraint};
1233 eval "\$ver = \$$dep->{package}::VERSION;";
1234 if ( $@ ) {
1235 $msg .= "the VERSION of the package could not be found: $@";
1236 $ok = 0;
1237 } else {
1238 eval "\$ok = ( \$ver $const )";
1239 if ( $@ || ! $ok ) {
1240 rizwank 1.1 $msg .= " $ver is currently installed: $@";
1241 $ok = 0;
1242 }
1243 }
1244 }
1245 }
1246 unless ( $ok ) {
1247 $report .= "WARNING: $dep->{package}$const is required for $context, but $msg\n";
1248 $depsOK = 0;
1249 }
1250 }
1251 return undef if( $depsOK );
1252
1253 return $report;
1254 }
1255
1256 # =========================
1257 =pod
1258
1259 ---++ Copyright and License
1260
1261 rizwank 1.1 Copyright (C) 2000-2004 Peter Thoeny, Peter@Thoeny.com
1262
1263 This program is free software; you can redistribute it and/or
1264 modify it under the terms of the GNU General Public License
1265 as published by the Free Software Foundation; either version 2
1266 of the License, or (at your option) any later version.
1267
1268 This program is distributed in the hope that it will be useful,
1269 but WITHOUT ANY WARRANTY; without even the implied warranty of
1270 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1271 GNU General Public License for more details, published at
1272 http://www.gnu.org/copyleft/gpl.html
1273
1274 =cut
1275
1276 1;
1277
1278 # EOF
|
Return to
Func.pm
CVS log
Up to [RizwankCVS] / geekymedia_web / twiki / lib / TWiki