Merge remote-tracking branch 'upstream/WebGUI8' into 8
Conflicts: docs/previousVersion.sql
This commit is contained in:
Doug Bell
commit
02c0da33e4
7 changed files with 223 additions and 2636 deletions
183
lib/WebGUI/Command/changeIobStatus.pm
Normal file
183
lib/WebGUI/Command/changeIobStatus.pm
Normal file
|
|
@ -0,0 +1,183 @@
|
|||
package WebGUI::Command::changeIobStatus;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2009 Plain Black Corporation.
|
||||
#-------------------------------------------------------------------
|
||||
# Please read the legal notices (docs/legal.txt) and the license
|
||||
# (docs/license.txt) that came with this distribution before using
|
||||
# this software.
|
||||
#-------------------------------------------------------------------
|
||||
# http://www.plainblack.com info@plainblack.com
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
use WebGUI::Command -command;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
sub opt_spec {
|
||||
return (
|
||||
[ 'configFile=s', 'The WebGUI config file to use. This parameter is required.'],
|
||||
[ 'quiet', q{Disable all output unless there's an error.} ],
|
||||
[ 'whatsHappening:s', q{The message attached to the InOut Board when changing status. If left unspecified it defaults to 'Automatically signed out.'}],
|
||||
[ 'userMessage:s', q{Text of the message to be sent to the user after changing the status. If left unspecified it will default to 'You were logged out of the In/Out Board automatically.'}],
|
||||
[ 'userMessageFile:s', q{Pathname to a file whose contents will be sent to the user after changing the status. Using this option overrides whatever messages is set with --userMessage (see above).}],
|
||||
[ 'currentStatus:s', q{Check users in the IOB having status status. If left unspecified, it will default to In.}],
|
||||
[ 'newStatus:s', q{Change users status in the IOB to status status. If left unspecified, it will default to Out.}],
|
||||
);
|
||||
}
|
||||
|
||||
sub validate_args {
|
||||
my ($self, $opt, $args) = @_;
|
||||
if (! $opt->{configfile}) {
|
||||
$self->usage_error('You must specify the --configFile option.');
|
||||
}
|
||||
}
|
||||
|
||||
sub run {
|
||||
my ($self, $opt, $args) = @_;
|
||||
|
||||
my ($configFile, $help, $quiet, $whatsHappening, $newStatus, $currentStatus, $userMessage, $userMessageFile) =
|
||||
@{$opt}{qw(configfile help quiet whatshappening newstatus currentstatus usermessage usermessagefile)};
|
||||
$whatsHappening ||= "Automatically signed out.";
|
||||
$newStatus ||= "Out";
|
||||
$currentStatus ||= "In";
|
||||
$userMessage ||= "You were logged out of the In/Out Board automatically.";
|
||||
|
||||
print "Starting up...\n" unless ($quiet);
|
||||
my $session = WebGUI::Session->open($configFile);
|
||||
|
||||
if ($userMessageFile) {
|
||||
print "Opening message file.." unless ($quiet);
|
||||
if (open(FILE,"<".$userMessageFile)) {
|
||||
print "OK\n" unless ($quiet);
|
||||
my $contents;
|
||||
while (<FILE>) {
|
||||
$contents .= $_;
|
||||
}
|
||||
close(FILE);
|
||||
if (length($contents) == 0) {
|
||||
print "Message file empty, reverting to original message.\n";
|
||||
} else {
|
||||
$userMessage = $contents;
|
||||
}
|
||||
} else {
|
||||
print "Failed to open message file.\n";
|
||||
}
|
||||
}
|
||||
|
||||
print "Searching for users with a status of $currentStatus ...\n" unless ($quiet);
|
||||
my $userList;
|
||||
my $now = time();
|
||||
my $inbox = WebGUI::Inbox->new($session);
|
||||
my $sth = $session->db->read("select userId,assetId from InOutBoard_status where status=?",[$currentStatus]);
|
||||
while (my ($userId,$assetId) = $sth->array) {
|
||||
my $user = WebGUI::User->new($session, $userId);
|
||||
print "\tFound user ".$user->username."\n" unless ($quiet);
|
||||
$userList .= $user->username." (".$userId.")\n";
|
||||
$session->db->write("update InOutBoard_status set dateStamp=?, message=?, status=? where userId=? and assetId=?",[$now, $whatsHappening, $newStatus, $userId, $assetId]);
|
||||
$session->db->write("insert into InOutBoard_statusLog (userId, createdBy, dateStamp, message, status, assetId) values (?,?,?,?,?,?)",
|
||||
[$userId,3,$now, $whatsHappening, $newStatus, $assetId]);
|
||||
$inbox->addMessage({
|
||||
userId=>$userId,
|
||||
subject=>"IOB Update",
|
||||
message=>$userMessage
|
||||
});
|
||||
}
|
||||
|
||||
if (length($userList) > 0) {
|
||||
print "Alerting admins of changes\n" unless ($quiet);
|
||||
my $message = "The following users had their status changed:\n\n".$userList;
|
||||
$inbox->addMessage({
|
||||
groupId=>3,
|
||||
subject=>"IOB Update",
|
||||
message=>$userMessage
|
||||
});
|
||||
}
|
||||
|
||||
print "Cleaning up..." unless ($quiet);
|
||||
$session->var->end;
|
||||
$session->close;
|
||||
print "OK\n" unless ($quiet);
|
||||
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WebGUI::Command::changeIobStatus - Automate WebGUI's InOut Board User status switching.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
webgui.pl changeiobstatus --configFile config.conf
|
||||
[--currentStatus status]
|
||||
[--newStatus status]
|
||||
[--userMessage text|--userMessageFile pathname]
|
||||
[--whatsHappening text]
|
||||
[--quiet]
|
||||
|
||||
webgui.pl changeiobstatus --help
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This WebGUI utility script helps you switch one or more user status
|
||||
in the InOut Board (IOB). For instance, you might want to run it
|
||||
from cron each night to automatically mark out all users that haven't
|
||||
already marked out.
|
||||
|
||||
=over
|
||||
|
||||
=item B<--configFile config.conf>
|
||||
|
||||
The WebGUI config file to use. Only the file name needs to be specified,
|
||||
since it will be looked up inside WebGUI's configuration directory.
|
||||
This parameter is required.
|
||||
|
||||
=item B<--currentStatus status>
|
||||
|
||||
Check users in the IOB having B<status> status. If left unspecified,
|
||||
it will default to C<In>.
|
||||
|
||||
=item B<--newStatus status>
|
||||
|
||||
Change users status in the IOB to B<status> status. If left unspecified,
|
||||
it will default to C<Out>.
|
||||
|
||||
=item B<--userMessage msg>
|
||||
|
||||
Text of the message to be sent to the user after changing the status.
|
||||
If left unspecified it will default to
|
||||
|
||||
You were logged out of the In/Out Board automatically.
|
||||
|
||||
=item B<--userMessageFile pathname>
|
||||
|
||||
Pathname to a file whose contents will be sent to the user after changing
|
||||
the status. Using this option overrides whatever messages is set
|
||||
with B<--userMessage> (see above).
|
||||
|
||||
=item B<--whatsHappening text>
|
||||
|
||||
The message attached to the InOut Board when changing status. If left
|
||||
unspecified it defaults to
|
||||
|
||||
Automatically signed out.
|
||||
|
||||
=item B<--quiet>
|
||||
|
||||
Disable all output unless there's an error.
|
||||
|
||||
=item B<--help>
|
||||
|
||||
Shows this documentation, then exits.
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright 2001-2009 Plain Black Corporation.
|
||||
|
||||
=cut
|
||||
|
||||
|
|
@ -1,6 +1,7 @@
|
|||
package WebGUI::Template::Plugin::Asset;
|
||||
|
||||
use base 'Template::Plugin';
|
||||
use WebGUI::Template::Proxy::Asset;
|
||||
|
||||
sub new {
|
||||
my $config = ref($_[-1]) eq 'HASH' ? pop(@_) : { };
|
||||
|
|
@ -9,42 +10,33 @@ sub new {
|
|||
my $stash = $context->stash;
|
||||
my $session = $stash->{_session};
|
||||
|
||||
my $self = bless {
|
||||
_session => $session,
|
||||
_context => $context,
|
||||
}, $class;
|
||||
|
||||
if ( ref $asset) {
|
||||
}
|
||||
elsif ( defined $asset ) {
|
||||
$asset = $self->_getAsset($asset);
|
||||
$asset = $class->_getAsset($session, $asset);
|
||||
}
|
||||
elsif ( $stash->{_asset} ) {
|
||||
$asset = $stash->{_asset};
|
||||
}
|
||||
elsif ( $stash->{assetId} ) {
|
||||
$asset = $self->_getAsset($stash->{assetId});
|
||||
$asset = $class->_getAsset($session, $stash->{assetId});
|
||||
}
|
||||
else {
|
||||
$asset = $session->asset;
|
||||
}
|
||||
$self->{_asset} = $asset;
|
||||
|
||||
my %properties = map { $_ => 1 } $asset->meta->get_all_properties_list;
|
||||
$self->{_callable} = \%properties;
|
||||
|
||||
return $self;
|
||||
return WebGUI::Template::Proxy::Asset->_new($context, $asset);
|
||||
}
|
||||
|
||||
sub _getAsset {
|
||||
my ( $self, $id ) = @_;
|
||||
my ( $class, $session, $id ) = @_;
|
||||
my ( $asset );
|
||||
try {
|
||||
$asset = WebGUI::Asset->newByUrl( $self->session, $id );
|
||||
$asset = WebGUI::Asset->newByUrl( $session, $id );
|
||||
}
|
||||
catch {
|
||||
try {
|
||||
$asset = WebGUI::Asset->newById( $self->session, $id );
|
||||
$asset = WebGUI::Asset->newById( $session, $id );
|
||||
}
|
||||
catch {
|
||||
die "Could not find asset $id to include in template: " . $_;
|
||||
|
|
@ -53,37 +45,5 @@ sub _getAsset {
|
|||
return $asset;
|
||||
}
|
||||
|
||||
sub DESTROY {
|
||||
# prevent AUTOLOADing
|
||||
}
|
||||
|
||||
sub AUTOLOAD {
|
||||
my $sub = our $AUTOLOAD;
|
||||
$sub =~ s/.*:://;
|
||||
my $self = shift;
|
||||
if ($self->{_callable}{$sub}) {
|
||||
my $result = $self->{_asset}->();
|
||||
if ( eval { $result->isa('WebGUI::Asset'); 1 } ) {
|
||||
return $self->_wrap($result);
|
||||
}
|
||||
return $result;
|
||||
}
|
||||
die 'Not allowed to call ' . $sub;
|
||||
}
|
||||
|
||||
sub _wrap {
|
||||
my $self = shift;
|
||||
my $wrap = shift;
|
||||
my $class = ref $self;
|
||||
return $class->new($self->{_context}, $wrap);
|
||||
}
|
||||
|
||||
sub parent {
|
||||
my $self = shift;
|
||||
my $parent = $self->{_asset}->parentNode;
|
||||
return $self->_wrap($parent);
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
||||
|
|
|
|||
127
lib/WebGUI/Template/Proxy.pm
Normal file
127
lib/WebGUI/Template/Proxy.pm
Normal file
|
|
@ -0,0 +1,127 @@
|
|||
package WebGUI::Template::Proxy;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Scalar::Util qw(blessed);
|
||||
use mro;
|
||||
use Try::Tiny;
|
||||
use namespace::clean;
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
$class = __PACKAGE__->_classify($class);
|
||||
return $class->_new(@_);
|
||||
}
|
||||
|
||||
sub _new {
|
||||
my ($class, $context, $object) = @_;
|
||||
|
||||
my $stash = $context->stash;
|
||||
my $session = $stash->{_session};
|
||||
|
||||
my $self = bless {
|
||||
_session => $session,
|
||||
_context => $context,
|
||||
_object => $object,
|
||||
}, $class;
|
||||
|
||||
$self->{_methods} = $self->_get_methods($object);
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub DESTROY {
|
||||
# prevent AUTOLOADing
|
||||
}
|
||||
|
||||
sub AUTOLOAD {
|
||||
my $subname = our $AUTOLOAD;
|
||||
$subname =~ s/.*:://;
|
||||
my $self = shift;
|
||||
if (my $sub = $self->can($subname)) {
|
||||
return $self->$sub(@_);
|
||||
}
|
||||
die 'Method not found: ' . $subname;
|
||||
}
|
||||
|
||||
sub can {
|
||||
my ($self, $subname) = @_;
|
||||
my $sub = $self->SUPER::can($subname);
|
||||
if ($sub) {
|
||||
return $sub;
|
||||
}
|
||||
elsif (ref $self) {
|
||||
if ($self->{_methods}{$subname}) {
|
||||
return $self->{_methods}{$subname};
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
my %classified;
|
||||
sub _classify {
|
||||
my $self = shift;
|
||||
my $class = shift;
|
||||
if ($classified{$class}) {
|
||||
return $classified{$class};
|
||||
}
|
||||
my $classes = mro::get_linear_isa($class);
|
||||
my @proxyclasses = map { (/^WebGUI::(.*)/ ? (__PACKAGE__ . '::' . $1) : (), __PACKAGE__ . '::' . $_) } @$classes;
|
||||
for my $isa ( @proxyclasses ) {
|
||||
(my $module = $isa . '.pm') =~ s{::}{/}g;
|
||||
try {
|
||||
require $module;
|
||||
$classified{$class} = $isa;
|
||||
} || next;
|
||||
return $isa;
|
||||
}
|
||||
die "Cannot proxy $class";
|
||||
}
|
||||
|
||||
sub _get_methods {
|
||||
my $self = shift;
|
||||
my $object = shift;
|
||||
my @allowed = $self->_get_allowed($object);
|
||||
my %methods;
|
||||
for my $method ( @allowed ) {
|
||||
$methods{$method} = $self->_gen_wrapped($method);
|
||||
}
|
||||
return \%methods;
|
||||
}
|
||||
|
||||
sub _gen_wrapped {
|
||||
my $self = shift;
|
||||
my $method = shift;
|
||||
my $context = $self->{_context};
|
||||
my $object = $self->{_object};
|
||||
return sub {
|
||||
my @res;
|
||||
if (wantarray) {
|
||||
@res = $object->$method;
|
||||
}
|
||||
else {
|
||||
$res[0] = $object->$method;
|
||||
}
|
||||
for my $res ( @res ) {
|
||||
$self->_wrap(@res);
|
||||
}
|
||||
return wantarray ? @res : $res[0];
|
||||
};
|
||||
}
|
||||
|
||||
sub _wrap {
|
||||
my $self = shift;
|
||||
my $context = $self->{_context};
|
||||
for my $item ( @_ ) {
|
||||
if ( blessed $item ) {
|
||||
if (! $item->isa(__PACKAGE__) ) {
|
||||
$item = __PACKAGE__->new($context, $item);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub _get_allowed {
|
||||
return ();
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
22
lib/WebGUI/Template/Proxy/Asset.pm
Normal file
22
lib/WebGUI/Template/Proxy/Asset.pm
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
package WebGUI::Template::Proxy::Asset;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use base 'WebGUI::Template::Proxy';
|
||||
|
||||
sub _get_allowed {
|
||||
my $self = shift;
|
||||
my $asset = shift;
|
||||
my @properties = $asset->meta->get_all_property_list;
|
||||
return @properties;
|
||||
}
|
||||
|
||||
sub parent {
|
||||
my $self = shift;
|
||||
my $parent = $self->{_asset}->parentNode;
|
||||
$self->_wrap($parent);
|
||||
return $parent;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
Loading…
Add table
Add a link
Reference in a new issue