#!/usr/bin/perl -w

package Apache::Sling::GroupMember;

use 5.008001;
use strict;
use warnings;
use Carp;
use Getopt::Long qw(:config bundling);
use JSON;
use Text::CSV;
use Apache::Sling;
use Apache::Sling::GroupUtil;
use Apache::Sling::GroupMemberUtil;
use Apache::Sling::Print;
use Apache::Sling::Request;

require Exporter;

use base qw(Exporter);

our @EXPORT_OK = qw(command_line);

our $VERSION = '0.24';

#{{{sub new

sub new {
    my ( $class, $authn, $verbose, $log ) = @_;
    if ( !defined $authn ) { croak 'no authn provided!'; }
    my $response;
    $verbose = ( defined $verbose ? $verbose : 0 );
    my $group = {
        BaseURL  => ${$authn}->{'BaseURL'},
        Authn    => $authn,
        Message  => q{},
        Response => \$response,
        Verbose  => $verbose,
        Log      => $log
    };
    bless $group, $class;
    return $group;
}

#}}}

#{{{sub set_results
sub set_results {
    my ( $group, $message, $response ) = @_;
    $group->{'Message'}  = $message;
    $group->{'Response'} = $response;
    return 1;
}

#}}}

#{{{sub add
sub add {
    my ( $group, $act_on_group, $add_member ) = @_;
    my $res = Apache::Sling::Request::request(
        \$group,
        Apache::Sling::GroupMemberUtil::add_setup(
            $group->{'BaseURL'}, $act_on_group, $add_member
        )
    );
    my $success = Apache::Sling::GroupMemberUtil::add_eval($res);
    my $message = "\"$add_member\" ";
    $message .= ( $success ? 'added' : 'was not added' );
    $message .= " to group \"$act_on_group\"!";
    $group->set_results( "$message", $res );
    return $success;
}

#}}}

#{{{sub add_from_file
sub add_from_file {
    my ( $group, $file, $fork_id, $number_of_forks ) = @_;
    $fork_id         = defined $fork_id         ? $fork_id         : 0;
    $number_of_forks = defined $number_of_forks ? $number_of_forks : 1;
    my $csv               = Text::CSV->new();
    my $count             = 0;
    my $number_of_columns = 0;
    my @column_headings;
    if ( !defined $file ) {
        croak 'File to upload from not defined';
    }
    if ( open my ($input), '<', $file ) {
        while (<$input>) {
            if ( $count++ == 0 ) {

                # Parse file column headings first to determine field names:
                if ( $csv->parse($_) ) {
                    @column_headings = $csv->fields();

                    # First field must be group:
                    if ( $column_headings[0] !~ /^[Gg][Rr][Oo][Uu][Pp]$/msx ) {
                        croak 'First CSV column must be the group ID, '
                          . 'column heading must be "group". '
                          . 'Found: "'
                          . $column_headings[0] . "\".\n";
                    }

                    # Second field must be user:
                    if ( $column_headings[1] !~ /^[Uu][Ss][Ee][Rr]$/msx ) {
                        croak 'Second CSV column must be the user ID, '
                          . 'column heading must be "user". '
                          . 'Found: "'
                          . $column_headings[1] . "\".\n";
                    }
                    $number_of_columns = @column_headings;
                }
                else {
                    croak 'CSV broken, failed to parse line: '
                      . $csv->error_input;
                }
            }
            elsif ( $fork_id == ( $count++ % $number_of_forks ) ) {
                if ( $csv->parse($_) ) {
                    my @columns      = $csv->fields();
                    my $columns_size = @columns;

           # Check row has same number of columns as there were column headings:
                    if ( $columns_size != $number_of_columns ) {
                        croak
"Found \"$columns_size\" columns. There should have been \"$number_of_columns\".\n"
                          . "Row contents was: $_";
                    }
                    my $act_on_group = $columns[0];
                    my $add_member   = $columns[1];
                    $group->add( $act_on_group, $add_member );
                    Apache::Sling::Print::print_result($group);
                }
                else {
                    croak 'CSV broken, failed to parse line: '
                      . $csv->error_input;
                }
            }
        }
        close $input or croak q{Problem closing input!};
    }
    else {
        croak "Problem opening file: '$file'";
    }
    return 1;
}

#}}}

#{{{ sub command_line
sub command_line {
    my @ARGV = @_;

    #options parsing
    my $sling  = Apache::Sling->new;
    my $config = config($sling);

    GetOptions(
        $config,      'auth=s',     'help|?',      'log|L=s',
        'man|M',      'pass|p=s',   'threads|t=s', 'url|U=s',
        'user|u=s',   'verbose|v+', 'add|a=s',     'additions|A=s',
        'delete|d=s', 'exists|e=s', 'group|g=s',   'view|V'
    ) or help();

    if ( $sling->{'Help'} ) { help(); }
    if ( $sling->{'Man'} )  { man(); }

    return run( $sling, $config );
}

