File Coverage

blib/lib/Sakai/Nakamura/Content.pm

Criterion	Covered	Total	%
statement	101	224	45.0
branch	22	68	32.3
condition	0	3	0.0
subroutine	20	28	71.4
pod	10	15	66.6
total	153	338	45.2

#!/usr/bin/perl -w

package Sakai::Nakamura::Content;

use 5.008008;
use strict;
use warnings;
use Carp;
use JSON;
use Getopt::Long qw(:config bundling);
use Pod::Usage;
use Sakai::Nakamura;
use Sakai::Nakamura::Authn;
use Sakai::Nakamura::ContentUtil;

use base qw(Apache::Sling::Content);

require Exporter;

use base qw(Exporter);

our @EXPORT_OK = qw(run);

our $VERSION = '0.13';

#{{{sub new
sub new {
    my ( $class, @args ) = @_;
    my $content = $class->SUPER::new(@args);

    # Add a class variable to track the last content path seen:
    $content->{'Path'} = q{};

    # Add a class variable to track the last comment made:
    $content->{'Comment'} = q{};
    bless $content, $class;
    return $content;
}

#}}}

#{{{ sub command_line
sub command_line {
    my ( $class, @ARGV ) = @_;
    my $nakamura = Sakai::Nakamura->new;
    my $config   = $class->config( $nakamura, @ARGV );
    my $authn    = new Sakai::Nakamura::Authn( \$nakamura );
    return $class->run( $nakamura, $config );
}

#}}}

#{{{sub comment_add
sub comment_add {
    my ( $content, $comment, $remote_dest ) = @_;
    $remote_dest =
      defined $remote_dest
      ? Apache::Sling::URL::strip_leading_slash($remote_dest)
      : $content->{'Path'};

    my $res = Apache::Sling::Request::request(
        \$content,
        Sakai::Nakamura::ContentUtil::comment_add_setup(
            $content->{'BaseURL'}, $remote_dest, $comment
        )
    );
    my $success = Sakai::Nakamura::ContentUtil::comment_add_eval($res);
    my $message = (
        $success
        ? 'Comment added'
        : 'Problem adding comment to content'
    );
    $content->set_results( "$message", $res );
    return $success;
}

#}}}

#{{{sub config

sub config {
    my ( $class, $nakamura, @ARGV ) = @_;
    my $content_config = $class->config_hash( $nakamura, @ARGV );

    GetOptions(
        $content_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',              'additions|A=s',
        'copy|c',             'delete|d',
        'exists|e',           'filename|n=s',
        'local|l=s',          'move|m',
        'property|P=s',       'remote|r=s',
        'remote-source|S=s',  'replace|R',
        'view|V',             'view-copyright=s',
        'view-description=s', 'view-tags=s',
        'view-title=s',       'view-visibility=s'
    ) or $class->help();

    return $content_config;
}

#}}}

#{{{sub config_hash

sub config_hash {
    my ( $class, $nakamura, @ARGV ) = @_;
    my $view_copyright;
    my $view_description;
    my $view_tags;
    my $view_title;
    my $view_visibility;
    my $content_config = $class->SUPER::config_hash( $nakamura, @ARGV );
    $content_config->{'view-copyright'}   = \$view_copyright;
    $content_config->{'view-description'} = \$view_description;
    $content_config->{'view-tags'}        = \$view_tags;
    $content_config->{'view-title'}       = \$view_title;
    $content_config->{'view-visibility'}  = \$view_visibility;

    return $content_config;
}

#}}}

