#!/usr/bin/env perl
#
# list Sakai assessments, using SOAP methods partly added by EDIA
#
# $Id$
# based on ./content-lists-test.pl
use strict;
use warnings;
use SOAP::Lite;
#use SOAP::Lite +trace => [ all ];
use Data::Dumper;
$Data::Dumper::Indent = 1;
use XML::LibXML;
use XML::LibXML::XPathContext;
use Getopt::Std;
use open ':std', ':encoding(UTF-8)'; # support UTF-8 output
#--- parameter specification: ---#
#
my %opt;
getopts( 'H:P:p:u:Nf:', \%opt ) or die "Cannot parse command line\n";
my $user = $opt{u} // $ENV{SAKAI_USER} // 'admin';
my $password = $opt{p} // $ENV{SAKAI_PASSWORD} // 'minda';
my $host = $opt{H} // $ENV{SAKAI_HOST} // 'sakai2.win.tue.nl';
my $port = $opt{P} // $ENV{SAKAI_PORT} // ( $opt{N} ? 80 : 443 );
my $http = $opt{N} ? 'http' : ( $ENV{SAKAI_PROTOCOL} // 'https' );
my $format = $opt{f} // $ENV{QTI_FORMAT} // 'QTI_1_2';
my @formats = qw(QTI_1_2 QTI_2_0 Markup);
grep { $format eq $_ } @formats
or die join( ' ', 'format must be one of:', @formats ), "\n";
my $server = "$http://$host:$port/";
my $ns_uri = 'http://webservices.sakaiproject.org/';
#--- call input construction: ---#
#
sub service
{
my $proxy = $server . 'sakai-ws/soap/' . $_[0];
SOAP::Lite->uri($ns_uri)->proxy($proxy)->on_action( sub { return '' } )
or die "No SOAP login object for service $proxy\n";
}
sub method
{
SOAP::Data->name( "ns1:" . $_[0] )->attr( { 'xmlns:ns1' => $ns_uri } );
}
sub soap_data_name
{
#warn sprintf("SOAP parameter: %s => %s\n", @_);
SOAP::Data->name(@_)->type('string') # assessmentIds are strings!
}
sub param
{
# feed the arguments pairwise to SOAP::Data->name()
map { soap_data_name( $_[$_], $_[ $_ + 1 ] ) }
grep { !( $_ % 2 ) } ( 0 .. $#_ );
}
sub call
{
my ( $service, $method, @params ) = @_;
$service->call( method($method), param(@params) )
or die sprintf( "failed call %s(%s)\n", $method, join( ', ', @params ) );
}
#--- for deconstructing output: ---#
#
my $xml_parser = new XML::LibXML(
line_numbers => 1,
load_ext_dtd => 0, # disables validation, says the documentation
no_blanks => 1,
clean_namespaces => 1,
no_network => 1,
pedantic_parser => 1
) or die "cannot create the XML parser\n";
my $xpath_context = new XML::LibXML::XPathContext;
sub xmldoc
{
my $doc = eval { $xml_parser->parse_string( $_[0] ) }
or die "cannot parse SOAP result: $@\n";
$doc->getDocumentElement;
}
sub xpath
{
ref( $_[1] ) and $_[1]->can('findnodes')
or die "bug: xpath() called with wrong argument(s)\n";
my @nodes = $xpath_context->findnodes(@_)->get_nodelist;
wantarray() ? @nodes : $nodes[0];
}
#--- here we go ---#
#
my $login_service = service('login');
#my $login = $login_service->loginToServer(id=>$user, pw=>$password)
my $login = call(
$login_service,
'loginToServer',
'id' => $user,
'pw' => $password
);
$login->result
or die "Cannot log in as $user to site $server\n";
my ( $session, $server_direct ) = split( /,/, $login->result )
or die "Cannot log in as $user to site $server\n";
warn "session is: $session\n";
# testing methods provided by
my $sakai_service = service('sakai');
my $getUDNFCU = call(
$sakai_service,
'getUserDisplayNameForCurrentUser',
'sessionid' => $session
) or die "Cannot get display name for $user\n";
warn "the current user is ", $getUDNFCU->result, "\n";
my $sites =
call( $sakai_service, 'getAllSitesForCurrentUser', 'sessionid' => $session );
#print $sites->result;
# returns - texttext
my %siteid2title;
foreach my $site ( xpath( '//list/item', xmldoc( $sites->result ) ) )
{
my ($id) = xpath( 'siteId', $site )->textContent;
my ($title) = xpath( 'siteTitle', $site )->textContent;
#warn "site $id has title $title\n";
$siteid2title{$id} = $title;
}
my %sitetitle2id = reverse(%siteid2title);
my $tnq_service = service('testsandquizzes');
my %site2assignments;
my @assmt_attrs = ( 'id', 'title', 'status' );
sub site2assessments
# given a site id,
# returns the list of its assessments, each as a hashref
{
my ($site_id) = @_;
my $assessments = call(
$tnq_service,
'listAssessmentsForSite',
'sessionId' => $session,
'siteId' => $site_id
);
#print $assessments->result, "\n";
# returns - numbertextTEXT
my @assmts;
foreach my $assmt ( xpath( '/list/item', xmldoc( $assessments->result ) ) )
{
my %attr;
foreach my $name (@assmt_attrs)
{
my $Name = $name =~ s/./\U$&/r;
$attr{$name} = xpath( "assessment$Name", $assmt )->textContent;
}
push( @assmts, {%attr} );
}
@assmts;
}
foreach my $name ( sort keys %sitetitle2id )
{
#next unless $name eq 'Feature demo';
#next unless $name eq "B. Koenig's playground";
my $site_id = $sitetitle2id{$name};
my @assmts = site2assessments($site_id);
warn sprintf( "%d assessments in site %s\n", scalar(@assmts), $name );
#warn join( ' ', 'with ids:', map { $_->{id} } @assmts ), "\n";
foreach my $assmt (@assmts)
{
my $id = $assmt->{id} // die "whoops, assessment without id!\n";
warn
sprintf( "assessment %s (%s) is %s\n", map { $assmt->{$_} } @assmt_attrs );
my $qti = call(
$tnq_service,
'exportAssessment',
'sessionId' => $session,
'assessmentId' => $id,
'format' => $format
) // die "cannot export assessment $id\n";
if ( $qti->fault )
{
warn "error calling exportAssessment($id):\n", $qti->faultstring, "\n";
}
else
{
print $qti->result;
}
}
}