External Policy Interface Perl

This is perl routine is written to implement a very simple extension to the TWiki platform that integrates with scrambls policy. To be granted access the wiki needs to have a topic named "ReaderXXXX" (X being some number) that has a meta attribute with an email address. If the email address given by scrambls is found in one of these topics we return true.

Putting aside the twiki related code, the key perl statements are:

my $response = CGI->new;
print $response->header("application/json");
print "{\"item\":\"$email\",\"inlist\":$inlist,\"cache\":0}";
return 0;

The full code of the extension follows.

#
# Copyright (C) Wave Systems 2012 - All rights reserved
# TWiki extension that adds scripts to demonstrate use of external policy server
#
package TWiki::Plugins::DemoScenariosPlugin;
use strict;
use vars qw( $VERSION $RELEASE $SHORTDESCRIPTION $debug $pluginName $NO_PREFS_IN_TOPIC );
use Date::Format;
use Time::Local;
require TWiki::Func;    # The plugins API
require TWiki::Plugins; # For the API version
$VERSION = '0.1';
$RELEASE = '0.1';
$SHORTDESCRIPTION = "script to support demo scenarios";
$NO_PREFS_IN_TOPIC = 1;
$pluginName = 'DemoScenariosPlugin';
#################################
# declares the tag handlers
#
sub initPlugin {
    my( $topic, $web, $user, $installWeb ) = @_;
    TWiki::Func::registerRESTHandler('inlist', \&RESTinlist);
    return 1;
}
sub RESTinlist {
   my ($session) = @_;
   my $query = TWiki::Func::getCgiQuery();
   my $email = $query->param('email');
   my $web = "Main";
   my @tops = TWiki::Func::getTopicList("Main");
   my $inlist = "false";
        # search for any topic named ReaderXXXX and get the email address meta field
   foreach my $topic (@tops) {
      if ($topic =~ m/Reader\d*/) {
         my ($meta, $text) = TWiki::Func::readTopic($web, $topic);
         my $topicEmail = $meta->get('FIELD','EmailAddress');
         if (defined($topicEmail) && $topicEmail->{'value'} eq $email) { $inlist = "true"; last; }
      }
   }
   my $response = CGI->new;
   print $response->header("application/json");
   print "{\"item\":\"$email\",\"inlist\":$inlist,\"cache\":0}";
   return 0;
}