#{{{ 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 content to be uploaded.
 --add or -a                       - Add content.
 --auth (type)                     - Specify auth type. If ommitted, default is used.
 --copy or -c                      - Copy content.
 --delete or -d                    - Delete content.
 --filename or -n (filename)       - Specify file name to use for content upload.
 --help or -?                      - view the script synopsis and options.
 --local or -l (localPath)         - Local path to content to upload.
 --log or -L (log)                 - Log script output to specified log file.
 --man or -M                       - view the full script documentation.
 --move or -m                      - Move content.
 --pass or -p (password)           - Password of user performing content manipulations.
 --property or -P (property)       - Specify property to set on node.
 --remote or -r (remoteNode)       - specify remote destination under JCR root to act on.
 --remote-source or -S (remoteSrc) - specify remote source node under JCR root to act on.
 --replace or -R                   - when copying or moving, overwrite remote destination if it exists.
 --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 content manipulations as.
 --verbose or -v or -vv or -vvv    - Increase verbosity of output.
 --view or -V (actOnContent)       - view details for specified content in json format.
 --view-copyright (remoteNode)     - view copyright for specified remote content.
 --view-description (remoteNode)   - view description for specified remote content.
 --view-tags (remoteNode)          - view tags for specified remote content.
 --view-title (remoteNode)         - view title for specified remote content.
 --view-visibility (remoteNode)    - view visibility setting for specified remote content.

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 run
sub run {
    my ( $content, $nakamura, $config ) = @_;
    if ( !defined $config ) {
        croak 'No content config supplied!';
    }
    $nakamura->check_forks;
    ${ $config->{'remote'} } =
      Apache::Sling::URL::strip_leading_slash( ${ $config->{'remote'} } );
    ${ $config->{'remote-source'} } = Apache::Sling::URL::strip_leading_slash(
        ${ $config->{'remote-source'} } );
    my $authn =
      defined $nakamura->{'Authn'}
      ? ${ $nakamura->{'Authn'} }
      : new Sakai::Nakamura::Authn( \$nakamura );

    my $success = 1;

    if    ( $nakamura->{'Help'} ) { $content->help(); }
    elsif ( $nakamura->{'Man'} )  { $content->man(); }
    elsif ( defined ${ $config->{'additions'} } ) {
        my $message =
          "Adding content from file \"" . ${ $config->{'additions'} } . "\":\n";
        Apache::Sling::Print::print_with_lock( "$message", $nakamura->{'Log'} );
        my @childs = ();
        for my $i ( 0 .. $nakamura->{'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( $nakamura->{'Referer'} );
                $authn->login_user();
                my $content =
                  new Sakai::Nakamura::Content( \$authn, $nakamura->{'Verbose'},
                    $nakamura->{'Log'} );
                $content->upload_from_file( ${ $config->{'additions'} },
                    $i, $nakamura->{'Threads'} );
                exit 0;
            }
            else {
                croak "Could not fork $i!";
            }
        }
        foreach (@childs) { waitpid $_, 0; }
    }
    else {
        if ( defined ${ $config->{'local'} } ) {
            $authn->login_user();
            $content =
              new Sakai::Nakamura::Content( \$authn, $nakamura->{'Verbose'},
                $nakamura->{'Log'} );
            $success = $content->upload_file( ${ $config->{'local'} } );
            Apache::Sling::Print::print_result($content);
        }
        elsif ( defined ${ $config->{'view-copyright'} } ) {
            $authn->login_user();
            $content =
              new Sakai::Nakamura::Content( \$authn, $nakamura->{'Verbose'},
                $nakamura->{'Log'} );
            $success =
              $content->view_copyright( ${ $config->{'view-copyright'} } );
            Apache::Sling::Print::print_result($content);
        }
        elsif ( defined ${ $config->{'view-description'} } ) {
            $authn->login_user();
            $content =
              new Sakai::Nakamura::Content( \$authn, $nakamura->{'Verbose'},
                $nakamura->{'Log'} );
            $success =
              $content->view_description( ${ $config->{'view-description'} } );
            Apache::Sling::Print::print_result($content);
        }
        elsif ( defined ${ $config->{'view-tags'} } ) {
            $authn->login_user();
            $content =
              new Sakai::Nakamura::Content( \$authn, $nakamura->{'Verbose'},
                $nakamura->{'Log'} );
            $success = $content->view_tags( ${ $config->{'view-tags'} } );
            Apache::Sling::Print::print_result($content);
        }
        elsif ( defined ${ $config->{'view-title'} } ) {
            $authn->login_user();
            $content =
              new Sakai::Nakamura::Content( \$authn, $nakamura->{'Verbose'},
                $nakamura->{'Log'} );
            $success = $content->view_title( ${ $config->{'view-title'} } );
            Apache::Sling::Print::print_result($content);
        }
        elsif ( defined ${ $config->{'view-visibility'} } ) {
            $authn->login_user();
            $content =
              new Sakai::Nakamura::Content( \$authn, $nakamura->{'Verbose'},
                $nakamura->{'Log'} );
            $success =
              $content->view_visibility( ${ $config->{'view-visibility'} } );
            Apache::Sling::Print::print_result($content);
        }
        else {
            $success = $content->SUPER::run( $nakamura, $config );
        }
    }
    return $success;
}

#}}}