#}}}

#{{{sub config

sub config {
    my ($sling) = @_;
    my $additions;
    my $add;
    my $delete;
    my $exists;
    my $group;
    my $view;

    my %group_member_config = (
        'auth'      => \$sling->{'Auth'},
        'help'      => \$sling->{'Help'},
        'log'       => \$sling->{'Log'},
        'man'       => \$sling->{'Man'},
        'pass'      => \$sling->{'Pass'},
        'threads'   => \$sling->{'Threads'},
        'url'       => \$sling->{'URL'},
        'user'      => \$sling->{'User'},
        'verbose'   => \$sling->{'Verbose'},
        'add'       => \$add,
        'additions' => \$additions,
        'delete'    => \$delete,
        'exists'    => \$exists,
        'group'     => \$group,
        'view'      => \$view
    );

    return \%group_member_config;
}

#}}}

#{{{sub check_exists
sub check_exists {
    my ( $group, $act_on_group, $exists_member ) = @_;
    my $res = Apache::Sling::Request::request(
        \$group,
        Apache::Sling::GroupUtil::view_setup(
            $group->{'BaseURL'}, $act_on_group
        )
    );
    my $success = Apache::Sling::GroupUtil::view_eval($res);
    my $message;
    if ($success) {
        my $group_info = from_json( ${$res}->content );
        my $is_member  = 0;
        foreach my $member ( @{ $group_info->{'members'} } ) {
            if (   $member eq "/system/userManager/user/$exists_member"
                || $member eq "/system/userManager/group/$exists_member"
                || $member eq "$exists_member" )
            {
                $is_member = 1;
                last;
            }
        }
        $success = $is_member;
        $message =
            "\"$exists_member\" is "
          . ( $is_member ? q{} : 'not ' )
          . "in group \"$act_on_group\"";
    }
    else {
        $message = "Problem viewing group: \"$act_on_group\"";
    }
    $group->set_results( "$message", $res );
    return $success;
}

#}}}

#{{{sub delete
sub delete {
    my ( $group, $act_on_group, $delete_member ) = @_;
    my $res = Apache::Sling::Request::request(
        \$group,
        Apache::Sling::GroupMemberUtil::delete_setup(
            $group->{'BaseURL'}, $act_on_group, $delete_member
        )
    );
    my $success = Apache::Sling::GroupMemberUtil::delete_eval($res);
    my $message = "\"$delete_member\" ";
    $message .= ( $success ? 'deleted' : 'was not deleted' );
    $message .= " from group \"$act_on_group\"!";
    $group->set_results( "$message", $res );
    return $success;
}

#}}}

#{{{ sub help
sub help {

    print <<"EOF";
Usage: perl $0 [-OPTIONS [-MORE_OPTIONS]] [--] [PROGRAM_ARG1 ...]
The following options are accepted:

 --additions or -A (file)       - file containing list of members to be added to groups.
 --add or -a (member)           - add specified member.
 --auth (type)                  - Specify auth type. If ommitted, default is used.
 --delete or -d (member)        - delete specified group member.
 --exists or -e (member)        - check whether specified member exists in group.
 --group or -g (actOnGroup)     - group to perform membership actions on.
 --help or -?                   - view the script synopsis and options.
 --log or -L (log)              - Log script output to specified log file.
 --man or -M                    - view the full script documentation.
 --pass or -p (password)        - Password of user performing actions.
 --threads or -t (threads)      - Used with -A, defines number of parallel
                                  processes to have running through file.
 --url or -U (URL)              - URL for system being tested against.
 --user or -u (username)        - Name of user to perform any actions as.
 --verbose or -v or -vv or -vvv - Increase verbosity of output.
 --view or -V                   - view members of specified group.

Options may be merged together. -- stops processing of options.
Space is not required between options and their arguments.
For full details run: perl $0 --man
EOF

    return 1;
}

#}}}

#{{{ sub man
sub man {

    print <<'EOF';
group membership perl script. Provides a means of managing membership of groups
in sling from the command line.

EOF

    help();

    print <<"EOF";
Example Usage

* Authenticate and add a member testuser to the group with id g-test:

 perl $0 -U http://localhost:8080 -g g-test -u admin -p admin -a testuser

* Authenticate and view members of group with id g-test:

 perl $0 -U http://localhost:8080 -g g-test -u admin -p admin -V

* Authenticate and check whether testuser is a member of group with id g-test:

 perl $0 -U http://localhost:8080 -g g-test -u admin -p admin -e testuser 

* Authenticate and remove testuser from being a member of group with id g-test with very verbose output:

 perl $0 -U http://localhost:8080 -g g-test -u admin -p admin -d testuser -vv

EOF

    return 1;
}

#}}}

#{{{sub run
sub run {
    my ( $sling, $config ) = @_;
    if ( !defined $config ) {
        croak 'No group_member config supplied!';
    }
    $sling->check_forks;
    my $authn =
      defined $sling->{'Authn'}
      ? ${ $sling->{'Authn'} }
      : new Apache::Sling::Authn( \$sling );

    my $success = 1;

    if ( defined ${ $config->{'additions'} } ) {
        my $message =
          "Adding groups from file \"" . ${ $config->{'additions'} } . "\":\n";
        Apache::Sling::Print::print_with_lock( "$message", $sling->{'Log'} );
        my @childs = ();
        for my $i ( 0 .. $sling->{'Threads'} ) {
            my $pid = fork;
            if ($pid) { push @childs, $pid; }    # parent
            elsif ( $pid == 0 ) {                # child
                    # Create a new separate user agent per fork in order to
                    # ensure cookie stores are separate, then log the user in:
                $authn->{'LWP'} = $authn->user_agent( $sling->{'Referer'} );
                $authn->login_user();
                my $group_member =
                  new Apache::Sling::GroupMember( \$authn, $sling->{'Verbose'},
                    $sling->{'Log'} );
                $group_member->add_from_file( ${ $config->{'additions'} },
                    $i, $sling->{'Threads'} );
                exit 0;
            }
            else {
                croak "Could not fork $i!";
            }
        }
        foreach (@childs) { waitpid $_, 0; }
    }
    else {
        $authn->login_user();
        my $group_member =
          new Apache::Sling::GroupMember( \$authn, $sling->{'Verbose'},
            $sling->{'Log'} );
        if ( defined ${ $config->{'exists'} } ) {
            $success = $group_member->check_exists( ${ $config->{'group'} },
                ${ $config->{'exists'} } );
        }
        elsif ( defined ${ $config->{'add'} } ) {
            $success = $group_member->add( ${ $config->{'group'} },
                ${ $config->{'add'} } );
        }
        elsif ( defined ${ $config->{'delete'} } ) {
            $success = $group_member->delete( ${ $config->{'group'} },
                ${ $config->{'delete'} } );
        }
        elsif ( defined ${ $config->{'view'} } ) {
            $success = $group_member->view( ${ $config->{'group'} } );
        }
        else {
            help();
            return 1;
        }
        Apache::Sling::Print::print_result($group_member);
    }
    return $success;
}

#}}}

#{{{sub view
sub view {
    my ( $group, $act_on_group ) = @_;
    my $res = Apache::Sling::Request::request(
        \$group,
        Apache::Sling::GroupUtil::view_setup(
            $group->{'BaseURL'}, $act_on_group
        )
    );
    my $success = Apache::Sling::GroupUtil::view_eval($res);
    my $message;
    if ($success) {
        my $group_info     = from_json( ${$res}->content );
        my $number_members = @{ $group_info->{'members'} };
        my $members = "$number_members result(s) for group \"$act_on_group\":";
        foreach my $member ( @{ $group_info->{'members'} } ) {
            $members .= "\n$member";
        }
        $message = "$members";
        $success = $number_members;
    }
    else {

        # HTTP request did not complete successfully!
        $message = "Problem viewing group: \"$act_on_group\"";
    }
    $group->set_results( "$message", $res );
    return $success;
}

#}}}

1;

__END__

=head1 NAME

Apache::Sling::Group - Manipulate Groups in an Apache Sling instance.

=head1 ABSTRACT

group related functionality for Sling implemented over rest APIs.

=head1 METHODS

=head2 new

Create, set up, and return a Group Object.

=head2 set_results

Set a suitable message and response for the group object.

=head2 add

Add a member to a group.

=head2 add_from_file

Add members to groups based on entries in a file.

=head2 config

Fetch hash of group membership configuration.

=head2 delete

Delete member from a group.

=head2 exists

Check whether a member exists in a group.

=head2 run

Run group membership related actions.

=head2 view

View members of a group.

=head1 USAGE

use Apache::Sling::Group;

=head1 DESCRIPTION

Perl library providing a layer of abstraction to the REST group methods

=head1 REQUIRED ARGUMENTS

None required.

=head1 OPTIONS

n/a

=head1 DIAGNOSTICS

n/a

=head1 EXIT STATUS

0 on success.

=head1 CONFIGURATION

None required.

=head1 DEPENDENCIES

=head1 INCOMPATIBILITIES

None known.

=head1 BUGS AND LIMITATIONS

None known.

=head1 AUTHOR

Daniel David Parry <perl@ddp.me.uk>

=head1 LICENSE AND COPYRIGHT

LICENSE: http://dev.perl.org/licenses/artistic.html

COPYRIGHT: (c) 2011 Daniel David Parry <perl@ddp.me.uk>
