Added POD to these packages.
This commit is contained in:
JT Smith
parent
21daeceb6e
commit
b240822489
12 changed files with 1075 additions and 99 deletions
|
|
@ -25,6 +25,16 @@ use WebGUI::SQL;
|
|||
use WebGUI::URL;
|
||||
use WebGUI::User;
|
||||
|
||||
|
||||
=head1 WebGUI Discussions
|
||||
|
||||
This package implements WebGUI's discussion system. However it is
|
||||
outdated and cludgy. We recommend not coding any new systems against
|
||||
this package, but instead wait for the new package that will be
|
||||
created in 6.0.0.
|
||||
|
||||
=cut
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub _deleteReplyTree {
|
||||
my ($sth, %data, $messageId);
|
||||
|
|
|
|||
|
|
@ -1,19 +1,59 @@
|
|||
package WebGUI::ErrorHandler;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
#-------------------------------------------------------------------
|
||||
# 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
|
||||
#-------------------------------------------------------------------
|
||||
=head1 LEGAL
|
||||
|
||||
-------------------------------------------------------------------
|
||||
WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
-------------------------------------------------------------------
|
||||
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
|
||||
-------------------------------------------------------------------
|
||||
|
||||
=cut
|
||||
|
||||
use FileHandle;
|
||||
use WebGUI::Session;
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Package WebGUI::ErrorHandler
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WebGUI::ErrorHandler;
|
||||
WebGUI::ErrorHandler::audit(message);
|
||||
WebGUI::ErrorHandler::fatalError();
|
||||
WebGUI::ErrorHandler::security(message);
|
||||
WebGUI::ErrorHandler::warn(message);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This package provides simple but effective error handling and logging for WebGUI.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
These functions are available from this package:
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 audit ( message )
|
||||
|
||||
Inserts an AUDIT type message into the WebGUI log.
|
||||
|
||||
=item message
|
||||
|
||||
Whatever message you wish to insert into the log.
|
||||
|
||||
=cut
|
||||
|
||||
sub audit {
|
||||
my ($log, $data);
|
||||
$log = FileHandle->new(">>".$session{config}{logfile}) or fatalError("Can't open log file for audit.");
|
||||
|
|
@ -24,6 +64,16 @@ sub audit {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 fatalError ( )
|
||||
|
||||
Outputs an error message to the user and logs an error. Should only
|
||||
be called if the system cannot recover from an error, or if it would
|
||||
be unsafe to attempt to recover from an error (like compile errors
|
||||
or database errors).
|
||||
|
||||
=cut
|
||||
|
||||
sub fatalError {
|
||||
my ($key, $log, $cgi, $logfile, $config);
|
||||
if (exists $session{cgi}) {
|
||||
|
|
@ -101,10 +151,22 @@ sub fatalError {
|
|||
}
|
||||
print '</table>';
|
||||
}
|
||||
WebGUI::Session::close();
|
||||
exit;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 security ( message )
|
||||
|
||||
Adds a SECURITY type message to the log.
|
||||
|
||||
=item message
|
||||
|
||||
The message you wish to add to the log.
|
||||
|
||||
=cut
|
||||
|
||||
sub security {
|
||||
my ($log, $data);
|
||||
$log = FileHandle->new(">>".$session{config}{logfile}) or fatalError("Can't open log file for audit.");
|
||||
|
|
@ -116,6 +178,17 @@ sub security {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 warn ( message )
|
||||
|
||||
Adds a WARNING type message to the log.
|
||||
|
||||
=item message
|
||||
|
||||
The message you wish to add to the log.
|
||||
|
||||
=cut
|
||||
|
||||
sub warn {
|
||||
my ($log);
|
||||
$log = FileHandle->new(">>".$session{config}{logfile}) or fatalError("Can't open log file for warning.");
|
||||
|
|
|
|||
|
|
@ -1,20 +1,63 @@
|
|||
package WebGUI::Macro;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
#-------------------------------------------------------------------
|
||||
# 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
|
||||
#-------------------------------------------------------------------
|
||||
=head1 LEGAL
|
||||
|
||||
-------------------------------------------------------------------
|
||||
WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
-------------------------------------------------------------------
|
||||
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
|
||||
-------------------------------------------------------------------
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
use strict qw(vars subs);
|
||||
use WebGUI::ErrorHandler;
|
||||
use WebGUI::Session;
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Package WebGUI::Macro
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WebGUI::Macro;
|
||||
@array = WebGUI::Macro::getParams($parameterString);
|
||||
$html = WebGUI::Macro::process($html);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This package is the interface to the WebGUI macro system.
|
||||
|
||||
NOTE: This entire system is likely to be replaced in the near future.
|
||||
It has served WebGUI well since the very beginning but lacks the
|
||||
speed and flexibility that WebGUI users will require in the future.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
These functions are available from this package:
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getParams ( parameterString )
|
||||
|
||||
A simple, but error prone mechanism for getting a prameter list from a string. Returns an array of parameters.
|
||||
|
||||
=item parameterString
|
||||
|
||||
A string containing a comma separated list of paramenters.
|
||||
|
||||
=cut
|
||||
|
||||
sub getParams {
|
||||
my ($data, @param);
|
||||
$data = $_[0];
|
||||
|
|
@ -28,6 +71,17 @@ sub getParams {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 process ( html )
|
||||
|
||||
Runs all the WebGUI macros to and replaces them in the HTML with their output.
|
||||
|
||||
=item html
|
||||
|
||||
A string of HTML to be processed.
|
||||
|
||||
=cut
|
||||
|
||||
sub process {
|
||||
my ($macro, $cmd, $output);
|
||||
$output = $_[0];
|
||||
|
|
|
|||
|
|
@ -1,14 +1,19 @@
|
|||
package WebGUI::MessageLog;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
#-------------------------------------------------------------------
|
||||
# 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
|
||||
#-------------------------------------------------------------------
|
||||
=head1 LEGAL
|
||||
|
||||
-------------------------------------------------------------------
|
||||
WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
-------------------------------------------------------------------
|
||||
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
|
||||
-------------------------------------------------------------------
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
use strict;
|
||||
use Tie::CPHash;
|
||||
|
|
@ -21,6 +26,29 @@ use WebGUI::URL;
|
|||
use WebGUI::User;
|
||||
use WebGUI::Utility;
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Package WebGUI::MessageLog
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WebGUI::MessageLog;
|
||||
WebGUI::MessageLog::addEntry($userId, $groupId,$subject,$message);
|
||||
WebGUI::MessageLog::addInternationalizedEntry($userId,$groupId,$url,$internationalId);
|
||||
WebGUI::MessageLog::completeEntry($messageLogId);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This package is WebGUI's notification system.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
These functions are available from this package:
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub _notify {
|
||||
my ($u, $message, $subject);
|
||||
|
|
@ -43,6 +71,42 @@ sub _notify {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 addEntry ( userId, groupId, subject, message [ , url, status ] )
|
||||
|
||||
Adds an entry to the message log and sends out notification to users.
|
||||
|
||||
=item userId
|
||||
|
||||
The id of the user that should receive this notification.
|
||||
|
||||
NOTE: This can be left blank if you're specifying a groupId.
|
||||
|
||||
=item groupId
|
||||
|
||||
The id of the group that should receive this notification.
|
||||
|
||||
NOTE: This can be left blank if you're specifying a userId.
|
||||
|
||||
=item subject
|
||||
|
||||
The subject of the notification.
|
||||
|
||||
=item message
|
||||
|
||||
The content of the notification.
|
||||
|
||||
=item url
|
||||
|
||||
The URL of any action that should be taken based upon this
|
||||
notification (if any).
|
||||
|
||||
=item status
|
||||
|
||||
Defaults to 'notice'. Can be 'pending', 'notice', or 'completed'.
|
||||
|
||||
=cut
|
||||
|
||||
sub addEntry {
|
||||
my ($u, @users, $messageLogId, $sth, $userId, $groupId, $subject, $message, $url, $status, $user);
|
||||
$messageLogId = getNextId("messageLogId");
|
||||
|
|
@ -70,6 +134,43 @@ sub addEntry {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 addInternationalizedEntry ( userId, groupId, url, internationalId [ , namespace, status ] )
|
||||
|
||||
Adds an entry to the message log using a translated message from
|
||||
the internationalization system and sends out notifications to users.
|
||||
|
||||
=item userId
|
||||
|
||||
The id of the user that should receive this notification.
|
||||
|
||||
NOTE: This can be left blank if you're specifying a groupId.
|
||||
|
||||
=item groupId
|
||||
|
||||
The id of the group that should receive this notification.
|
||||
|
||||
NOTE: This can be left blank if you're specifying a userId.
|
||||
|
||||
=item url
|
||||
|
||||
The URL of any action that should be taken based upon this
|
||||
notification (if any).
|
||||
|
||||
=item internationalId
|
||||
|
||||
The unique identifier from the internationalization system of the message to send.
|
||||
|
||||
=item namespace
|
||||
|
||||
The namespace from the internationalization system of the message to send. Defaults to "WebGUI";
|
||||
|
||||
=item status
|
||||
|
||||
Defaults to 'notice'. Can be 'pending', 'notice', or 'completed'.
|
||||
|
||||
=cut
|
||||
|
||||
sub addInternationalizedEntry {
|
||||
my ($u, $userId, $url, $groupId, $internationalId, @users, $messageLogId,$sth, $user, %message, %subject, $message, $subject, $namespace, $status);
|
||||
$messageLogId = getNextId("messageLogId");
|
||||
|
|
@ -103,6 +204,17 @@ sub addInternationalizedEntry {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 completeEntry ( messageLogId )
|
||||
|
||||
Set a message log entry to complete.
|
||||
|
||||
=item messageLogId
|
||||
|
||||
The id of the message to complete.
|
||||
|
||||
=cut
|
||||
|
||||
sub completeEntry {
|
||||
WebGUI::SQL->write("update messageLog set status='completed', dateOfEntry=".time()." where messageLogId='$_[0]'");
|
||||
}
|
||||
|
|
|
|||
|
|
@ -13,6 +13,7 @@ package WebGUI::Operation::Package;
|
|||
use Exporter;
|
||||
use strict qw(vars subs);
|
||||
use WebGUI::Icon;
|
||||
use WebGUI::Page;
|
||||
use WebGUI::Privilege;
|
||||
use WebGUI::Session;
|
||||
use WebGUI::SQL;
|
||||
|
|
@ -49,7 +50,7 @@ sub _recursePageTree {
|
|||
while (%package = $a->hash) {
|
||||
$newPageId = getNextId("pageId");
|
||||
$sequenceNumber++;
|
||||
$urlizedTitle = WebGUI::URL::makeUnique($package{urlizedTitle});
|
||||
$urlizedTitle = WebGUI::Page::makeUnique($package{urlizedTitle});
|
||||
WebGUI::SQL->write("insert into page (
|
||||
pageId,
|
||||
parentId,
|
||||
|
|
|
|||
|
|
@ -446,7 +446,7 @@ sub www_editPageSave {
|
|||
$session{form}{title} = "no title" if ($session{form}{title} eq "");
|
||||
$session{form}{menuTitle} = $session{form}{title} if ($session{form}{menuTitle} eq "");
|
||||
$session{form}{urlizedTitle} = $session{form}{menuTitle} if ($session{form}{urlizedTitle} eq "");
|
||||
$session{form}{urlizedTitle} = WebGUI::URL::makeUnique(WebGUI::URL::urlize($session{form}{urlizedTitle}),$session{form}{pageId});
|
||||
$session{form}{urlizedTitle} = WebGUI::Page::makeUnique(WebGUI::URL::urlize($session{form}{urlizedTitle}),$session{form}{pageId});
|
||||
$session{form}{startDate} = setToEpoch($session{form}{startDate}) || setToEpoch(time());
|
||||
$session{form}{endDate} = setToEpoch($session{form}{endDate}) || setToEpoch(addToDate(time(),10));
|
||||
WebGUI::SQL->write("update page set
|
||||
|
|
|
|||
|
|
@ -1,14 +1,19 @@
|
|||
package WebGUI::Page;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
#-------------------------------------------------------------------
|
||||
# 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
|
||||
#-------------------------------------------------------------------
|
||||
=head1 LEGAL
|
||||
|
||||
-------------------------------------------------------------------
|
||||
WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
-------------------------------------------------------------------
|
||||
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
|
||||
-------------------------------------------------------------------
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
use HTML::Template;
|
||||
use strict;
|
||||
|
|
@ -20,12 +25,49 @@ use WebGUI::SQL;
|
|||
use WebGUI::Template;
|
||||
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Package WebGUI::Page
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WebGUI::Page;
|
||||
$integer = WebGUI::Page::countTemplatePositions($templateId);
|
||||
$html = WebGUI::Page::drawTemplate($templateId);
|
||||
$hashRef = WebGUI::Page::getTemplateList();
|
||||
$template = WebGUI::Page::getTemplate($templateId);
|
||||
$hashRef = WebGUI::Page::getTemplatePositions($templateId);
|
||||
$url = WebGUI::Page::makeUnique($url,$pageId);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This package provides utility functions for WebGUI's page system.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
These functions are available from this package:
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub _newPositionFormat {
|
||||
return "<tmpl_var page.position".($_[0]+1).">";
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 countTemplatePositions ( templateId )
|
||||
|
||||
Returns the number of template positions in the specified page template.
|
||||
|
||||
=item templateId
|
||||
|
||||
The id of the page template you wish to count.
|
||||
|
||||
=cut
|
||||
|
||||
sub countTemplatePositions {
|
||||
my ($template, $i);
|
||||
$template = getTemplate($_[0]);
|
||||
|
|
@ -37,6 +79,17 @@ sub countTemplatePositions {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 drawTemplate ( templateId )
|
||||
|
||||
Returns an HTML string containing a small representation of the page template.
|
||||
|
||||
=item templateId
|
||||
|
||||
The id of the page template you wish to draw.
|
||||
|
||||
=cut
|
||||
|
||||
sub drawTemplate {
|
||||
my $template = getTemplate($_[0]);
|
||||
$template =~ s/\n//g;
|
||||
|
|
@ -48,11 +101,30 @@ sub drawTemplate {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getTemplateList
|
||||
|
||||
Returns a hash reference containing template ids and template titles
|
||||
for all the page templates available in the system.
|
||||
|
||||
=cut
|
||||
|
||||
sub getTemplateList {
|
||||
return WebGUI::Template::getList("Page");
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getTemplate ( templateId )
|
||||
|
||||
Returns an HTML template.
|
||||
|
||||
=item templateId
|
||||
|
||||
The id of the page template you wish to retrieve.
|
||||
|
||||
=cut
|
||||
|
||||
sub getTemplate {
|
||||
my $template = WebGUI::Template::get($_[0],"Page");
|
||||
$template =~ s/\^(\d+)\;/_newPositionFormat($1)/eg; #compatibility with old-style templates
|
||||
|
|
@ -60,6 +132,18 @@ sub getTemplate {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getTemplatePositions ( templateId )
|
||||
|
||||
Returns a hash reference containing the positions available in
|
||||
the specified page template.
|
||||
|
||||
=item templateId
|
||||
|
||||
The id of the page template you wish to retrieve the positions from.
|
||||
|
||||
=cut
|
||||
|
||||
sub getTemplatePositions {
|
||||
my (%hash, $template, $i);
|
||||
tie %hash, "Tie::IxHash";
|
||||
|
|
@ -69,6 +153,36 @@ sub getTemplatePositions {
|
|||
return \%hash;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 makeUnique ( pageURL, pageId )
|
||||
|
||||
Returns a unique page URL.
|
||||
|
||||
=item url
|
||||
|
||||
The URL you're hoping for.
|
||||
|
||||
=item pageId
|
||||
|
||||
The page id of the page you're creating a URL for.
|
||||
|
||||
=cut
|
||||
|
||||
sub makeUnique {
|
||||
my ($url, $test, $pageId);
|
||||
$url = $_[0];
|
||||
$pageId = $_[1] || "new";
|
||||
while (($test) = WebGUI::SQL->quickArray("select urlizedTitle from page where urlizedTitle='$url' and pageId<>'$pageId'")) {
|
||||
if ($url =~ /(.*)(\d+$)/) {
|
||||
$url = $1.($2+1);
|
||||
} elsif ($test ne "") {
|
||||
$url .= "2";
|
||||
}
|
||||
}
|
||||
return $url;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,14 +1,19 @@
|
|||
package WebGUI::Session;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
#-------------------------------------------------------------------
|
||||
# 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
|
||||
#-------------------------------------------------------------------
|
||||
=head1 LEGAL
|
||||
|
||||
-------------------------------------------------------------------
|
||||
WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
-------------------------------------------------------------------
|
||||
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
|
||||
-------------------------------------------------------------------
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
use CGI;
|
||||
use Data::Config;
|
||||
|
|
@ -25,6 +30,51 @@ our @EXPORT = qw(%session);
|
|||
our %session = ();
|
||||
tie %session, 'Tie::CPHash';
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Package WebGUI::Session
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WebGUI::Session;
|
||||
WebGUI::Session::close();
|
||||
WebGUI::Session::convertVisitorToUser($sessionId,$userId);
|
||||
WebGUI::Session::end($sessionId);
|
||||
$header = WebGUI::Session::httpHeader();
|
||||
$header = WebGUI::Session::httpRedirect($url);
|
||||
WebGUI::Session::open($webguiRoot,$configFilename);
|
||||
WebGUI::Session::refreshPageInfo($pageId);
|
||||
WebGUI::Session::refreshSessionVars($sessionId);
|
||||
WebGUI::Session::refreshUserInfo($userId);
|
||||
WebGUI::Session::setCookie($name,$value);
|
||||
WebGUI::Session::setScratch($name,$value);
|
||||
WebGUI::Session::start($userId);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This package is the heart and lifeblood of WebGUI. Without it WebGUI
|
||||
could not exist. By using this package a package gains access to
|
||||
WebGUI's $session variable which contains everything WebGUI needs to
|
||||
know to operate.
|
||||
|
||||
NOTE: It is important to distinguish the difference between a WebGUI
|
||||
session and a user session. A user session is attached to a WebGUI
|
||||
session. A WebGUI session is all of the basic data the WebGUI needs
|
||||
to operate.
|
||||
|
||||
TIP: The $session variable is a case-insensitive hash. The contents
|
||||
of the has vary, but can be seen by adding debug=1 to the end of any
|
||||
WebGUI URL while logged in as an admin user.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
These subroutines are available from this package:
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub _generateSessionId {
|
||||
my ($sessionId);
|
||||
|
|
@ -202,6 +252,14 @@ sub _loadWobjects {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 close
|
||||
|
||||
Cleans up a WebGUI session information from memory and disconnects from
|
||||
any resources opened by the session.
|
||||
|
||||
=cut
|
||||
|
||||
sub close {
|
||||
$session{'dbh'}->disconnect();
|
||||
undef %session;
|
||||
|
|
@ -209,6 +267,21 @@ sub close {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 convertVisitorToUser ( sessionId, userId )
|
||||
|
||||
Converts a visitor session to a user session.
|
||||
|
||||
=item sessionId
|
||||
|
||||
The session to convert.
|
||||
|
||||
=item userId
|
||||
|
||||
The user for the session to become.
|
||||
|
||||
=cut
|
||||
|
||||
sub convertVisitorToUser {
|
||||
WebGUI::SQL->write("update userSession set userId=$_[1] where sessionId=".quote($_[0]));
|
||||
$session{var}{userId} = $_[1];
|
||||
|
|
@ -216,6 +289,17 @@ sub convertVisitorToUser {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 end ( sessionId )
|
||||
|
||||
Removes the specified user session from memory and database.
|
||||
|
||||
=item sessionId
|
||||
|
||||
The session to end.
|
||||
|
||||
=cut
|
||||
|
||||
sub end {
|
||||
WebGUI::SQL->write("delete from userSession where sessionId='$_[0]'",$session{dbh});
|
||||
WebGUI::SQL->write("delete from userSessionScratch where sessionId='$_[0]'",$session{dbh});
|
||||
|
|
@ -225,6 +309,13 @@ sub end {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 httpHeader ( )
|
||||
|
||||
Generates an HTTP header.
|
||||
|
||||
=cut
|
||||
|
||||
sub httpHeader {
|
||||
unless ($session{header}{charset}) {
|
||||
$session{header}{charset} = $session{language}{characterSet} || "ISO-8859-1";
|
||||
|
|
@ -241,11 +332,38 @@ sub httpHeader {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 httpRedirect ( url )
|
||||
|
||||
Generates an HTTP header for redirect.
|
||||
|
||||
=item url
|
||||
|
||||
The URL to redirect to.
|
||||
|
||||
=cut
|
||||
|
||||
sub httpRedirect {
|
||||
|
||||
return $session{cgi}->redirect($_[0]);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 open ( webguiRoot [ , configFile ] )
|
||||
|
||||
Opens a closed ( or new ) WebGUI session.
|
||||
|
||||
=item webguiRoot
|
||||
|
||||
The path to the WebGUI files.
|
||||
|
||||
=item configFile
|
||||
|
||||
The filename of the config file that WebGUI should operate from.
|
||||
|
||||
=cut
|
||||
|
||||
sub open {
|
||||
my ($key, $config);
|
||||
###----------------------------
|
||||
|
|
@ -347,6 +465,18 @@ sub open {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 refreshPageInfo ( [ pageId ] )
|
||||
|
||||
Updates the WebGUI session to reflect new page information.
|
||||
|
||||
=item pageId
|
||||
|
||||
Defaults to page id "1". Specify the page id to change this WebGUI
|
||||
session to use.
|
||||
|
||||
=cut
|
||||
|
||||
sub refreshPageInfo {
|
||||
my ($pageId);
|
||||
if ($_[0] == 0) {
|
||||
|
|
@ -358,18 +488,64 @@ sub refreshPageInfo {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 refreshSessionVars ( sessionId )
|
||||
|
||||
Updates the user session variables from the database.
|
||||
|
||||
NOTE: This also updates the user information.
|
||||
|
||||
=item sessionId
|
||||
|
||||
The session id to update.
|
||||
|
||||
=cut
|
||||
|
||||
sub refreshSessionVars {
|
||||
_setupSessionVars($_[0],$session{setting}{sessionTimeout});
|
||||
refreshUserInfo($session{var}{userId});
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 refreshUserInfo ( userId )
|
||||
|
||||
Refreshes the user's information from the database into this user
|
||||
session.
|
||||
|
||||
=item userId
|
||||
|
||||
The user id to refresh into this session.
|
||||
|
||||
=cut
|
||||
|
||||
sub refreshUserInfo {
|
||||
_setupUserInfo($_[0]);
|
||||
$session{isInGroup} = ();
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 setCookie ( name, value [ , timeToLive ] )
|
||||
|
||||
Sends a cookie to the browser.
|
||||
|
||||
=item name
|
||||
|
||||
The name of the cookie to set. Must be unique from all other cookies
|
||||
from this domain or it will overwrite that cookie.
|
||||
|
||||
=item value
|
||||
|
||||
The value to set.
|
||||
|
||||
=item timeToLive
|
||||
|
||||
The time that the cookie should remain in the browser. Defaults to
|
||||
"+10y" (10 years from now).
|
||||
|
||||
=cut
|
||||
|
||||
sub setCookie {
|
||||
my $ttl = $_[2] || '+10y';
|
||||
#my $domain = $session{env}{SERVER_NAME} if ($session{env}{HTTP_USER_AGENT} =~ m/MSIE/i);
|
||||
|
|
@ -387,7 +563,19 @@ sub setCookie {
|
|||
|
||||
=head2 setScratch ( name, value )
|
||||
|
||||
Sets a scratch variable for this user session.
|
||||
Sets a scratch variable for this user session. Scratch variables are
|
||||
just arbitrary bits of data that a programmer may wish to store in
|
||||
a user session from page to page.
|
||||
|
||||
=item name
|
||||
|
||||
The name of the scratch variable.
|
||||
|
||||
=item value
|
||||
|
||||
The value of the scratch variable. If the value is blank but defined
|
||||
or if it is set to "-delete-" then the scratch variable will be
|
||||
removed from the user session.
|
||||
|
||||
=cut
|
||||
|
||||
|
|
@ -409,6 +597,17 @@ sub setScratch {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 start ( userId )
|
||||
|
||||
Start a new user session.
|
||||
|
||||
=item
|
||||
|
||||
The user id of the user to create a session for.
|
||||
|
||||
=cut
|
||||
|
||||
sub start {
|
||||
my ($sessionId);
|
||||
if ($session{cookie}{wgSession} ne "") { #fix for internet exploder cookie bug
|
||||
|
|
|
|||
|
|
@ -1,14 +1,19 @@
|
|||
package WebGUI::Style;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
#-------------------------------------------------------------------
|
||||
# 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
|
||||
#-------------------------------------------------------------------
|
||||
=head1 LEGAL
|
||||
|
||||
-------------------------------------------------------------------
|
||||
WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
-------------------------------------------------------------------
|
||||
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
|
||||
-------------------------------------------------------------------
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
use strict;
|
||||
use Tie::CPHash;
|
||||
|
|
@ -17,7 +22,35 @@ use WebGUI::Session;
|
|||
use WebGUI::SQL;
|
||||
use WebGUI::Template;
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Package WebGUI::Style
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WebGUI::Style;
|
||||
$style = WebGUI::Style::get();
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This package contains utility methods for WebGUI's style system.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
These subroutines are available from this package:
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 get ( )
|
||||
|
||||
Returns a style based upon the current WebGUI session information.
|
||||
|
||||
=cut
|
||||
|
||||
sub get {
|
||||
my ($header, $footer, %style, $styleId, @body);
|
||||
tie %style, 'Tie::CPHash';
|
||||
|
|
@ -54,3 +87,4 @@ sub get {
|
|||
|
||||
|
||||
1;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,14 +1,20 @@
|
|||
package WebGUI::Template;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
#-------------------------------------------------------------------
|
||||
# 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
|
||||
#-------------------------------------------------------------------
|
||||
=head1 LEGAL
|
||||
|
||||
-------------------------------------------------------------------
|
||||
WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
-------------------------------------------------------------------
|
||||
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
|
||||
-------------------------------------------------------------------
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
|
||||
use HTML::Template;
|
||||
use strict;
|
||||
|
|
@ -18,7 +24,45 @@ use WebGUI::Session;
|
|||
use WebGUI::SQL;
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Package WebGUI::Template
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WebGUI::Template;
|
||||
$template = WebGUI::Template::get($templateId, $namespace);
|
||||
$hashRef = WebGUI::Template::getList($namespace);
|
||||
$html = WebGUI::Template::process($template);
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This package contains utility methods for WebGUI's template system.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
These subroutines are available from this package:
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head get ( [ templateId, namespace ] )
|
||||
|
||||
Returns a template.
|
||||
|
||||
=item templateId
|
||||
|
||||
Defaults to "1". Specify the templateId of the template to retrieve.
|
||||
|
||||
=item namespace
|
||||
|
||||
Defaults to "Page". Specify the namespace of the template to retrieve.
|
||||
|
||||
=cut
|
||||
|
||||
sub get {
|
||||
my $templateId = $_[0] || 1;
|
||||
my $namespace = $_[1] || "Page";
|
||||
|
|
@ -27,13 +71,43 @@ sub get {
|
|||
return $template;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getList ( [ namespace ] )
|
||||
|
||||
Returns a hash reference containing template ids and template names
|
||||
of all the templates in the specified namespace.
|
||||
|
||||
=item namespace
|
||||
|
||||
Defaults to "Page". Specify the namespace to build the list for.
|
||||
|
||||
=cut
|
||||
|
||||
sub getList {
|
||||
my $namespace = $_[0] || "Page";
|
||||
return WebGUI::SQL->buildHashRef("select templateId,name from template where namespace=".quote($namespace)." order by name");
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 process ( template [ , vars ] )
|
||||
|
||||
Evaluate a template replacing template commands for HTML.
|
||||
|
||||
=item template
|
||||
|
||||
The template to process.
|
||||
|
||||
=item vars
|
||||
|
||||
A hash reference containing template variables and loops. Automatically
|
||||
includes the entire WebGUI session.
|
||||
|
||||
=cut
|
||||
|
||||
sub process {
|
||||
my ($t, $test, $html);
|
||||
$html = $_[0];
|
||||
|
|
|
|||
|
|
@ -1,22 +1,74 @@
|
|||
package WebGUI::URL;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
#-------------------------------------------------------------------
|
||||
# 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
|
||||
#-------------------------------------------------------------------
|
||||
=head1 LEGAL
|
||||
|
||||
-------------------------------------------------------------------
|
||||
WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
-------------------------------------------------------------------
|
||||
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
|
||||
-------------------------------------------------------------------
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
use strict;
|
||||
use URI::Escape;
|
||||
use WebGUI::Session;
|
||||
use WebGUI::SQL;
|
||||
use WebGUI::Utility;
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Package WebGUI::URL
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WebGUI::URL;
|
||||
$url = WebGUI::URL::append($url,$pairs);
|
||||
$string = WebGUI::URL::escape($string);
|
||||
$url = WebGUI::URL::gateway($url,$pairs);
|
||||
$url = WebGUI::URL::makeCompliant($string);
|
||||
$url = WebGUI::URL::page($url,$pairs);
|
||||
$string = WebGUI::URL::unescape($string);
|
||||
$url = WebGUI::URL::urlize($string);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This package provides URL writing functionality. It is important that
|
||||
all WebGUI URLs be written using these methods so that they can contain
|
||||
any extra information that WebGUI needs to add to the URLs in order
|
||||
to function properly.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
These subroutines are available from this package:
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 append ( url, pairs )
|
||||
|
||||
Returns a URL after adding some information to the end of it.
|
||||
|
||||
=item url
|
||||
|
||||
The URL to append information to.
|
||||
|
||||
=item pairs
|
||||
|
||||
Name value pairs to add to the URL in the form of:
|
||||
|
||||
name1=value1&name2=value2&name3=value3
|
||||
|
||||
=cut
|
||||
|
||||
sub append {
|
||||
my ($url);
|
||||
$url = $_[0];
|
||||
|
|
@ -29,11 +81,42 @@ sub append {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 escape ( string )
|
||||
|
||||
Encodes a string to make it safe to pass in a URL.
|
||||
|
||||
NOTE: See WebGUI::URL::unescape()
|
||||
|
||||
=item string
|
||||
|
||||
The string to escape.
|
||||
|
||||
=cut
|
||||
|
||||
sub escape {
|
||||
return uri_escape($_[0]);
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 gateway ( pageURL [ , pairs ] )
|
||||
|
||||
Generate a URL based on WebGUI's gateway script.
|
||||
|
||||
=item pageURL
|
||||
|
||||
The urlized title of a page that you wish to create a URL for.
|
||||
|
||||
=item pairs
|
||||
|
||||
Name value pairs to add to the URL in the form of:
|
||||
|
||||
name1=value1&name2=value2&name3=value3
|
||||
|
||||
=cut
|
||||
|
||||
sub gateway {
|
||||
my ($url);
|
||||
$url = $session{config}{scripturl}.'/'.$_[0];
|
||||
|
|
@ -47,6 +130,18 @@ sub gateway {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 makeCompliant ( string )
|
||||
|
||||
Returns a string that has made into a WebGUI compliant URL.
|
||||
|
||||
=item string
|
||||
|
||||
The string to make compliant. This is usually a page title or a
|
||||
filename.
|
||||
|
||||
=cut
|
||||
|
||||
sub makeCompliant {
|
||||
my ($value);
|
||||
$value = $_[0];
|
||||
|
|
@ -60,21 +155,19 @@ sub makeCompliant {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub makeUnique {
|
||||
my ($url, $test, $pageId);
|
||||
$url = $_[0];
|
||||
$pageId = $_[1] || "new";
|
||||
while (($test) = WebGUI::SQL->quickArray("select urlizedTitle from page where urlizedTitle='$url' and pageId<>'$pageId'")) {
|
||||
if ($url =~ /(.*)(\d+$)/) {
|
||||
$url = $1.($2+1);
|
||||
} elsif ($test ne "") {
|
||||
$url .= "2";
|
||||
}
|
||||
}
|
||||
return $url;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
=head2 page ( [ pairs ] )
|
||||
|
||||
Returns the URL of the current page.
|
||||
|
||||
=item pairs
|
||||
|
||||
Name value pairs to add to the URL in the form of:
|
||||
|
||||
name1=value1&name2=value2&name3=value3
|
||||
|
||||
=cut
|
||||
|
||||
sub page {
|
||||
my ($url);
|
||||
$url = $session{page}{url};
|
||||
|
|
@ -88,11 +181,36 @@ sub page {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 unescape
|
||||
|
||||
Decodes a string that was URL encoded.
|
||||
|
||||
NOTE: See WebGUI::URL::escape()
|
||||
|
||||
=item string
|
||||
|
||||
The string to unescape.
|
||||
|
||||
=cut
|
||||
|
||||
sub unescape {
|
||||
return uri_unescape($_[0]);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 urlize ( string )
|
||||
|
||||
Same as makeCompliant except that it also lower-cases the string.
|
||||
This is mainly meant for WebGUI page URLs.
|
||||
|
||||
=item string
|
||||
|
||||
The string to urlize.
|
||||
|
||||
=cut
|
||||
|
||||
sub urlize {
|
||||
my ($value);
|
||||
$value = lc($_[0]); #lower cases whole string
|
||||
|
|
|
|||
|
|
@ -1,14 +1,20 @@
|
|||
package WebGUI::Utility;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
#-------------------------------------------------------------------
|
||||
# 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
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head1 LEGAL
|
||||
|
||||
-------------------------------------------------------------------
|
||||
WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
-------------------------------------------------------------------
|
||||
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
|
||||
-------------------------------------------------------------------
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
use Exporter;
|
||||
use strict;
|
||||
|
|
@ -18,7 +24,51 @@ our @ISA = qw(Exporter);
|
|||
our @EXPORT = qw(&makeTabSafe &makeArrayTabSafe &randomizeHash &commify &randomizeArray
|
||||
&sortHashDescending &sortHash &isIn &makeCommaSafe &makeArrayCommaSafe &randint &round);
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Package WebGUI::Utility
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WebGUI::Utility;
|
||||
$string = commify($integer);
|
||||
$boolean = isIn($value, @array);
|
||||
makeArrayCommaSafe(\@array);
|
||||
makeArrayTabSafe(\@array);
|
||||
$string = makeCommaSafe($string);
|
||||
$string = makeTabSafe($string);
|
||||
$integer = randint($low,$high);
|
||||
randomizeArray(\@array);
|
||||
$hashRef = randomizeHash(\%hash);
|
||||
$hashRef = sortHash(\%hash);
|
||||
$hashRef = sortHashDescending(\%hash);
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This package provides miscellaneous but useful utilities to the
|
||||
WebGUI programmer.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
These subroutines are available from this package:
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 commify ( integer )
|
||||
|
||||
Returns a number with commas applied at each third character.
|
||||
|
||||
=item integer
|
||||
|
||||
Any old number will do.
|
||||
|
||||
=cut
|
||||
|
||||
sub commify {
|
||||
my $text = reverse $_[0];
|
||||
$text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
|
||||
|
|
@ -26,6 +76,21 @@ sub commify {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 isIn ( value, list )
|
||||
|
||||
Returns a boolean value as to whether the value is in the array.
|
||||
|
||||
=item value
|
||||
|
||||
The value to check for.
|
||||
|
||||
=item list
|
||||
|
||||
An array to look for the value in.
|
||||
|
||||
=cut
|
||||
|
||||
sub isIn {
|
||||
my ($i, @a, @b, @isect, %union, %isect, $e);
|
||||
foreach $e (@_) {
|
||||
|
|
@ -47,6 +112,19 @@ sub isIn {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 makeArrayCommaSafe ( array )
|
||||
|
||||
Searches through an array looking for commas and replaces them with
|
||||
semi-colons. Also replaces carriage returns with spaces. This is
|
||||
useful for exporting comma separated data.
|
||||
|
||||
=item array
|
||||
|
||||
A reference to the array to look through.
|
||||
|
||||
=cut
|
||||
|
||||
sub makeArrayCommaSafe {
|
||||
my ($array) = $_[0];
|
||||
my ($i);
|
||||
|
|
@ -56,6 +134,19 @@ sub makeArrayCommaSafe {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 makeArrayTabSafe ( array )
|
||||
|
||||
Searches through an array looking for tabs and replaces them with
|
||||
four spaces. Also replaces carriage returns with a space. This is
|
||||
useful for exporting tab separated data.
|
||||
|
||||
=item array
|
||||
|
||||
A reference to the array to look through.
|
||||
|
||||
=cut
|
||||
|
||||
sub makeArrayTabSafe {
|
||||
my ($array) = $_[0];
|
||||
my ($i);
|
||||
|
|
@ -65,6 +156,17 @@ sub makeArrayTabSafe {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 makeCommaSafe ( text )
|
||||
|
||||
Replaces commas with semi-colons and carriage returns with spaces.
|
||||
|
||||
=item text
|
||||
|
||||
The text to search through.
|
||||
|
||||
=cut
|
||||
|
||||
sub makeCommaSafe {
|
||||
my ($text) = $_[0];
|
||||
$text =~ s/\n/ /g;
|
||||
|
|
@ -74,6 +176,17 @@ sub makeCommaSafe {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 makeCommaSafe ( text )
|
||||
|
||||
Replaces tabs with four spaces and carriage returns with a space each.
|
||||
|
||||
=item text
|
||||
|
||||
The text to search through.
|
||||
|
||||
=cut
|
||||
|
||||
sub makeTabSafe {
|
||||
my ($text) = $_[0];
|
||||
$text =~ s/\n/ /g;
|
||||
|
|
@ -83,6 +196,21 @@ sub makeTabSafe {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 randint ( low, high )
|
||||
|
||||
Returns an integer between the low and high number.
|
||||
|
||||
=item low
|
||||
|
||||
The lowest possible value. Defaults to 0.
|
||||
|
||||
=item high
|
||||
|
||||
The highest possible value. Defaults to 1.
|
||||
|
||||
=cut
|
||||
|
||||
sub randint {
|
||||
my ($low, $high) = @_;
|
||||
$low = 0 unless defined $low;
|
||||
|
|
@ -92,6 +220,17 @@ sub randint {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 randomizeArray ( array )
|
||||
|
||||
Resorts an array in random order.
|
||||
|
||||
=item array
|
||||
|
||||
A reference to the array to randomize.
|
||||
|
||||
=cut
|
||||
|
||||
sub randomizeArray {
|
||||
my ($array, $i, $j);
|
||||
$array = shift;
|
||||
|
|
@ -105,6 +244,17 @@ sub randomizeArray {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 randomizeHash ( hashRef )
|
||||
|
||||
Resorts a hash tied to IxHash in random order. Returns a hash reference.
|
||||
|
||||
=item hashRef
|
||||
|
||||
A reference hash to randomize.
|
||||
|
||||
=cut
|
||||
|
||||
sub randomizeHash {
|
||||
my ($hash, $key, @keys, %temp);
|
||||
$hash = $_[0];
|
||||
|
|
@ -120,11 +270,35 @@ sub randomizeHash {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 round ( real )
|
||||
|
||||
Returns an integer after rounding a real number.
|
||||
|
||||
=item real
|
||||
|
||||
Any floating point number.
|
||||
|
||||
=cut
|
||||
|
||||
sub round {
|
||||
return sprintf("%.0f", $_[0]);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 sortHash ( hashRef )
|
||||
|
||||
Sorts a hash by its values. Returns a hash reference.
|
||||
|
||||
TIP: This subroutine can screw up your hash if the values aren't all unique.
|
||||
|
||||
=item hashRef
|
||||
|
||||
A reference to the hash to be sorted.
|
||||
|
||||
=cut
|
||||
|
||||
sub sortHash {
|
||||
my (%hash, %reversedHash, %newHash, $key);
|
||||
tie %hash, "Tie::IxHash";
|
||||
|
|
@ -140,6 +314,19 @@ sub sortHash {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 sortHashDecending
|
||||
|
||||
Sorts a hash in decending order by its values. Returns a hash reference.
|
||||
|
||||
TIP: This subroutine can screw up your hash if the values aren't all unique.
|
||||
|
||||
=item hashRef
|
||||
|
||||
A reference to the hash to be sorted.
|
||||
|
||||
=cut
|
||||
|
||||
sub sortHashDescending {
|
||||
my (%hash, %reversedHash, %newHash, $key);
|
||||
tie %hash, "Tie::IxHash";
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue