Apache-Sling
view release on metacpan or search on metacpan
0.16 Sat Sep 3 14:00:00 2011
- Adding authz functionality.
0.15 Wed Jul 13 13:00:00 2011
- Adding support for setting referrer header on the
LWP User Agent. This is required for Sakai Nakamura.
0.14 Sat Jul 2 07:45:00 2011
- Fixing bug with newline, tab handling - thanks to
Daniel Burckhardt for the bug report and patch.
- Improved handling of filename variable for file upload.
- Tweaked required version of external dependency to an
earlier supported version.
0.13 Tue Oct 12 10:45:00 2010
- Pulling functionality from user scripts into Sling.pm.
- Fixing bugs with user / group additions from file.
0.12 Sat Aug 14 11:35:00 2010
- Adding external tests.
- Fixing bugs in group membership.
lib/Apache/Sling/Content.pm view on Meta::CPAN
#}}}
#{{{ 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.
lib/Apache/Sling/Content.pm view on Meta::CPAN
return 1;
}
#}}}
#{{{ sub man
sub man {
my ($content) = @_;
print <<'EOF';
content perl script. Provides a means of uploading content into sling from the
command line. The script also acts as a reference implementation for the
Content perl library.
EOF
$content->help();
print <<"EOF";
Example Usage
lib/Apache/Sling/Content.pm view on Meta::CPAN
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 $content =
Apache::Sling::Content->new( \$authn, $sling->{'Verbose'},
$sling->{'Log'} );
$content->upload_from_file( ${ $config->{'additions'} },
$i, $sling->{'Threads'} );
exit 0;
}
else {
croak "Could not fork $i!";
}
}
foreach (@childs) { waitpid $_, 0; }
}
else {
$authn->login_user();
if ( defined ${ $config->{'local'} }
&& defined ${ $config->{'remote'} } )
{
$content =
Apache::Sling::Content->new( \$authn, $sling->{'Verbose'},
$sling->{'Log'} );
$success = $content->upload_file(
${ $config->{'local'} },
${ $config->{'remote'} },
${ $config->{'filename'} }
);
}
elsif ( defined ${ $config->{'exists'} } ) {
$content =
Apache::Sling::Content->new( \$authn, $sling->{'Verbose'},
$sling->{'Log'} );
$success = $content->check_exists( ${ $config->{'remote'} } );
lib/Apache/Sling/Content.pm view on Meta::CPAN
$content->help();
return 1;
}
Apache::Sling::Print::print_result($content);
}
return $success;
}
#}}}
#{{{sub upload_file
sub upload_file {
my ( $content, $local_path, $remote_path, $filename ) = @_;
$filename = defined $filename ? $filename : q{};
my $res = Apache::Sling::Request::request(
\$content,
Apache::Sling::ContentUtil::upload_file_setup(
$content->{'BaseURL'}, $local_path, $remote_path, $filename
)
);
my $success = Apache::Sling::ContentUtil::upload_file_eval($res);
my $basename = $local_path;
$basename =~ s/^(.*\/)([^\/]*)$/$2/msx;
my $remote_dest =
$remote_path . ( $filename ne q{} ? "/$filename" : "/$basename" );
my $message = "Content: \"$local_path\" upload to \"$remote_dest\" ";
$message .= ( $success ? 'succeeded!' : 'failed!' );
$content->set_results( "$message", $res );
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.*?)$/msx
or croak 'Problem parsing content to add';
my $local_path = $1;
my $remote_path = $2;
$content->upload_file( $local_path, $remote_path, q{} );
Apache::Sling::Print::print_result($content);
}
}
close $input or croak 'Problem closing input!';
}
else {
croak "Problem opening file: '$file'";
}
return 1;
}
lib/Apache/Sling/Content.pm view on Meta::CPAN
Delete content.
=head2 move
Move location of content in the system.
=head2 run
Run content related actions.
=head2 upload_file
Upload a file into the system.
=head2 upload_from_file
Upload new content to the system based on definitions in a file.
=head2 view
View content details.
=head2 view_file
View content.
lib/Apache/Sling/ContentUtil.pm view on Meta::CPAN
#{{{sub move_eval
sub move_eval {
my ($res) = @_;
return ( ${$res}->code =~ /^20(0|1)$/msx );
}
#}}}
#{{{sub upload_file_setup
sub upload_file_setup {
my ( $base_url, $local_path, $remote_dest, $filename ) = @_;
if ( !defined $base_url ) {
croak 'No base URL provided to upload against!';
}
if ( !defined $local_path ) { croak 'No local file to upload defined!'; }
if ( !defined $remote_dest ) {
croak "No remote path to upload to defined for file $local_path!";
}
if ( $filename eq q{} ) { $filename = './*'; }
my $post_variables = '$post_variables = []';
return
"fileupload $base_url/$remote_dest $filename $local_path $post_variables";
}
#}}}
#{{{sub upload_file_eval
sub upload_file_eval {
my ($res) = @_;
return ( ${$res}->code =~ /^20(0|1)$/msx );
}
#}}}
1;
__END__
lib/Apache/Sling/ContentUtil.pm view on Meta::CPAN
Returns a textual representation of the request needed to move content within
the system.
=head2 move_eval
Inspects the result returned from issuing the request generated in move_setup
returning true if the result indicates the content was moved successfully,
else false.
=head2 upload_file_setup
Returns a textual representation of the request needed to upload a file to the system.
=head2 upload_file_eval
Check result of system upload_file.
=head1 REQUIRED ARGUMENTS
None required.
=head1 OPTIONS
n/a
=head1 DIAGNOSTICS
lib/Apache/Sling/Group.pm view on Meta::CPAN
#{{{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:
lib/Apache/Sling/GroupMember.pm view on Meta::CPAN
#{{{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:
lib/Apache/Sling/LDAPSynch.pm view on Meta::CPAN
my ( $tmp_cache_file_handle, $tmp_cache_file_name ) =
File::Temp::tempfile();
my %synch_cache;
print {$tmp_cache_file_handle}
Data::Dumper->Dump( [ \%synch_cache ], [qw( synch_cache )] )
or croak q(Unable to print initial data dump of synch cache to file!);
close $tmp_cache_file_handle
or croak
q(Problem closing temporary file handle when initializing synch cache);
${ $class->{'Content'} }
->upload_file( $tmp_cache_file_name, $class->{'CachePath'},
$class->{'CacheFile'} )
or croak q(Unable to initialize LDAP synch cache file!);
unlink $tmp_cache_file_name
or croak
q(Problem clearing up temporary file after init of synch cache!);
}
return 1;
}
#}}}
lib/Apache/Sling/LDAPSynch.pm view on Meta::CPAN
my ( $class, $synch_cache ) = @_;
my ( $tmp_cache_file_handle, $tmp_cache_file_name ) =
File::Temp::tempfile();
print {$tmp_cache_file_handle}
Data::Dumper->Dump( [$synch_cache], [qw( synch_cache )] )
or croak q(Unable to print data dump of synch cache to file!);
close $tmp_cache_file_handle
or croak
q(Problem closing temporary file handle when updating synch cache);
${ $class->{'Content'} }
->upload_file( $tmp_cache_file_name, $class->{'CachePath'},
$class->{'CacheFile'} )
or croak q(Unable to update LDAP synch cache file!);
my $time = time;
${ $class->{'Content'} }
->upload_file( $tmp_cache_file_name, $class->{'CacheBackupPath'},
"cache$time.txt" )
or croak q(Unable to create LDAP synch cache backup file!);
unlink $tmp_cache_file_name
or croak
q(Problem clearing up temporary file after updating synch cache!);
return 1;
}
#}}}
lib/Apache/Sling/LDAPSynch.pm view on Meta::CPAN
my ( $class, $synch_user_list ) = @_;
my ( $tmp_user_list_file_handle, $tmp_user_list_file_name ) =
File::Temp::tempfile();
print {$tmp_user_list_file_handle}
Data::Dumper->Dump( [$synch_user_list], [qw( synch_user_list )] )
or croak q(Unable to print data dump of synch user list to file!);
close $tmp_user_list_file_handle
or croak
q(Problem closing temporary file handle when writing synch user list);
${ $class->{'Content'} }
->upload_file( $tmp_user_list_file_name, $class->{'CachePath'},
$class->{'UserList'} )
or croak
q(Unable to upload LDAP synch user list file into sling instance!);
Apache::Sling::Print::print_result( ${ $class->{'Content'} } );
my $time = time;
${ $class->{'Content'} }
->upload_file( $tmp_user_list_file_name, $class->{'CacheBackupPath'},
"user_list$time.txt" )
or croak q(Unable to create LDAP synch user list backup file!);
unlink $tmp_user_list_file_name
or croak
q(Problem clearing up temporary file after updating synch user list!);
return 1;
}
#}}}
lib/Apache/Sling/LDAPSynch.pm view on Meta::CPAN
croak q(Could not open file to download synchronized user list to!);
}
}
$class->{'Message'} =
"Successfully downloaded user list to $user_list_file!";
return 1;
}
#}}}
#{{{sub upload_synch_user_list
sub upload_synch_user_list {
my ( $class, $user_list_file ) = @_;
my %user_list_hash;
if ( open my ($input), '<', $user_list_file ) {
while (<$input>) {
chomp;
$user_list_hash{$_} = 1;
}
close $input or croak q(Problem closing upload user list file handle!);
}
else {
croak q(Unable to open synch user list file to parse for upload!);
}
$class->update_synch_user_list( \%user_list_hash );
$class->{'Message'} =
q(Successfully uploaded user list for use in subsequent synchronizations!);
return 1;
}
#}}}
#{{{sub parse_attributes
sub parse_attributes {
my ( $ldap_attrs, $sling_attrs, $ldap_attrs_array, $sling_attrs_array ) =
@_;
lib/Apache/Sling/LDAPSynch.pm view on Meta::CPAN
'help|?', 'log|L=s',
'man|M', 'pass|p=s',
'threads|t=s', 'url|U=s',
'user|u=s', 'verbose|v+',
'download-user-list', 'ldap-attributes|a=s',
'ldap-base|b=s', 'ldap-dn|d=s',
'ldap-filter|f=s', 'ldap-host|h=s',
'ldap-pass|P=s', 'attributes|A=s',
'synch-full|s', 'synch-full-since|S=s',
'synch-listed|l', 'synch-listed-since',
'upload-user-list'
) or $ldap_synch->help();
return $ldap_synch_config;
}
#}}}
#{{{sub config_hash
sub config_hash {
lib/Apache/Sling/LDAPSynch.pm view on Meta::CPAN
my $ldap_attributes;
my $ldap_base;
my $ldap_dn;
my $ldap_filter;
my $ldap_host;
my $ldap_pass;
my $synch_full;
my $synch_full_since;
my $synch_listed;
my $synch_listed_since;
my $upload_user_list;
my %ldap_synch_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'},
lib/Apache/Sling/LDAPSynch.pm view on Meta::CPAN
'ldap-attributes' => $ldap_attributes,
'ldap-base' => $ldap_base,
'ldap-dn' => $ldap_dn,
'ldap-filter' => $ldap_filter,
'ldap-host' => $ldap_host,
'ldap-pass' => $ldap_pass,
'synch-full' => $synch_full,
'synch-full-since' => $synch_full_since,
'synch-listed' => $synch_listed,
'synch-listed-since' => $synch_listed_since,
'upload-user-list' => $upload_user_list
);
return \%ldap_synch_config;
}
#}}}
#{{{ sub help
sub help {
lib/Apache/Sling/LDAPSynch.pm view on Meta::CPAN
--ldap-filter or -F (filter) - Specify ldap attribute to search for users with.
--ldap-host or -H (host) - Specify ldap host to synchronize from.
--ldap-pass or -P (pass) - Specify ldap pass for authentication.
--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.
--synch-full or -s - Perform a full synchronization from ldap to sling.
--synch-full-since or -S (since) - Perform a full synchronization from ldap to sling using changes since specified time.
--synch-listed or -l - Perform a sychronization of listed users from ldap to sling.
--synch-listed-since (since) - Perform a sychronization of listed users from ldap to sling using changes since specified time.
--upload-user-list (userList) - Upload user list specified by file userList.
--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.
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;
lib/Apache/Sling/LDAPSynch.pm view on Meta::CPAN
EOF
$ldap_synch->help();
print <<"EOF";
Example Usage
* Upload a restricted list of users (one id per line of specified file) to use in synchronizations:
perl $0 --upload-user-list user_list.txt --sling-host http://localhost:8080 --sling-user admin --sling-pass admin
* Download a previously specified list of users to be synchronized to a specified file:
perl $0 --download-user-list user_list.txt --sling-host http://localhost:8080 --sling-user admin --sling-pass admin
* Authenticate and perform a full synchronization:
perl $0 -s -h ldap://ldap.org -b "ou=people,o=ldap,dc=org" -H http://localhost:8080 -u admin -P admin -a "displayname,mail,sn" -A "name,email,surname"
EOF
lib/Apache/Sling/LDAPSynch.pm view on Meta::CPAN
${ $config->{'ldap-dn'} },
${ $config->{'ldap-pass'} },
\$authn,
${ $config->{'flag-disabled'} },
$sling->{'Verbose'},
$sling->{'Log'}
);
$success = $ldap_synch->download_synch_user_list(
${ $config->{'download-user-list'} } );
}
elsif ( defined ${ $config->{'upload-user-list'} } ) {
$ldap_synch = new Apache::Sling::LDAPSynch(
${ $config->{'ldap-host'} },
${ $config->{'ldap-base'} },
${ $config->{'ldap-filter'} },
${ $config->{'ldap-dn'} },
${ $config->{'ldap-pass'} },
\$authn,
${ $config->{'flag-disabled'} },
$sling->{'Verbose'},
$sling->{'Log'}
);
$success = $ldap_synch->upload_synch_user_list(
${ $config->{'upload-user-list'} } );
}
elsif ( defined ${ $config->{'synch-full'} } ) {
$ldap_synch = new Apache::Sling::LDAPSynch(
${ $config->{'ldap-host'} },
${ $config->{'ldap-base'} },
${ $config->{'ldap-filter'} },
${ $config->{'ldap-dn'} },
${ $config->{'ldap-pass'} },
\$authn,
${ $config->{'flag-disabled'} },
lib/Apache/Sling/LDAPSynch.pm view on Meta::CPAN
Fetch the synchronization user list file.
=head2 update_synch_user_list
Update the synchronization user_list file with the latest state.
=head2 download_synch_user_list
Download the current synchronization user list file.
=head2 upload_synch_user_list
Upload a list of users to be synchronized into the sling system.
=head2 parse_attributes
Read the given ldap and sling attributes into two separate specified arrays.
Check that the length of the arrays match.
=head2 check_for_property_modifications
lib/Apache/Sling/Request.pm view on Meta::CPAN
my $variables = join q{ }, @req_variables;
my $post_variables;
my $success = eval $variables;
if ( !defined $success ) {
croak "Error parsing post variables: \"$variables\"";
}
$request = POST( "$target", $post_variables );
}
if ( $action eq 'data' ) {
# multi-part form upload
my $variables = join q{ }, @req_variables;
my $post_variables;
my $success = eval $variables;
if ( !defined $success ) {
croak "Error parsing post variables: \"$variables\"";
}
$request =
POST( "$target", $post_variables, 'Content_Type' => 'form-data' );
}
if ( $action eq 'fileupload' ) {
# multi-part form upload with the file name and file specified
my $filename = shift @req_variables;
my $file = shift @req_variables;
my $variables = join q{ }, @req_variables;
my $post_variables;
my $success = eval $variables;
if ( !defined $success ) {
croak "Error parsing post variables: \"$variables\"";
}
push @{$post_variables}, $filename => ["$file"];
lib/Apache/Sling/User.pm view on Meta::CPAN
#{{{sub add_from_file
sub add_from_file {
my ( $user, $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 site:
t/External/Apache-Sling-Content.t view on Meta::CPAN
$content = Apache::Sling::Content->new( \$authn, $verbose, $log );
isa_ok $content, 'Apache::Sling::Content', 'content';
my ( $tmp_content_handle, $tmp_content_name ) = File::Temp::tempfile();
my $tmp_content_basename = basename $tmp_content_name;
print {$tmp_content_handle} "Test file\n";
# You need to flush the tmp content handle to actually write data
# out to the file on disk:
close $tmp_content_handle;
my $test_path = "content_test_path_$$";
ok( ! $content->upload_file($tmp_content_name,".."), 'Check upload_file function fails with remote path that is not allowed' );
ok( $content->upload_file($tmp_content_name,$test_path), 'Check upload_file function' );
ok( ! $content->view("$test_path/this_file_does_not_exist"), 'Check view function with non-existent file' );
ok( $content->view("$test_path/$tmp_content_basename"), 'Check view function' );
ok( $content->view_file("$test_path/$tmp_content_basename"), 'Check view file function' );
ok( ! $content->view_file("$test_path/this_file_does_not_exist"), 'Check view file function with non-existent file' );
throws_ok{ $content->view_file()} qr{No file to view specified!}, 'Check view_file function croaks with a missing remote path';
ok( $content->view_full_json("$test_path/$tmp_content_basename"), 'Check view_full_json function' );
ok( ! $content->view_full_json("$test_path/this_file_does_not_exist"), 'Check view_full_json function with non-existent file' );
throws_ok{ $content->view_full_json()} qr{No file to view specified!}, 'Check view_full_json function croaks with a missing remote path';
ok( $content->upload_file($tmp_content_name,$test_path,$test_content1), 'Check upload_file function with filename specified' );
ok( $content->view("$test_path/$test_content1"), 'Check view function on named file' );
ok( $content->view_file("$test_path/$test_content1"), 'Check view file function on named file' );
my $upload = "$tmp_content_name\n";
throws_ok{ $content->upload_from_file(\$upload)} qr{Problem parsing content to add}, 'Check upload_file function croaks with a missing remote path';
$upload = "$tmp_content_name,$test_content1\n";
ok( $content->upload_from_file(\$upload,0,1), 'Check upload_from_file function' );
my ( $tmp_content2_handle, $tmp_content2_name ) = File::Temp::tempfile();
$upload .= "$tmp_content2_name,$test_content2\n";
ok( $content->upload_from_file(\$upload,1,2), 'Check upload_from_file function with two forks' );
unlink($tmp_content_name);
unlink($tmp_content2_name);
throws_ok{ $content->upload_from_file($tmp_content_name,0,1)} qr{Problem opening file: '$tmp_content_name'}, 'Check upload_file function croaks with a missing file';
# Add content item to manipulate:
ok( my $content_config = Apache::Sling::Content->config($sling), 'check content_config function' );
$content_config->{'add'} = \$test_content1;
$content_config->{'remote'} = \$test_content1;
ok( Apache::Sling::Content->run($sling,$content_config), q{check content_run function adding content $test_content1} );
# Test content additions from file:
my ( $tmp_content_additions_handle, $tmp_content_additions_name ) = File::Temp::tempfile();
ok( $content_config = Apache::Sling::Content->config($sling), 'check content_config function' );
t/External/Apache-Sling-Content.t view on Meta::CPAN
$content_config->{'remote-source'} = \$test_content1;
$content_config->{'remote'} = \$test_content2;
ok( ! Apache::Sling::Content->run($sling,$content_config), q{check content_run function copying content $test_content1 to $test_content2} );
ok( $content_config = Apache::Sling::Content->config($sling), 'check content_config function' );
$content_config->{'move'} = \1;
$content_config->{'remote-source'} = \$test_content2;
$content_config->{'remote'} = \$test_content3;
ok( Apache::Sling::Content->run($sling,$content_config), q{check content_run function moving content $test_content2 to $test_content1} );
# Test uploading file:
( $tmp_content_handle, $tmp_content_name ) = File::Temp::tempfile();
ok( $content_config = Apache::Sling::Content->config($sling), 'check content_config function' );
$content_config->{'local'} = \$tmp_content_name;
ok( Apache::Sling::Content->run($sling,$content_config), q{check content_run function with only local defined} );
$content_config->{'remote'} = \$test_content2;
ok( Apache::Sling::Content->run($sling,$content_config), q{check content_run function uploading content $tmp_content_name to $test_content2} );
# Cleanup content:
unlink($tmp_content_name);
ok( $content_config = Apache::Sling::Content->config($sling), 'check content_config function' );
$content_config->{'delete'} = \1;
$content_config->{'remote'} = \$test_content1;
ok( Apache::Sling::Content->run($sling,$content_config), q{check content_run function deleting content $test_content1} );
$content_config->{'remote'} = \$test_content2;
ok( Apache::Sling::Content->run($sling,$content_config), q{check content_run function deleting content $test_content2} );
$content_config->{'remote'} = \$test_content3;
t/External/Apache-Sling-Group.t view on Meta::CPAN
"Group Test: adding group that already exists fails." );
# Add test user:
ok( $user->add( $test_user, $test_pass, \@test_properties ),
"Group Test: User \"$test_user\" added successfully." );
ok( $user->check_exists( $test_user ),
"Group Test: User \"$test_user\" exists." );
# Testing group addition from file
# test group name:
my $test_upload_group1 = "group_test_upload_group_1_$$";
my $test_upload_group2 = "group_test_upload_group_2_$$";
my $test_upload_group3 = "group_test_upload_group_3_$$";
my $test_upload_group4 = "group_test_upload_group_4_$$";
my $upload = "group\n$test_upload_group1";
ok( $group->add_from_file(\$upload,0,1), 'Check add_from_file function' );
$upload = "group\n$test_upload_group2\n$test_upload_group3\n$test_upload_group4";
ok( $group->add_from_file(\$upload,0,3), 'Check add_from_file function with three forks' );
$upload = "bad_heading\n$test_upload_group1";
throws_ok{ $group->add_from_file(\$upload,0,1); } qr%First CSV column must be the group ID, column heading must be "group". Found: "bad_heading".%, 'Check add_from_file function with bad heading';
$upload = "group\n$test_upload_group1,bad_extra_column";
throws_ok{ $group->add_from_file(\$upload,0,1); } qr%Found "2" columns. There should have been "1".%, 'Check add_from_file function with heading / data count mismatch';
$upload = "group,property\n$test_upload_group2,test";
ok( $group->add_from_file(\$upload,0,1), 'Check add_from_file function with extra property specified' );
# Cleanup Users:
ok( $user->del( $test_user ),
"Group Test: User \"$test_user\" deleted successfully." );
ok( ! $user->check_exists( $test_user ),
"Group Test: User \"$test_user\" no longer exists." );
# Cleanup Groups:
ok( $group->del( $test_group1 ),
"Group Test: Group \"$test_group1\" deleted successfully." );
ok( $group->del( $test_group2 ),
"Group Test: Group \"$test_group2\" deleted successfully." );
ok( $group->del( $test_group3 ),
"Group Test: Group \"$test_group3\" deleted successfully." );
ok( $group->del( $test_upload_group1 ),
"User Test: User \"$test_upload_group1\" deleted successfully." );
ok( $group->del( $test_upload_group2 ),
"User Test: User \"$test_upload_group2\" deleted successfully." );
ok( ! $group->del( $test_upload_group3 ),
"User Test: Deleting non-existent group fails." );
ok( $group->del( $test_upload_group4 ),
"User Test: User \"$test_upload_group4\" deleted successfully." );
ok( ! $group->check_exists( $test_group1 ),
"Group Test: Group \"$test_group1\" should no longer exist." );
ok( ! $group->check_exists( $test_group2 ),
"Group Test: Group \"$test_group2\" should no longer exist." );
ok( ! $group->check_exists( $test_group3 ),
"Group Test: Group \"$test_group3\" should no longer exist." );
ok( ! $group->check_exists( $test_upload_group1 ),
"User Test: User \"$test_upload_group1\" should no longer exist." );
ok( ! $group->check_exists( $test_upload_group2 ),
"User Test: User \"$test_upload_group2\" should no longer exist." );
ok( ! $group->check_exists( $test_upload_group4 ),
"User Test: User \"$test_upload_group4\" should no longer exist." );
# group object:
$group = Apache::Sling::Group->new( \$authn, $verbose, $log );
isa_ok $group, 'Apache::Sling::Group', 'group';
# add group:
ok( my $group_config = Apache::Sling::Group->config($sling), 'check group_config function' );
$group_config->{'add'} = \$test_group1;
ok( Apache::Sling::Group->run($sling,$group_config), q{check group_run function add for $test_group1} );
t/External/Apache-Sling-GroupMember.t view on Meta::CPAN
"Group Test: Member \"$test_user\" added to \"$test_group1\"." );
ok( $group_member->check_exists( $test_group1, $test_user ),
"Group Test: Member \"$test_user\" exists in \"$test_group1\"." );
ok( $group_member->view( $test_group1 ) == 1,
"Group Test: 1 Member in \"$test_group1\"." );
ok( ! $group_member->add( "non-existent-$test_group1", $test_user ),
"Group Test: Unable to add member to non-existent group" );
# Test group member additions from file:
my $test_upload_user1 = "user_test_upload_user_1_$$";
my $test_upload_user2 = "user_test_upload_user_2_$$";
my $test_upload_user3 = "user_test_upload_user_3_$$";
my $test_upload_user4 = "user_test_upload_user_4_$$";
ok( $user->add( $test_upload_user1, $test_pass, \@test_properties ),
"Group Test: User \"$test_upload_user1\" added successfully." );
ok( $user->add( $test_upload_user2, $test_pass, \@test_properties ),
"Group Test: User \"$test_upload_user2\" added successfully." );
ok( $user->add( $test_upload_user3, $test_pass, \@test_properties ),
"Group Test: User \"$test_upload_user3\" added successfully." );
ok( $user->add( $test_upload_user4, $test_pass, \@test_properties ),
"Group Test: User \"$test_upload_user4\" added successfully." );
ok( $user->check_exists( $test_upload_user1 ),
"Group Test: User \"$test_upload_user1\" exists." );
ok( $user->check_exists( $test_upload_user2 ),
"Group Test: User \"$test_upload_user2\" exists." );
ok( $user->check_exists( $test_upload_user3 ),
"Group Test: User \"$test_upload_user3\" exists." );
ok( $user->check_exists( $test_upload_user4 ),
"Group Test: User \"$test_upload_user4\" exists." );
my $upload = "group,user\n$test_group3,$test_upload_user1";
ok( $group_member->add_from_file(\$upload,0,1), 'Check member add_from_file function' );
$upload = "group,user\n$test_group3,$test_upload_user2\n$test_group3,$test_upload_user3\n$test_group3,$test_upload_user4";
ok( $group_member->add_from_file(\$upload,0,3), 'Check member add_from_file function with three forks' );
$upload = "group,bad_heading\n$test_group3,$test_upload_user1";
throws_ok{ $group_member->add_from_file(\$upload,0,1); } qr%Second CSV column must be the user ID, column heading must be "user". Found: "bad_heading".%, 'Check member add_from_file function with bad second heading';
$upload = "group,user\n$test_group3,$test_upload_user1,bad_extra_column";
throws_ok{ $group_member->add_from_file(\$upload,0,1); } qr%Found "3" columns. There should have been "2".%, 'Check member add_from_file function with heading / data count mismatch';
$upload = "group,user,property\n$test_group3,$test_upload_user2,test";
ok( $group_member->add_from_file(\$upload,0,1), 'Check member add_from_file function with extra property specified' );
ok( ! $group_member->view( "non-existent-$test_group1" ),
"Group Test: Test for members in non-existent group." );
ok( ! $group_member->check_exists( "non-existent-$test_group1", $test_user ),
"Group Test: Test member exists in non-existent group." );
ok( $group_member->add( $test_group2, $test_user ),
"Group Test: Member \"$test_user\" added to \"$test_group2\"." );
ok( $group_member->check_exists( $test_group2, $test_user ),
"Group Test: Member \"$test_user\" exists in \"$test_group2\"." );
t/External/Apache-Sling-GroupMember.t view on Meta::CPAN
$group_member_config->{'delete'} = \$test_user;
$group_member_config->{'group'} = \$test_group1;
ok( Apache::Sling::GroupMember->run($sling,$group_member_config), q{check group_member_run function delete for $test_group1} );
# Cleanup Users:
ok( $user->del( $test_user ),
"Group Test: User \"$test_user\" deleted successfully." );
ok( ! $user->check_exists( $test_user ),
"Group Test: User \"$test_user\" no longer exists." );
ok( $user->del( $test_upload_user1, $test_pass, \@test_properties ),
"Group Test: User \"$test_upload_user1\" deleted successfully." );
ok( $user->del( $test_upload_user2, $test_pass, \@test_properties ),
"Group Test: User \"$test_upload_user2\" deleted successfully." );
ok( $user->del( $test_upload_user3, $test_pass, \@test_properties ),
"Group Test: User \"$test_upload_user3\" deleted successfully." );
ok( $user->del( $test_upload_user4, $test_pass, \@test_properties ),
"Group Test: User \"$test_upload_user4\" deleted successfully." );
ok( ! $user->check_exists( $test_upload_user1 ),
"Group Test: User \"$test_upload_user1\" no longer exists." );
ok( ! $user->check_exists( $test_upload_user2 ),
"Group Test: User \"$test_upload_user2\" no longer exists." );
ok( ! $user->check_exists( $test_upload_user3 ),
"Group Test: User \"$test_upload_user3\" no longer exists." );
ok( ! $user->check_exists( $test_upload_user4 ),
"Group Test: User \"$test_upload_user4\" no longer exists." );
# Cleanup Groups:
ok( $group->del( $test_group1 ),
"Group Test: Group \"$test_group1\" deleted successfully." );
ok( $group->del( $test_group2 ),
"Group Test: Group \"$test_group2\" deleted successfully." );
ok( $group->del( $test_group3 ),
"Group Test: Group \"$test_group3\" deleted successfully." );
ok( ! $group->check_exists( $test_group1 ),
"Group Test: Group \"$test_group1\" should no longer exist." );
t/External/Apache-Sling-User.t view on Meta::CPAN
"User Test: Successfully switched to user: \"$super_user\" with basic auth" );
# Testing view for user:
ok( $user->view( $test_user ),
"User Test: User \"$test_user\" viewed successfully." );
ok( ! $user->view( "non-existent-$test_user" ),
"User Test: non-existent user not viewed successfully." );
# Testing user addition from file
# test user name:
my $test_upload_user1 = "user_test_upload_user_1_$$";
my $test_upload_user2 = "user_test_upload_user_2_$$";
my $test_upload_user3 = "user_test_upload_user_3_$$";
my $test_upload_user4 = "user_test_upload_user_4_$$";
my $upload = "user,password\n$test_upload_user1,$test_pass";
ok( $user->add_from_file(\$upload,0,1), 'Check add_from_file function' );
$upload = "user,password\n$test_upload_user2,$test_pass\n$test_upload_user3,$test_pass\n$test_upload_user4,$test_pass";
ok( $user->add_from_file(\$upload,0,3), 'Check add_from_file function with three forks' );
$upload = "user,bad_heading\n$test_upload_user1,$test_pass";
throws_ok{ $user->add_from_file(\$upload,0,1); } qr%Second CSV column must be the user password, column heading must be "password". Found: "bad_heading".%, 'Check add_from_file function with bad second heading';
$upload = "user,password\n$test_upload_user1,$test_pass,bad_extra_column";
throws_ok{ $user->add_from_file(\$upload,0,1); } qr%Found "3" columns. There should have been "2".%, 'Check add_from_file function with heading / data count mismatch';
$upload = "user,password,property\n$test_upload_user2,$test_pass,test";
ok( $user->add_from_file(\$upload,0,1), 'Check add_from_file function with extra property specified' );
# Check user deletion:
ok( ! $user->del( "non-existent-$test_user" ),
"User Test: non-existent user not deleted successfully." );
ok( $user->del( $test_user ),
"User Test: User \"$test_user\" deleted successfully." );
ok( $user->del( $test_upload_user1 ),
"User Test: User \"$test_upload_user1\" deleted successfully." );
ok( $user->del( $test_upload_user2 ),
"User Test: User \"$test_upload_user2\" deleted successfully." );
ok( $user->del( $test_upload_user4 ),
"User Test: User \"$test_upload_user4\" deleted successfully." );
ok( ! $user->check_exists( $test_user ),
"User Test: User \"$test_user\" should no longer exist." );
ok( ! $user->check_exists( $test_upload_user1 ),
"User Test: User \"$test_upload_user1\" should no longer exist." );
ok( ! $user->check_exists( $test_upload_user2 ),
"User Test: User \"$test_upload_user2\" should no longer exist." );
ok( ! $user->check_exists( $test_upload_user4 ),
"User Test: User \"$test_upload_user4\" should no longer exist." );
# user object:
$user = Apache::Sling::User->new( \$authn, $verbose, $log );
isa_ok $user, 'Apache::Sling::User', 'user';
# add user:
ok( my $user_config = Apache::Sling::User->config($sling), 'check user_config function' );
$user_config->{'add'} = \$test_user;
$user_config->{'email'} = \"test\@example.com";
t/Local/Apache-Sling-Content.t view on Meta::CPAN
ok( defined $content->{ 'Response' }, 'Check response defined' );
$content->set_results( 'Test Message', undef );
ok( $content->{ 'Message' } eq 'Test Message', 'Message now set' );
ok( ! defined $content->{ 'Response' }, 'Check response no longer defined' );
throws_ok { $content->add() } qr/No position or ID to perform action for specified!/, 'Check add function croaks without remote_dest specified';
throws_ok { $content->copy() } qr/No content source to copy from defined!/, 'Check copy function croaks without remote_src specified';
throws_ok { $content->del() } qr/No content destination to delete defined!/, 'Check del function croaks without remote_dest specified';
throws_ok { $content->check_exists() } qr/No position or ID to perform exists for specified!/, 'Check check_exists function croaks without remote_dest specified';
throws_ok { $content->move() } qr/No content source to move from defined!/, 'Check move function croaks without remote_src specified';
throws_ok { $content->upload_file() } qr/No local file to upload defined!/, 'Check upload_file function croaks without file specified';
throws_ok { $content->view() } qr/No position or ID to perform exists for specified!/, 'Check view function croaks without remote_dest specified';
throws_ok { $content->view_file() } qr/No file to view specified!/, 'Check view_file function croaks without remote_dest specified';
my $file = "\n";
throws_ok { $content->upload_from_file() } qr/File to upload from not defined/, 'Check upload_from_file function croaks without file specified';
throws_ok { $content->upload_from_file(\$file) } qr/Problem parsing content to add/, 'Check upload_from_file function croaks with blank file';
throws_ok { $content->upload_from_file('/tmp/__non__--__tnetsixe__') } qr{Problem opening file: '/tmp/__non__--__tnetsixe__'}, 'Check upload_from_file function croaks with non-existent file specified';
ok( my $content_config = Apache::Sling::Content->config($sling), 'check content_config function' );
ok( Apache::Sling::Content->run($sling,$content_config), 'check run function' );
throws_ok { Apache::Sling::Content->run() } qr/No content config supplied!/, 'check run function croaks with no config supplied';
t/Local/Apache-Sling-ContentUtil.t view on Meta::CPAN
ok( Apache::Sling::ContentUtil::move_setup('http://localhost:8080','remoteSrc/', 'remoteDest/') eq
"post http://localhost:8080/remoteSrc/ \$post_variables = [':dest','remoteDest/',':operation','move']", 'Check move_setup function without replace defined' );
ok(Apache::Sling::ContentUtil::move_setup('http://localhost:8080','remoteSrc/','remoteDest/',1) eq
"post http://localhost:8080/remoteSrc/ \$post_variables = [':dest','remoteDest/',':operation','move',':replace','true']", 'Check move_setup function with replace defined' );
throws_ok { Apache::Sling::ContentUtil::move_setup() } qr/No base url defined!/, 'Check move_setup function croaks without base url';
throws_ok { Apache::Sling::ContentUtil::move_setup('http://localhost:8080') } qr/No content source to move from defined!/, 'Check move_setup function croaks without remote_src';
throws_ok { Apache::Sling::ContentUtil::move_setup('http://localhost:8080','remoteSrc/') } qr/No content destination to move to defined!/, 'Check move_setup function croaks without remote_dest';
ok( Apache::Sling::ContentUtil::move_eval( \$res ), 'Check move_eval function' );
ok(Apache::Sling::ContentUtil::upload_file_setup('http://localhost:8080','./local','remote','') eq
"fileupload http://localhost:8080/remote ./* ./local \$post_variables = []", 'Check upload_file_setup function' );
ok(Apache::Sling::ContentUtil::upload_file_setup('http://localhost:8080','./local','remote','file') eq
"fileupload http://localhost:8080/remote file ./local \$post_variables = []", 'Check upload_file_setup function' );
throws_ok { Apache::Sling::ContentUtil::upload_file_setup() } qr/No base URL provided to upload against!/, 'Check upload_file_setup function croaks without base url';
throws_ok { Apache::Sling::ContentUtil::upload_file_setup('http://localhost:8080') } qr/No local file to upload defined!/, 'Check upload_file_setup function croaks without local_path';
throws_ok { Apache::Sling::ContentUtil::upload_file_setup('http://localhost:8080','local') } qr/No remote path to upload to defined for file local!/, 'Check upload_file_setup function croaks without remote_dest';
ok( Apache::Sling::ContentUtil::upload_file_eval( \$res ), 'Check upload_file_eval function' );
t/Local/Apache-Sling-Group.t view on Meta::CPAN
$group->set_results( 'Test Message', undef );
ok( $group->{ 'Message' } eq 'Test Message', 'Message now set' );
ok( ! defined $group->{ 'Response' }, 'Check response no longer defined' );
throws_ok { $group->add() } qr/No group name defined to add!/, 'Check add function croaks without group specified';
throws_ok { $group->del() } qr/No group name defined to delete!/, 'Check del function croaks without group specified';
throws_ok { $group->check_exists() } qr/No group to check existence of defined!/, 'Check check_exists function croaks without group specified';
throws_ok { $group->view() } qr/No group to view defined!/, 'Check view function croaks without group specified';
my $file = "\n";
throws_ok { $group->add_from_file() } qr/File to upload from not defined/, 'Check add_from_file function croaks without file';
throws_ok { $group->add_from_file(\$file) } qr/First CSV column must be the group ID, column heading must be "group". Found: ""./, 'Check add_from_file function croaks with blank file';
throws_ok { $group->add_from_file('/tmp/__non__--__tnetsixe__') } qr{Problem opening file: '/tmp/__non__--__tnetsixe__'}, 'Check add_from_file function croaks with non-existent file specified';
ok( my $group_config = Apache::Sling::Group->config($sling), 'check config function' );
ok( Apache::Sling::Group->run($sling,$group_config), 'check run function' );
throws_ok { Apache::Sling::Group->run() } qr/No group config supplied!/, 'check run function croaks with no config supplied';
t/Local/Apache-Sling-GroupMember.t view on Meta::CPAN
ok( $group_member->{ 'Verbose' } == 1, 'Check Verbosity set' );
ok( defined $group_member->{ 'Authn' }, 'Check authn defined' );
ok( defined $group_member->{ 'Response' }, 'Check response defined' );
throws_ok { $group_member->add() } qr/No group name defined to add to!/, 'Check add function croaks without group specified';
throws_ok { $group_member->del() } qr/No group name defined to delete from!/, 'Check delete function croaks without group specified';
throws_ok { $group_member->check_exists() } qr/No group to view defined!/, 'Check exists function croaks without group specified';
throws_ok { $group_member->view() } qr/No group to view defined!/, 'Check view function croaks without group specified';
my $file = "\n";
throws_ok { $group_member->add_from_file() } qr/File to upload from not defined/, 'Check add_from_file function croaks without file';
throws_ok { $group_member->add_from_file(\$file) } qr/First CSV column must be the group ID, column heading must be "group". Found: ""./, 'Check add_from_file function croaks with blank file';
throws_ok { $group_member->add_from_file('/tmp/__non__--__tnetsixe__') } qr{Problem opening file: '/tmp/__non__--__tnetsixe__'}, 'Check add_from_file function croaks with non-existent file specified';
ok( my $group_member_config = Apache::Sling::GroupMember->config($sling), 'check config function' );
ok( Apache::Sling::GroupMember->run($sling,$group_member_config), 'check run function' );
throws_ok { Apache::Sling::GroupMember->run() } qr/No group_member config supplied!/, 'check run function croaks with no config supplied';
t/Local/Apache-Sling-Request.t view on Meta::CPAN
BEGIN { use_ok( 'Apache::Sling::Content' ); }
my $sling = Apache::Sling->new();
my $authn = new Apache::Sling::Authn(\$sling);
my $content = new Apache::Sling::Content(\$authn,'1','log.txt');
throws_ok { Apache::Sling::Request::string_to_request() } qr/No string defined to turn into request!/, 'Checking string_to_request function string undefined';
throws_ok { Apache::Sling::Request::string_to_request('',\$authn) } qr/Error generating request for blank target!/, 'Checking string_to_request function blank string';
ok ( Apache::Sling::Request::string_to_request("post http://localhost:8080 \$post_variables = ['a','b']",\$authn), 'Checking string_to_request function for post action' );
ok ( Apache::Sling::Request::string_to_request("data http://localhost:8080 \$post_variables = ['a','b']",\$authn), 'Checking string_to_request function for data action' );
my ( $tmp_print_file_handle, $tmp_print_file_name ) = File::Temp::tempfile();
ok ( Apache::Sling::Request::string_to_request("fileupload http://localhost:8080 filename $tmp_print_file_name \$post_variables = []",\$authn), 'Checking string_to_request function for file upload action' );
throws_ok { Apache::Sling::Request::string_to_request("fileupload http://localhost:8080 filename $tmp_print_file_name \$post_variables = ['a',",\$authn) } qr//, 'Checking string_to_request function for fileupload action fails with broken post variabl...
unlink($tmp_print_file_name);
$authn->{'Username'} = 'user';
$authn->{'Password'} = 'pass';
ok ( Apache::Sling::Request::string_to_request("put http://localhost:8080",\$authn), 'Checking string_to_request function for put action' );
ok ( Apache::Sling::Request::string_to_request("delete http://localhost:8080",\$authn), 'Checking string_to_request function for delete action' );
$authn->{'Verbose'} = 2;
ok ( Apache::Sling::Request::string_to_request("get http://localhost:8080",\$authn), 'Checking string_to_request function for get action' );
throws_ok { Apache::Sling::Request::request(\$content,'') } qr/Error generating request for blank target!/, 'Checking request function blank string';
throws_ok { Apache::Sling::Request::request() } qr/No reference to a suitable object supplied!/, 'Check request function croaks without object';
throws_ok { Apache::Sling::Request::request(\$content) } qr/No string defined to turn into request!/, 'Check request function croaks without string';
t/Local/Apache-Sling-User.t view on Meta::CPAN
ok( $user->{ 'Message' } eq 'Test Message', 'Message now set' );
ok( ! defined $user->{ 'Response' }, 'Check response no longer defined' );
throws_ok { $user->add() } qr/No user name defined to add!/, 'Check add function croaks without user specified';
throws_ok { $user->change_password() } qr/No user name defined to change password for!/, 'Check check_exists function croaks without user specified';
throws_ok { $user->check_exists() } qr/No user to check existence of defined!/, 'Check check_exists function croaks without user specified';
throws_ok { $user->del() } qr/No user name defined to delete!/, 'Check del function croaks without user specified';
throws_ok { $user->update() } qr/No user name defined to update!/, 'Check update function croaks without user specified';
throws_ok { $user->view() } qr/No user to check existence of defined!/, 'Check view function croaks without user specified';
my $file = "\n";
throws_ok { $user->add_from_file() } qr/File to upload from not defined/, 'Check add_from_file function croaks without file specified';
throws_ok { $user->add_from_file(\$file) } qr/First CSV column must be the user ID, column heading must be "user". Found: ""./, 'Check add_from_file function croaks with blank file';
throws_ok { $user->add_from_file('/tmp/__non__--__tnetsixe__') } qr{Problem opening file: '/tmp/__non__--__tnetsixe__'}, 'Check add_from_file function croaks with non-existent file specified';
ok( my $user_config = Apache::Sling::User->config($sling), 'check config function' );
ok( Apache::Sling::User->run($sling,$user_config), 'check run function' );
throws_ok { Apache::Sling::User->run() } qr/No user config supplied!/, 'check run function croaks with no config supplied';
( run in 1.589 second using v1.01-cache-2.11-cpan-b16cb0d3907 )