#{{{sub upload_file
sub upload_file {
    my ( $content, $local_path ) = @_;
    my $filename = q{};
    my $res      = Apache::Sling::Request::request(
        \$content,
        Apache::Sling::ContentUtil::upload_file_setup(
            $content->{'BaseURL'},    $local_path,
            'system/pool/createfile', $filename
        )
    );
    my $success = Apache::Sling::ContentUtil::upload_file_eval($res);

    # Check whether initial upload succeeded:
    if ( !$success ) {
        croak
          "Content: \"$local_path\" upload to /system/pool/createfile failed!";
    }

    # Obtain path from POST response body:
    my $content_path = ( ${$res}->content =~ m/"_path":"([^"]*)"/x )[0];
    if ( !defined $content_path ) {
        croak 'Content path not found in JSON response to file upload';
    }
    $content_path = "p/$content_path";
    my $content_filename =
      ( ${$res}->content =~ m/"sakai:pooled-content-file-name":"([^"]*)"/x )[0];
    if ( !$content_filename =~ /.*\..*/x ) {
        croak "Content filename: '$content_filename' has no file extension";
    }
    my $content_fileextension = ( $content_filename =~ m/([^.]+)$/x )[0];

    # Add Meta data for file:
    $res = Apache::Sling::Request::request(
        \$content,
        Sakai::Nakamura::ContentUtil::add_file_metadata_setup(
            $content->{'BaseURL'}, "$content_path",
            $content_filename,     $content_fileextension
        )
    );
    $success = Sakai::Nakamura::ContentUtil::add_file_metadata_eval($res);

    # Check whether adding metadata succeeded:
    if ( !$success ) {
        croak "Adding metadata for \"$content_path\" failed!";
    }

    # Add permissions on file:
    $res = Apache::Sling::Request::request(
        \$content,
        Sakai::Nakamura::ContentUtil::add_file_perms_setup(
            $content->{'BaseURL'}, "$content_path"
        )
    );
    $success = Sakai::Nakamura::ContentUtil::add_file_perms_eval($res);

    # Check whether setting file permissions succeeded:
    if ( !$success ) {
        croak "Adding file perms for \"$content_path\" failed!";
    }
    my $message =
      "File upload of \"$local_path\" to \"$content_path\" succeeded";
    $content->set_results( "$message", $res );
    $content->{'Path'} = $content_path;
    return $success;
}

#}}}

#{{{sub upload_from_file
sub upload_from_file {
    my ( $content, $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 $count = 0;
    if ( !defined $file ) {
        croak 'File to upload from not defined';
    }
    if ( open my ($input), '<', $file ) {
        while (<$input>) {
            if ( $fork_id == ( $count++ % $number_of_forks ) ) {
                chomp;
                $_ =~ /^\s*(\S.*?)\s*$/msx
                  or croak "/Problem parsing content to add: '$_'";
                my $local_path = $1;
                $content->upload_file($local_path);
                Apache::Sling::Print::print_result($content);
            }
        }
        close $input or croak 'Problem closing input!';
    }
    else {
        croak "Problem opening file: '$file'";
    }
    return 1;
}

#}}}

#{{{sub view_attribute
sub view_attribute {
    my ( $content, $remote_dest, $attribute_name, $nakamura_name, $missing_ok )
      = @_;
    $remote_dest =
      defined $remote_dest
      ? Apache::Sling::URL::strip_leading_slash($remote_dest)
      : $content->{'Path'};

    # By default the attribute must be present in the full JSON:
    $missing_ok = defined $missing_ok ? $missing_ok : 0;
    my $json_success = $content->view_full_json($remote_dest);
    if ( !$json_success ) {
        return $json_success;
    }
    my $content_json = from_json( $content->{'Message'} );
    my $attribute    = $content_json->{$nakamura_name};

    # merge an array attribute into a string:
    if ( ref($attribute) eq 'ARRAY' ) {
        $attribute = join( ',', @{$attribute} );
    }

    # If the attribute is undefined but allowed to be
    # missing then set it to an empty string:
    if ( !defined $attribute && $missing_ok ) {
        $attribute = q{};
    }
    my $success = defined $attribute;
    $content->{'Message'} =
      $success ? $attribute : "Problem viewing $attribute_name";
    return $success;
}

#}}}

#{{{sub view_copyright
sub view_copyright {
    my ( $content, $remote_dest ) = @_;
    my $success =
      $content->view_attribute( $remote_dest, 'copyright', 'sakai:copyright' );
    return $success;
}

#}}}

#{{{sub view_description
sub view_description {
    my ( $content, $remote_dest ) = @_;
    my $success = $content->view_attribute( $remote_dest, 'description',
        'sakai:description', 1 );
    return $success;
}

#}}}

#{{{sub view_tags
sub view_tags {
    my ( $content, $remote_dest ) = @_;
    my $success =
      $content->view_attribute( $remote_dest, 'tags', 'sakai:tags', 1 );
    return $success;
}

#}}}

#{{{sub view_title
sub view_title {
    my ( $content, $remote_dest ) = @_;
    my $success = $content->view_attribute( $remote_dest, 'title',
        'sakai:pooled-content-file-name' );
    return $success;
}

#}}}

#{{{sub view_visibility
sub view_visibility {
    my ( $content, $remote_dest ) = @_;
    my $success = $content->view_attribute( $remote_dest, 'visibility',
        'sakai:permissions' );
    return $success;
}

#}}}

1;

__END__