#!/usr/bin/env perl
#
# list, add, or remove Sakai users in/to/from sites
#
# $Id$

# based on ./sakai-list-courses.pl

# TO DO: factor this out into Perl modules with classes
# Sakai::SOAP::Session, Sakai::SOAP::Site, etc.

use strict;
use warnings;

# provided by Ubuntu package libsoap-lite-perl
use SOAP::Lite;
#use SOAP::Lite +trace => [ all ];

# for debugging only
use Data::Dumper;
$Data::Dumper::Indent = 1;

# provided by Ubuntu package libxml-libxml-perl
use XML::LibXML;
use XML::LibXML::XPathContext;

# provided by Ubuntu package libtext-csv-xs-perl
use Text::CSV_XS;

use Getopt::Std;

use open ':encoding(UTF-8)';    # support UTF-8 input and output
binmode( STDIN,  ':utf8' );
binmode( STDOUT, ':utf8' );
binmode( STDERR, ':utf8' );

my ($me) = $0 =~ m#([^/]*)$#;

my ( $user, $password, $server, $include_admin_workspace,
  $include_my_workspace, $use_glob, $sep, $quote, $careful, $verbose )
 = get_arguments();

my $xml_parser = get_xml_parser();

execute_requested_command();

exit(0);

#--- auxiliary functions ---#
#

#--- main() ---#
#

sub execute_requested_command
{
  if ( !@ARGV )
  {
    usage_error('supply a command to execute');
  }

  my ($session) = eval { login( $user, $password, $server ) }
   or die "$me: cannot login as $user to server $server: $@\n";

  # logout() in case we abort and never reach the logout() below:
  local $SIG{__DIE__} = sub { logout($session) if !$^S; };

  show_current_user( $session, $server, $user );

  my $args = join( ' ', @ARGV );

  if ( $args =~ /^list sites/ )
  {
    @ARGV < 4 or usage_error('list sites takes 0 or 1 arguments');
    list_sites( $session, @ARGV[ 2 .. $#ARGV ] );
  }
  elsif ( $args =~ /^list users/ )
  {
    @ARGV < 4 or usage_error('list users takes 0 or 1 arguments');
    list_users( $session, @ARGV[ 2 .. $#ARGV ] );
  }
  elsif ( $args =~ /^list sitemembers/ )
  {
    @ARGV < 4 or usage_error('list sitemembers takes 0 or 1 arguments');
    list_site_members( $session, @ARGV[ 2 .. $#ARGV ] );
  }
  elsif ( $args =~ /^list groups/ )
  {
    @ARGV < 4 or usage_error('list groups takes 0 or 1 arguments');
    list_groups( $session, @ARGV[ 2 .. $#ARGV ] );
  }
  elsif ( $args =~ /^list groupmembers/ )
  {
    @ARGV < 5 or usage_error('list groupmembers takes 0, 1 or 2 arguments');
    list_group_members( $session, @ARGV[ 2 .. $#ARGV ] );
  }
  elsif ( $args =~ /^list pages/ )
  {
    @ARGV < 5 or usage_error('list pages takes 0, 1 or 2 arguments');
    list_pages( $session, @ARGV[ 2 .. $#ARGV ] );
  }
  elsif ( $args =~ /^list/ )
  {
    usage_error(
"'list' must be followed by 'users', 'sitemembers', 'groups', or 'groupmembers'"
    );
  }
  elsif ( $args =~ /^add sitemember / )
  {
    @ARGV == 5 or usage_error('add sitemember takes 3 arguments');
    add_site_member( $session, @ARGV[ 2 .. $#ARGV ] );
  }
  elsif ( $args =~ /^remove sitemember / )
  {
    @ARGV == 4 or usage_error('remove sitemember takes 2 arguments');
    remove_site_member( $session, @ARGV[ 2 .. $#ARGV ] );
  }
  elsif ( $args =~ /^add groupmember / )
  {
    @ARGV == 6 or usage_error('add groupmember takes 4 arguments');
    add_group_member( $session, @ARGV[ 2 .. $#ARGV ] );
  }
  elsif ( $args =~ /^remove groupmember / )
  {
    @ARGV == 5 or usage_error('remove groupmember takes 3 arguments');
    remove_group_member( $session, @ARGV[ 2 .. $#ARGV ] );
  }
  elsif ( $args =~ /^(add|remove)/ )
  {
    usage_error(
      "'$1' must be followed by 'sitemember' or 'groupmember' and arguments");
  }
  else
  {
    usage_error('unrecognized command');
  }

  logout($session);
}

#-- usage information ---#
#

sub ehm
{
  warn "$me: ", join( ' ', @_ ), "\n";
}

sub ehm_v
{
  ehm(@_) if $verbose;
}

sub usage_error
{
  ehm( 'usage error:', @_ );
  die "$me: use -h for help\n";
}

sub HELP_MESSAGE
{
  ehm( @_, "\n" ) if @_;

  print STDERR <<ZZ;

Usage:

  $me [options] list sites
  $me [options] list users [username]
  $me [options] list sitemembers [sitename]
  $me [options] list groups [sitename]
  $me [options] list groupmembers [sitename] [groupname]
  $me [options] list pages [sitename] [pagename]
  $me [options] add sitemember rolename username sitename
  $me [options] remove sitemember username sitename
  $me [options] add groupmember rolename username sitename groupname
  $me [options] remove groupmember username sitename groupname

where

  list sites
    lists all sites.

  list users
    lists all users.

  list sitemembers
    lists all members of all sites,
    or of the named site, if a site name is supplied.

  list groups lists all groups of all sites,
    or of the named site, if a site name is supplied.

  list groupmembers
    lists all members of all groups in all sites,
    or all groups in the named sites, if a site name is supplied,
    or of the named group, if a group name is also supplied.

  list pages
    lists all pages of all sites,
    or all pages in the named sites, if a site name is supplied,
    or named that, if a page name is also supplied.

    Note: the output of this command may change in future versions.

  add sitemember
    adds the user to the named site if not present.

  remove sitemember
    removes the user from the named site if present.

  add groupmember
    adds the user to the named site group if not present.

  remove groupmember
    removes the user from the named group if present.

Options:

  -u user      The user to connect as; defaults to 'admin'.
  -p password  The password for that user.
  -H host      The hostname of the Sakai server.
  -P port      The port number to connect to.
  -N           Use http, not https.

  -g           Interpret wildcards in site name, group name,
               and user name arguments:
                 ?  stands for 1 arbitrary character
                 *  stands for 0 or more arbitrary characters
               Be careful when using this with add or remove.

  -c           Careful: check pre- and postconditions
               when asked to add or remove an item.
  -v           Issue some success and progress messages.

  Options to prevent accidental mistakes:

  -A           Even do it for the administrative workspace.
  -M           Even do it for the My Workspace sites.


  Options to control CSV output (for the 'list' commands):

  -t sep       Use sep as the column separator (default: ,).
  -q qte       Use qte as the quote character (default: ");
               use '' to not quote at all.

Environment variables:

  SAKAI_USER   The user to connect as if -u is not specified.
               Defaults to 'admin'.
  SAKAI_PASSWORD
              The password for that user if -p is not specified.
  SAKAI_HOST  The hostname of the Sakai server if -H is not specified.
  SAKAI_PORT  The port number to connect to if -P is not specified.
  SAKAI_PROTOCOL
              The protocol to use (http or https); -N can override this.

Note: to keep passwords out of your shell's history,
precede the command to set SAKAI_PASSWORD with a space
(see also bash's HISTCONTROL environment variable, which can be set to
ignorespace or ignoreboth, i.e. also ignores duplicate commands).

ZZ

  exit( !!@_ );
}

#--- command line processing ---#
#

sub get_arguments
{
  my %opt;
  getopts( 'AcghH:MNP:p:q:t:u:v', \%opt ) or die "Cannot parse command line\n";

  HELP_MESSAGE() if $opt{h};

  my $user     = $opt{u} // $ENV{SAKAI_USER} // 'admin';
  my $password = $opt{p} // $ENV{SAKAI_PASSWORD} // 'admin';
  my $host     = $opt{H} // $ENV{SAKAI_HOST}
   // 'qa11-mysql.nightly.sakaiproject.org';
  my $port = $opt{P} // $ENV{SAKAI_PORT} // ( $opt{N} ? 80 : 443 );
  my $http = $opt{N} ? 'http' : ( $ENV{SAKAI_PROTOCOL} // 'https' );
  my $server = "$http://$host:$port/";

  my $include_admin_workspace = $opt{A} // 0;
  my $include_my_workspace    = $opt{M} // 0;
  # I don't know a reliable way to verify these;
  # what we can do for now is check the site name, but it may be changed;
  # but I don't know how to check if is_user is set for a site,
  # nor do I know how to check if a site has an 'admin' role defined

  (
    $user,                 $password,
    $server,               $include_admin_workspace,
    $include_my_workspace, $opt{g} // 0,
    $opt{t},               $opt{q},
    $opt{c} // 0,          $opt{v} // $opt{w} // 0
  );
}

#--- call input construction (SOAP related functions): ---#
#

sub service
{
  my $proxy = $server . 'sakai-ws/soap/' . $_[0];

  my $ns_uri = 'http://webservices.sakaiproject.org/';

  SOAP::Lite->uri($ns_uri)->proxy($proxy)->on_action( sub { return '' } )
   or die "No SOAP login object for service $proxy\n";
}

sub method
{
  my $ns_uri = 'http://webservices.sakaiproject.org/';
  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 ) );
}

# Sakai's SOAP methods have two ways of returning a Boolean  ... sigh ...

sub sakai_soap_is_success
# converts 'success' or 'failure' to their boolean value
{
  my ( $method_name, $result ) = @_;

  if ( $result eq 'success' )
  {
    1;
  }
  elsif ( $result eq 'failure' )
  {
    0;
  }
  else
  {
    ehm("unexpected result from $method_name: $result");
    0;
  }
}

sub sakai_soap_is_true
# converts 'true' or 'false' to their boolean value
{
  my ( $method_name, $result ) = @_;

  if ( $result eq 'true' )
  {
    1;
  }
  elsif ( $result eq 'false' )
  {
    0;
  }
  else
  {
    ehm("unexpected result from $method_name: $result");
    0;
  }
}

#--- for deconstructing output (XML parsing and searching functions): ---#
#

sub get_xml_parser
# set $xml_parser = get_xml_parser() before calling xmldoc()
{
  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";
}

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 $xpath_context = new XML::LibXML::XPathContext;

  my @nodes = $xpath_context->findnodes(@_)->get_nodelist;
  wantarray() ? @nodes : $nodes[0];
}

#--- for CSV output ---#
#

my $csv_writer;

sub csv_print
{
  $csv_writer = csv_writer() if !$csv_writer;

  $csv_writer->print( *STDOUT, [@_] );
}

sub csv_writer
# depends on $sep and $quote having been set
{
  new Text::CSV_XS(
    {
      eol          => $/,
      'sep_char'   => ( $sep // ',' ),
      'quote_char' => ( $quote // '"' )
    }
  ) or die "cannot create CSV writer: $@\n";
}

#--- wrappers for some of Sakai's SOAP calls ---#
#

# to get an overview of the services type: (on a host that has access, like localhost)
# 	w3m https://qa11-mysql.nightly.sakaiproject.org/sakai-ws/
# 	w3m https://sakai2.win.tue.nl/sakai-ws/
# 	w3m https://future.update.eitdigital.eu/sakai-ws/
# 	w3m https://update.eitdigital.eu/sakai-ws/

sub login
# logs in, returning the session id and the server URL
# (there is also a 'login' method that only returns the session id)
{
  my ( $user, $password ) = @_;

  my $call = call(
    service('login'),
    'loginToServer',
    'id' => $user,
    'pw' => $password
  ) or die "Cannot log in as $user to site $server\n";

  my ( $session, $server_url ) = split( /,/, $call->result // '' );
}

sub logout
# logs out
{
  my ($session) = @_;

  #warn "logging out\n";

  my $call = call( service('login'), 'logout', 'sessionid' => $session )
   or die "Cannot log out\n";
}

sub show_current_user
{
  my ( $session, $server, $user ) = @_;

  my $call = call(
    service('sakai'),
    'getUserDisplayNameForCurrentUser',
    'sessionid' => $session
  ) or die "Cannot get display name for $user\n";

  $call->result
   or die "$me: cannot log in as $user to $server\n";

  ehm_v( "logged in to $server as $user", '(' . $call->result . ')' );
}

sub get_site_type
# given a site id, returns the site's type, if set,
# and if Sakai was patched to have getSiteType (we wrote that patch)
{
  my ( $session, $siteid ) = @_;

  my $call = call(
    service('sakai'), 'getSiteType',
    'sessionid' => $session,
    'siteid'    => $siteid
  ) or die "cannot get type of site $siteid\n";
  my $type = $call->result;
}

sub attributes
# given an XML::LibXML::Node, returns its attributes as a name->value hash
{
  my ($node) = @_;
  my %attr = map { $_->nodeName() => $_->nodeValue() } $node->attributes();
}

sub subelements
# given an XML::LibXML::Node, returns its subelements as a name->content hash
{
  my ($node) = @_;
  my @subelts =
   grep { $_->isa('XML::LibXML::Element') } $node->nonBlankChildNodes();
  my %elts = map { $_->nodeName() => $_->textContent() } @subelts;
}

#--- SOAP calls (or wrappers) on sites / users ---#
#

sub all_sites
# gets the sites as a hashref mapping site id to createdBy, createdTime and type
# excludes 'My Workspace' unless -M is specified
# excludes 'Administration Workspace' unless -A is specified
{
  my ($session) = @_;

  my $call = call( service('contenthosting'),
    'getAllSitesCollectionSize', 'sessionid' => $session );

  $call->result
   or die "$me: cannot cannot list sites for user $user\n";

  #print $call->result;
  # returns <list><site+ @createdBy @createdTime @id @title @type/></list>

  # --- print for each site : id, title, type (? on unpatched Sakais) --- #

  my %id2attr;

  foreach my $site ( xpath( '//list/site', xmldoc( $call->result ) ) )
  {
    my %attr = attributes($site);

    next if !$include_my_workspace && $attr{title} eq 'My Workspace';
    next
     if !$include_admin_workspace && $attr{title} eq 'Administration Workspace';

    $id2attr{ $attr{id} }->{createdBy}   = $attr{createdBy};
    $id2attr{ $attr{id} }->{createdTime} = $attr{createdTime};
    $id2attr{ $attr{id} }->{title}       = $attr{title};
    $id2attr{ $attr{id} }->{type}        = $attr{type} if $attr{type};
  }

  \%id2attr;
}

sub sites_with_title
# returns a hashref $siteid->$sitename
# for all sites matching $sitename;
# if $sitename is undef, all sites;
# if $use_glob is set, all sites matching $sitename;
# otherwise, all sites titled $sitename
{
  my ( $session, $sitename ) = @_;

  # we need the site id; I know of no clever way :-(
  # TO DO: use the method checkForSite()

  my %id2attr = %{ all_sites($session) };

  # filter sites by $sitename
  # return all sites if $sitename is undef!
  my @titles = map { $id2attr{$_}->{title} } keys %id2attr;
  my %match = map { $_ => 1 } argument_matches( $sitename, @titles );
  foreach my $id ( keys %id2attr )
  {
    if ( !$match{ $id2attr{$id}->{title} } )
    {
      delete $id2attr{$id};
    }
  }

  \%id2attr;
}

sub site_ids_with_title
# returns the sorted keys of sites_with_title( $session, $sitename )
{
  my ( $session, $sitename ) = @_;

  my %id2attr = %{ sites_with_title( $session, $sitename ) };

  sort { $id2attr{$a}->{title} cmp $id2attr{$b}->{title} } keys %id2attr;
}

sub all_users
{
  my ($session) = @_;

  my $call = call( service('sakai'), 'getAllUsers', 'sessionid' => $session );

  $call->result
   or die "$me: cannot cannot list users for user $user\n";

  #print $call->result;
  # returns <list><item+><userId/><eid/><displayName/><type/></item+></list>

  # eids are unique, we don't need userId
  my %eid2attr;

  foreach my $user ( xpath( '//list/item', xmldoc( $call->result ) ) )
  {
    my %attr = subelements($user);
    my $eid  = $attr{eid};

    $eid2attr{$eid}->{userId} = $attr{userId};
    # not that I need it, but just in case
    $eid2attr{$eid}->{displayName} = $attr{displayName};
    $eid2attr{$eid}->{type} = $attr{type} if $attr{type};
  }

  \%eid2attr;
}

sub users_with_eid
{
  my ( $session, $eid_arg ) = @_;

  my %eid2attr = %{ all_users($session) };

  # filter by $eid_arg (if provided)

  # filter eids by $eid_arg
  # return all eids if $eid_arg is undef!
  my %match = map { $_ => 1 } argument_matches( $eid_arg, keys(%eid2attr) );

  foreach my $eid ( keys %eid2attr )
  {
    if ( !$match{$eid} )
    {
      delete $eid2attr{$eid};
    }
  }

  \%eid2attr;
}

sub is_member_of_site
{
  my ( $session, $siteid, $eid ) = @_;

  my $call = call(
    service('sakai'),
    'checkForMemberInSite',
    'sessionid' => $session,
    'siteid'    => $siteid,
    eid         => $eid
  );
  my $result = $call->result
   or die "$me: cannot check for membership of user $eid\n";

  sakai_soap_is_true( 'checkForMemberInSite', $result );
}

sub site_members
# not used anymore
{
  # I can't find a method that will return a site's members;
  # work around this by passing an arrayref with all eids to check :-(
  # Yes, this is crazy.  It is also quite slow with thousands of users.

  my ( $session, $siteid, $eids ) = @_;

  grep { is_member_of_site( $session, $siteid, $_ ) } @$eids;
}

sub sites_for_user
# returns a mapping id => title for the sites the user is a member of
{
  my ( $session, $eid ) = @_;

  my $call = call(
    service('sakai'),
    'getAllSitesForUser',
    'sessionid' => $session,
    'userid'    => $eid
  );

  my $result = $call->result
   or die "$me: cannot check for membership of user $eid\n";
  #print "$result\n";
  # prints <list><item+><siteId/><siteTitle/></item></list>

  my %site_id2title;

  foreach my $site ( xpath( '//list/item', xmldoc( $call->result ) ) )
  {
    my %attr = subelements($site);
    next if !$include_my_workspace && $attr{siteTitle} eq 'My Workspace';
    next
     if !$include_admin_workspace
     && $attr{siteTitle} eq 'Administration Workspace';
    $site_id2title{ $attr{siteId} } = $attr{siteTitle};
  }

  \%site_id2title;
}

sub sites_for_user_with_title
# return sites_for_user( $session, $eid) filtered by $sitename
# return all sites if $sitename is undef!
{
  my ( $session, $eid, $sitename ) = @_;

  my %site_id2title = %{ sites_for_user( $session, $eid ) };

  # filter sites by $sitename
  my @titles = values(%site_id2title);
  my %match = map { $_ => 1 } argument_matches( $sitename, @titles );

  foreach my $id ( keys %site_id2title )
  {
    if ( !$match{ $site_id2title{$id} } )
    {
      delete $site_id2title{$id};
    }
  }

  \%site_id2title;
}

sub groups_for_site
# given a site id, returns the site's groups
{
  my ( $session, $siteid ) = @_;

  my $call = call(
    service('sakai'), 'getGroupsInSite',
    'sessionid' => $session,
    'siteid'    => $siteid
  ) or die "cannot get type of site $siteid\n";
  # print $call->result;
  # prints <list+><group><id/><title/><description/><properties><property+><propertyname/><propertyValue/></property+></properties></group></list+>

  my %group_id2title;

  foreach my $group ( xpath( '//list/group', xmldoc( $call->result ) ) )
  {
    my %attr = subelements($group);
    $group_id2title{ $attr{id} } = $attr{title};
  }

  \%group_id2title;
}

sub groups_for_site_with_title
{
  my ( $session, $siteid, $groupname ) = @_;

  my %group_id2title = %{ groups_for_site( $session, $siteid ) };

  # filter groups by $groupname
  my @groupnames = values(%group_id2title);
  my %match = map { $_ => 1 } argument_matches( $groupname, @groupnames );

  foreach my $id ( keys %group_id2title )
  {
    if ( !$match{ $group_id2title{$id} } )
    {
      delete $group_id2title{$id};
    }
  }

  \%group_id2title;
}

sub group_ids_for_site_with_title
{
  my %group_id2title = %{ groups_for_site_with_title(@_) };
  sort { $group_id2title{$a} cmp $group_id2title{$b} } keys %group_id2title;
}

sub pages_for_site
# given a site id, returns the site's pages
{
  my ( $session, $siteid ) = @_;

  my $call = call(
    service('lessons'), 'getPagesForSite',
    'sessionId' => $session,
    'siteId'    => $siteid
  ) or die "cannot get type of site $siteid\n";
  #print $call->result;
  # prints <pages><page*><pageId/><toolId><title/><siteId/><isHidden/><releaseDate/><gradebookPoint/><owner/><group/><contents><content*><id/><type/><sequence/><html/><attributes/></content*></contents></page*></pages>
  # Nov 7, 2018: crashes on the server end (yielding "") in case the HTML content of an item contains unsanitary characters (like a carriage return)
  my %page_id2attr;

  if ( $call->result )
   # not ""; assume it's XML
  {
    foreach my $page ( xpath( '//pages/page', xmldoc( $call->result ) ) )
    {
      my %attr = subelements($page);

      foreach my $attr (qw(toolId title siteId isHidden))
      {
        $page_id2attr{ $attr{pageId} }->{$attr} = $attr{$attr};
      }

      my @items = xpath( 'contents/content', $page );
      $page_id2attr{ $attr{pageId} }->{nrItems} = scalar(@items);
    }
  }

  \%page_id2attr;
}

sub pages_for_site_with_title
{
  my ( $session, $siteid, $pagename ) = @_;

  my %page_id2attr = %{ pages_for_site( $session, $siteid ) };

  foreach my $id ( keys %page_id2attr )
  {
    # filter pages by $pagename (if supplied)
    if ( !argument_matches( $pagename, $page_id2attr{$id}->{title} ) )
    {
      delete $page_id2attr{$id};
    }
  }

  \%page_id2attr;
}

sub page_ids_for_site_with_title
{
  my %page_id2title = %{ pages_for_site_with_title(@_) };
  sort { $page_id2title{$a} cmp $page_id2title{$b} } keys %page_id2title;
}

sub add_member_to_site_with_role
{
  my ( $session, $siteid, $eid, $roleid ) = @_;

  my $call = call(
    service('sakai'),
    'addMemberToSiteWithRole',
    'sessionid' => $session,
    'siteid'    => $siteid,
    'eid'       => $eid,
    'roleid'    => $roleid
  );

  my $result = $call->result
   or die "$me: cannot execute addMemberToSiteWithRole for user $eid\n";

  sakai_soap_is_success( 'addMemberToSiteWithRole', $result );
}

sub add_members_to_site_with_role
{
  my ( $session, $siteid, $eids, $roleid ) = @_;

  ref($eids) eq 'ARRAY'
   or
   die("bug: add_members_to_site_with_role() called with invalid argument\n");

  my $eids_j = join( ',', @$eids );

  my $call = call(
    service('sakai'),
    'addMemberToSiteWithRoleBatch',
    'sessionid' => $session,
    'siteid'    => $siteid,
    'eids'      => $eids_j,
    'roleid'    => $roleid
  );

  my $result = $call->result
   or die
   "$me: cannot execute addMemberToSiteWithRoleBatch for users $eids_j\n";

  sakai_soap_is_success( 'addMemberToSiteWithRoleBatch', $result );
}

sub remove_member_from_site
{
  my ( $session, $siteid, $eid ) = @_;

  my $call = call(
    service('sakai'),
    'removeMemberFromSite',
    'sessionid' => $session,
    'siteid'    => $siteid,
    'eid'       => $eid
  );

  my $result = $call->result
   or die "$me: cannot execute removeMemberFromSite for user $eid\n";

  sakai_soap_is_success( 'removeMemberFromSite', $result );
}

sub remove_members_from_site
{
  my ( $session, $siteid, $eids ) = @_;

  ref($eids) eq 'ARRAY'
   or die("bug: remove_members_from_site() called with invalid argument\n");

  my $eids_j = join( ',', @$eids );

  my $call = call(
    service('sakai'),
    'removeMemberFromSiteBatch',
    'sessionid' => $session,
    'siteid'    => $siteid,
    'eids'      => $eids_j
  );

  my $result = $call->result
   or die "$me: cannot execute removeMemberFromSiteBatch for users $eids_j\n";

  sakai_soap_is_success( 'removeMemberFromSiteBatch', $result );
}

#--- SOAP calls (or wrappers) on groups ---#
#

sub is_member_of_group
{
  my ( $session, $siteid, $groupid, $eid ) = @_;

  # users aren't members of groups, but of realms
  # whose ids combine the group id and site id

  my $realmid = realm_id_for_group_in_site( $groupid, $siteid );

  if ( !is_realm( $session, $realmid ) )
  {
    ehm("huh? cannot find realm for group $groupid in site $siteid");
    return 0;
  }

  is_member_of_realm( $session, $realmid, $eid );
}

sub users_in_group
{
  my ( $session, $siteid, $groupid ) = @_;

  my $realmid = realm_id_for_group_in_site( $groupid, $siteid );

  if ( !is_realm( $session, $realmid ) )
  {
    ehm("huh? cannot find realm for group $groupid in site $siteid");
    return ();
  }

  users_in_realm( $session, $realmid );
}

sub add_member_to_group
# unused; always claims to succeed, but always fails;
# catalina.out says: ERROR [ajp-nio-8309-exec-8] org.sakaiproject.webservices.SakaiScript.addMemberToGroup WS addMemberToGroup(): java.lang.IllegalArgumentException : addMember called with null role!
{
  my ( $session, $siteid, $groupid, $eid ) = @_;

  my $call = call(
    service('sakai'),
    'addMemberToGroup',
    'sessionid' => $session,
    'siteid'    => $siteid,
    'groupid'   => $groupid,
    'userid'    => $eid
  );
  # why does this exist while removeMemberFromGroup doesn't?

  my $result = $call->result
   or die "$me: cannot execute addMemberToGroup for user $eid\n";

  sakai_soap_is_true( 'addMemberToGroup', $result );
}

sub add_member_to_group_with_role
{
  my ( $session, $siteid, $groupid, $eid, $roleid ) = @_;

  my $realmid = realm_id_for_group_in_site( $groupid, $siteid );

  if ( !is_realm( $session, $realmid ) )
  {
    ehm("huh? cannot find realm for group $groupid in site $siteid");
    return 0;
  }

  add_member_to_realm_with_role( $session, $realmid, $eid, $roleid );
}

sub remove_member_from_group
{
  my ( $session, $siteid, $groupid, $eid ) = @_;

  my $realmid = realm_id_for_group_in_site( $groupid, $siteid );

  if ( !is_realm( $session, $realmid ) )
  {
    ehm("huh? cannot find realm for group $groupid in site $siteid");
    return 0;
  }

  remove_member_from_realm( $session, $realmid, $eid );
}

#--- SOAP calls on realms ---#
#

sub realm_id_for_group_in_site
{
  my ( $groupid, $siteid ) = @_;

  "/site/$siteid/group/$groupid";
}

sub is_realm
{
  my ( $session, $realmid ) = @_;

  my $call = call(
    service('sakai'),
    'checkForAuthzGroup',
    'sessionid'    => $session,
    'authzgroupid' => $realmid
  );
  my $result = $call->result
   or die "$me: cannot check existence of realm $realmid\n";

  sakai_soap_is_true( 'checkForAuthzGroup', $result );
}

sub is_member_of_realm
{
  my ( $session, $realmid, $eid ) = @_;

  my $call = call(
    service('sakai'),
    'checkForUserInAuthzGroup',
    'sessionid'    => $session,
    'authzgroupid' => $realmid,
    'eid'          => $eid
  );
  my $result = $call->result
   or die "$me: cannot check existence of user $eid in realm $realmid\n";
  #print "user $eid is in realm $realmid: $result\n";

  sakai_soap_is_true( 'checkForUserInAuthzGroup', $result );
}

sub users_in_realm
{
  my ( $session, $realmid ) = @_;

  my %eid2attr = %{ users_in_realm_with_roles( $session, $realmid ) };

  [ sort keys %eid2attr ];
}

sub users_in_realm_with_roles
{
  my ( $session, $realmid ) = @_;

  my %eid2attr;

  my $call = call(
    service('sakai'),
    'getUsersInAuthzGroup',
    'sessionid'    => $session,
    'authzgroupid' => $realmid
  );
  my $result = $call->result
   or die "$me: cannot get users in realm $realmid\n";
  # returns <list><user*><id/><name/><role/></user*></list>

  foreach my $user ( xpath( '//list/user', xmldoc( $call->result ) ) )
  {
    my %attr = subelements($user);
    my $eid  = $attr{id};

    $eid2attr{$eid}->{name} = $attr{name};
    $eid2attr{$eid}->{role} = $attr{role};
  }

  \%eid2attr;
}

sub users_with_role_in_realm
# not complete yet
{
  my ( $session, $roleids, $realmid ) = @_;

  my $call = call(
    service('sakai'),
    'getUsersInAuthzGroupWithRole',
    'sessionid'       => $session,
    'authzgroupid'    => $realmid,
    'authzgrouproles' => $roleids,
  );
  my $result = $call->result
   or die "$me: cannot get users with role(s) $roleids in realm $realmid\n";
  #print "$result\n";
}

sub add_member_to_realm_with_role
{
  my ( $session, $realmid, $eid, $roleid ) = @_;

  my $call = call(
    service('sakai'),
    'addMemberToAuthzGroupWithRole',
    'sessionid'    => $session,
    'authzgroupid' => $realmid,
    'eid'          => $eid,
    'roleid'       => $roleid
  );

  my $result = $call->result
   or die "$me: cannot execute addMemberToAuthzGroupWithRole for user $eid\n";

  sakai_soap_is_success( 'addMemberToAuthzGroupWithRole', $result );
}

sub remove_member_from_realm
{
  my ( $session, $realmid, $eid ) = @_;

  my $call = call(
    service('sakai'),
    'removeMemberFromAuthzGroup',
    'sessionid'    => $session,
    'eid'          => $eid,
    'authzgroupid' => $realmid
  );

  my $result = $call->result
   or die "$me: cannot execute removeMemberFromAuthzGroup for user $eid\n";

  sakai_soap_is_success( 'removeMemberFromAuthzGroup', $result );
}

#
#--- SOAP calls (or wrappers) ---#

#--- item selection based on argument values ---#
#

sub rx_for_glob
# produces a regex corresponding to the given glob expression
# we only support:
#   * (1 or more characters)
#   ? (1 character)
{
  my ($glob) = @_;

  # convert * to .* and ? to ., and add ^ and $,
  # while escaping any other regular expression metacharacters
  my @glob = split( /([?*])/, $glob );
  @glob = map { $_ eq '*' ? '.*' : $_ eq '?' ? '.' : quotemeta($_) } @glob;
  $glob = join( '', '^', @glob, '$' );

  qr/$glob/;
}

sub argument_matches
{
  my ( $argument, @items ) = @_;

  # returns the @items that match the $argument:
  # - if $argument is undef, all of them
  # - if $use_glob is set, those that match the glob
  # - otherwise, those equal to $argument

  if ( !defined $argument )
  {
    @items;
  }
  elsif ($use_glob)
  {
    my $rx = rx_for_glob($argument);
    grep { /$rx/ } @items;
  }
  else
  {
    grep { $_ eq $argument } @items;
  }
}

sub argument_mismatches
{
  my ( $argument, @items ) = @_;

  # returns the @items not in argument_matches($argument, $items)

  my %match = map { $_ => 1 } argument_matches( $argument, @items );

  grep { !defined $match{$_} } @items;
}

#
#--- item selection based on argument values ---#

#--- reporting functions using the SOAP calls and wrappers above ---#
#

sub list_sites
{
  my ( $session, $sitename ) = @_;

  my %id2attr = %{ sites_with_title( $session, $sitename ) };

  csv_print(qw(SITE_HYPHENATED SITE_TYPE SITE_ID SITE_NAME));

  # print the sites sorted by their titles
  foreach my $id (
    sort { $id2attr{$a}->{title} cmp $id2attr{$b}->{title} }
    keys %id2attr
   )
  {
    my %attr       = %{ $id2attr{$id} };
    my $type       = $attr{type} // '?';
    my $hyphenated = index( $id, '-' ) != -1 ? 'hyphenated' : 'unhyphenated';
    csv_print( $hyphenated, $type, $id, $attr{title} );
  }
}

sub list_users
{
  my ( $session, $eid_arg ) = @_;

  csv_print(qw(USER_EID USER_TYPE USER_NAME));

  my %eid2attr = %{ users_with_eid( $session, $eid_arg ) };

  # print the users sorted by their eids
  foreach my $eid ( sort keys %eid2attr )
  {
    my %attr = %{ $eid2attr{$eid} };
    my $type = $attr{type} // '?';
    csv_print( $eid, $type, $attr{displayName} );
  }
}

sub list_site_members
{
  my ( $session, $sitename ) = @_;

  # if $sitename is undef, list members of *all* sites
  # if $use_glob, interpret wildcards in $sitename

  csv_print(qw(USER_EID SITE_NAME));

  my %eid2attr = %{ all_users($session) };

  foreach my $eid ( sort keys %eid2attr )
  {
    my %id2title = %{ sites_for_user_with_title( $session, $eid, $sitename ) };

    my @siteids_by_title =
     sort { $id2title{$a} cmp $id2title{$b} } keys %id2title;

    foreach my $siteid (@siteids_by_title)
    {
      my $title = $id2title{$siteid};
      csv_print( $eid, $title );
    }
  }
}

sub list_groups
{
  my ( $session, $sitename ) = @_;

  # if $sitename is undef, list members of *all* sites
  # if $use_glob, interpret wildcards in $sitename

  my %id2attr = %{ sites_with_title( $session, $sitename ) };

  csv_print(qw(GROUP_NAME SITE_NAME));

  my @site_idsbytitle =
   sort { $id2attr{$a}->{title} cmp $id2attr{$b}->{title} } keys %id2attr;

  foreach my $siteid (@site_idsbytitle)
  {
    # list the groups in this site

    my %group_id2title = %{ groups_for_site( $session, $siteid ) };

    foreach my $groupname ( sort values %group_id2title )
    {
      csv_print( $groupname, $id2attr{$siteid}->{title} );
    }
  }
}

sub list_group_members
{
  my ( $session, $sitename, $groupname ) = @_;

  # if $sitename is undef, list members of *all* sites
  # if $use_glob, interpret wildcards in $sitename
  # if $use_glob, interpret wildcards in $groupname

  my %id2attr = %{ sites_with_title( $session, $sitename ) };

  csv_print(qw(USER_EID GROUP_NAME SITE_NAME));

  my @site_idsbytitle =
   sort { $id2attr{$a}->{title} cmp $id2attr{$b}->{title} } keys %id2attr;

  foreach my $siteid (@site_idsbytitle)
  {
    # list the groups in this site, filtered by $groupname (if any)

    my %group_id2title =
     %{ groups_for_site_with_title( $session, $siteid, $groupname ) };

    my @group_idsbytitle =
     sort { $group_id2title{$a} cmp $group_id2title{$b} } keys %group_id2title;

    foreach my $groupid (@group_idsbytitle)
    {
      my $groupname = $group_id2title{$groupid};

      foreach my $eid ( @{ users_in_group( $session, $siteid, $groupid ) } )
      {
        csv_print( $eid, $groupname, $id2attr{$siteid}->{title} );
      }
    }
  }
}

sub list_pages
{
  my ( $session, $sitename, $pagename ) = @_;

  # if $sitename is undef, list members of *all* sites
  # if $use_glob, interpret wildcards in $sitename
  # if $use_glob, interpret wildcards in $pagename

  my %id2attr = %{ sites_with_title( $session, $sitename ) };

  csv_print(qw(PAGE_ID TOOL_ID PAGE_NAME SITE_ID IS_HIDDEN NR_PAGES SITE_NAME));
  my @site_idsbytitle =
   sort { $id2attr{$a}->{title} cmp $id2attr{$b}->{title} } keys %id2attr;

  foreach my $siteid (@site_idsbytitle)
  {
    # list the pages in this site, filtered by $pagename (if any)

    my $sitename = $id2attr{$siteid}->{title};

    my %page_id2attr =
     %{ pages_for_site_with_title( $session, $siteid, $pagename ) };

    foreach my $pageid ( sort keys %page_id2attr )
    {
      my @attrs = qw(toolId title siteId isHidden nrItems);
      my @values = map { $page_id2attr{$pageid}->{$_} } @attrs;
      csv_print( @values, $sitename );
    }
  }
}

sub add_site_member
{
  my ( $session, $roleid, $eid_arg, $sitename ) = @_;

  # let's do some sanity checks

  if ( !defined $sitename )
  {
    usage_error(
      'with add sitemember, supply a rolename, user id, and site name');
  }

  if ( $roleid =~ /\W/ )
  {
    usage_error("doesn't look like a role name: $roleid");
  }

  if ( $eid_arg =~ /\s/ )
  {
    usage_error("doesn't look like a user id: $eid_arg");
  }

  my @eids =
   $use_glob
   ? sort keys( %{ users_with_eid( $session, $eid_arg ) } )
   : ($eid_arg);

  my %id2attr = %{ sites_with_title( $session, $sitename ) }
   or die "$me: no site found with name $sitename\n";
  my @siteids =
   sort { $id2attr{$a}->{title} cmp $id2attr{$b}->{title} } keys %id2attr;

  foreach my $siteid (@siteids)
  {
    my $sitename = $id2attr{$siteid}->{title};

    if ($careful)
    {
      my @eids_to_add = ();

      foreach my $eid (@eids)
      {
        if ( is_member_of_site( $session, $siteid, $eid ) )
        {
          ehm("$eid is already in $sitename");
        }
        else
        {
          push( @eids_to_add, $eid );
        }
      }

      @eids = @eids_to_add;
    }

    if ( !@eids )
    {
      # none left to add
      next;
    }

    add_members_to_site_with_role( $session, $siteid, [@eids], $roleid );

    if ( !$careful )
    {
      # don't verify the postcondition
      next;
    }

    foreach my $eid (@eids)
    {
      if ( !is_member_of_site( $session, $siteid, $eid ) )
      {
        ehm("$eid could not be added to $sitename");
      }
      else
      {
        ehm_v("added $eid to $sitename");
      }
    }
  }
}

sub remove_site_member
{
  my ( $session, $eid_arg, $sitename ) = @_;

  # let's do some sanity checks

  if ( !defined $sitename )
  {
    usage_error('with remove sitemember, supply a user id and site name');
  }

  if ( $eid_arg =~ /\s/ )
  {
    usage_error("doesn't look like a user id: $eid_arg");
  }

  my @eids =
   $use_glob
   ? sort keys( %{ users_with_eid( $session, $eid_arg ) } )
   : ($eid_arg);

  my %id2attr = %{ sites_with_title( $session, $sitename ) }
   or die "$me: no site found with name $sitename\n";
  my @siteids =
   sort { $id2attr{$a}->{title} cmp $id2attr{$b}->{title} } keys %id2attr;

  foreach my $siteid (@siteids)
  {
    my $sitename = $id2attr{$siteid}->{title};

    if ($careful)
    {
      my @eids_to_remove = ();

      foreach my $eid (@eids)
      {
        if ( !is_member_of_site( $session, $siteid, $eid ) )
        {
          ehm("$eid is not in $sitename");
        }
        else
        {
          push( @eids_to_remove, $eid );
        }
      }

      @eids = @eids_to_remove;
    }

    if ( !@eids )
    {
      # none left to remove
      next;
    }

    remove_members_from_site( $session, $siteid, [@eids] );

    if ( !$careful )
    {
      # don't verify the postcondition
      next;
    }

    foreach my $eid (@eids)
    {
      if ( is_member_of_site( $session, $siteid, $eid ) )
      {
        ehm("$eid could not be removed from $sitename");
      }
      else
      {
        ehm_v("removed $eid from $sitename");
      }
    }
  }
}

sub add_group_member
{
  my ( $session, $roleid, $eid_arg, $sitename, $groupname ) = @_;

  # let's do some sanity checks

  if ( !defined $sitename )
  {
    usage_error(
'with add groupmember, supply a role id, user id, site name, and group name'
    );
  }

  if ( $eid_arg =~ /\s/ )
  {
    usage_error("doesn't look like a user id: $eid_arg");
  }

  my @eids =
   $use_glob
   ? sort keys( %{ users_with_eid( $session, $eid_arg ) } )
   : ($eid_arg);

  my %id2attr = %{ sites_with_title( $session, $sitename ) }
   or die "$me: no site found with name $sitename\n";
  my @siteids =
   sort { $id2attr{$a}->{title} cmp $id2attr{$b}->{title} } keys %id2attr;

  foreach my $siteid (@siteids)
  {
    my $sitename = $id2attr{$siteid}->{title};

    foreach my $eid (@eids)
    {
      if ( $careful && !is_member_of_site( $session, $siteid, $eid ) )
      {
        ehm("$eid is not in site $sitename");
        next;
      }

      my @groupids =
       group_ids_for_site_with_title( $session, $siteid, $groupname )
       or die "no group named $groupname in site $siteid named $sitename\n";

      foreach my $groupid (@groupids)
      {
        if ( $careful
          && is_member_of_group( $session, $siteid, $groupid, $eid ) )
        {
          ehm("$eid is already in $groupname in $sitename");
        }
        else
        {
          add_member_to_group_with_role( $session, $siteid, $groupid, $eid,
            $roleid );

          if ( !$careful )
          {
            # don't verify the postcondition
          }
          elsif ( !is_member_of_group( $session, $siteid, $groupid, $eid ) )
          {
            ehm("$eid could not be added to $groupname in $sitename");
          }
          else
          {
            ehm_v("added $eid to $groupname in $sitename");
          }
        }
      }
    }
  }
}

sub remove_group_member
{
  my ( $session, $eid_arg, $sitename, $groupname ) = @_;

  # let's do some sanity checks

  if ( !defined $sitename )
  {
    usage_error(
      'with remove groupmember, supply a user id, site name, and group name');
  }

  if ( $eid_arg =~ /\s/ )
  {
    usage_error("doesn't look like a user id: $eid_arg");
  }

  my @eids =
   $use_glob
   ? sort keys( %{ users_with_eid( $session, $eid_arg ) } )
   : ($eid_arg);

  my %id2attr = %{ sites_with_title( $session, $sitename ) }
   or die "$me: no site found with name $sitename\n";
  my @siteids =
   sort { $id2attr{$a}->{title} cmp $id2attr{$b}->{title} } keys %id2attr;

  foreach my $siteid (@siteids)
  {
    my $sitename = $id2attr{$siteid}->{title};

    foreach my $eid (@eids)
    {
      if ( $careful && !is_member_of_site( $session, $siteid, $eid ) )
      {
        ehm_w("$eid is not in site $sitename");
        next;
      }

      my @groupids =
       group_ids_for_site_with_title( $session, $siteid, $groupname )
       or die "no group named $groupname in site $siteid named $sitename\n";

      foreach my $groupid (@groupids)
      {
        if ( $careful
          && !is_member_of_group( $session, $siteid, $groupid, $eid ) )
        {
          ehm_w("$eid is not in $groupname in $sitename");
        }
        else
        {
          remove_member_from_group( $session, $siteid, $groupid, $eid );

          if ( !$careful )
          {
            # don't verify the postcondition
          }
          elsif ( is_member_of_group( $session, $siteid, $groupid, $eid ) )
          {
            ehm("$eid could not be removed from $groupname in $sitename");
          }
          else
          {
            ehm_v("removed $eid from $groupname in $sitename");
          }
        }
      }
    }
  }
}