Changeset 28525 for trunk/Nebulous
- Timestamp:
- Jun 28, 2010, 2:59:29 PM (16 years ago)
- Location:
- trunk/Nebulous
- Files:
-
- 2 edited
-
bin/neb-ls (modified) (7 diffs)
-
lib/Nebulous/Client.pm (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/Nebulous/bin/neb-ls
r24346 r28525 1 1 #!/usr/bin/env perl 2 2 3 # Copyright (C) 2007-2009 Joshua Hoblitt 3 # Copyright (C) 2007-2009 Joshua Hoblitt, 2010 Chris Waters 4 4 5 5 use strict; … … 16 16 my ( 17 17 $server, 18 $ long,19 # $recursive,18 $path, 19 $column, 20 20 ); 21 21 22 22 $server = $ENV{'NEB_SERVER'} unless $server; 23 23 24 # make --long the default25 $long = 1;26 24 27 25 GetOptions( 28 26 'server|s=s' => \$server, 29 # 'recursive|r' => \$recursive,30 ' l|1' => \$long,27 'path|p' => \$path, 28 'column|c' => \$column, 31 29 ) || pod2usage( 2 ); 30 31 # twiddle column so that it does it by default. 32 33 $column = not $column; 32 34 33 35 my $pattern = shift; … … 47 49 $pattern ||= "/"; 48 50 49 #if ($recursive) { 50 # $pattern = "^" . $pattern . ".*"; 51 #} else { 52 # $pattern = "^" . $pattern . "\$"; 53 #} 51 my $keys = $neb->find_objects_wildcard($pattern); 54 52 55 my $keys = $neb->find_objects($pattern); 56 53 if ($path) { 54 my @files; 55 foreach my $key (@{ $keys }) { 56 my $uris = $neb->find_instances($key); 57 if (defined $uris) { 58 push @files, URI->new(@$uris[0])->file; 59 } 60 } 61 @{ $keys } = @files; 62 } 57 63 if ($keys) { 58 if ($long) { 59 print join("\n", @{ $keys }), "\n"; 60 } else { 61 print join(" ", @{ $keys }), "\n"; 64 if ($column) { 65 open(COLUMN,"|column") || die "Cannot open column command."; 66 print COLUMN join("\n", @{ $keys }), "\n"; 67 close(COLUMN); 68 } 69 else { 70 print join("\n", @{ $keys }), "\n"; 62 71 } 63 72 } 73 64 74 65 75 __END__ … … 73 83 =head1 SYNOPSIS 74 84 75 neb-ls [--server <URL>] [- l|-1] [--recursive] <pattern>85 neb-ls [--server <URL>] [-c] [-p] <pattern> 76 86 77 87 =head1 DESCRIPTION 78 88 79 89 This program list Nebulous keys matched by C<<pattern>>. Call it with no 80 arguments is equival anet to searching with the pattern C<.*>. Where81 C<<pattern>> is a POSIX 1003.2 compatable regular repression.90 arguments is equivalent to searching with the pattern C<neb://>. SQL like 91 wildcards are supported to select out certain files. 82 92 83 93 =head1 OPTIONS … … 85 95 =over 4 86 96 87 =item * - l|-197 =item * --path|-p 88 98 89 Use a long listing format. 99 Find the disk files corresponding to the keys found. 100 101 =item * --column|-c 102 103 Disable column formatting, and output results one to a line. 90 104 91 105 Optional 92 106 93 =cut94 #=item * --recursive|-r95 #96 #By default C<neb-ls> will only try to match the exact string provided to it.97 #With this option set all keys which match C<<pattern>> as a REGEX or substring98 #will be returned.99 #100 #Optional101 #102 107 =item * --server|-s <URL> 103 108 … … 122 127 =back 123 128 124 =head1 CREDITS125 126 Just me, myself, and I.127 128 129 =head1 SUPPORT 129 130 … … 132 133 =head1 AUTHOR 133 134 134 Joshua Hoblitt <jhoblitt@cpan.org> 135 Joshua Hoblitt <jhoblitt@cpan.org>, Chris Waters 135 136 136 137 =head1 COPYRIGHT 137 138 138 Copyright (C) 2007-20 09 Joshua Hoblitt. All rights reserved.139 Copyright (C) 2007-2010 Joshua Hoblitt / Chris Waters. All rights reserved. 139 140 140 141 This program is free software; you can redistribute it and/or modify it under -
trunk/Nebulous/lib/Nebulous/Client.pm
r28446 r28525 9 9 no warnings qw( uninitialized ); 10 10 11 our $VERSION = '0.1 7';11 our $VERSION = '0.18'; 12 12 13 13 use Digest::MD5; … … 741 741 } 742 742 743 sub find_objects_wildcard 744 { 745 my $self = shift; 746 747 my @args = validate_pos( @_, 748 { 749 type => SCALAR, 750 optional => 1, 751 }, 752 ); 753 754 $log->debug( "entered - @_" ); 755 756 my $response = $self->{ 'server' }->find_objects_wildcard( @args ); 757 if ( $response->fault ) { 758 $self->set_err($response->faultstring); 759 760 if ($response->faultstring =~ /no keys found/) { 761 $log->debug( "leaving" ); 762 return; 763 } 764 if ($response->faultstring =~ /does not match any key or directory/) { 765 $log->debug( "leaving" ); 766 return; 767 } 768 769 $log->logdie("unhandled fault - ", $self->err); 770 } 771 772 my $keys = $response->result; 773 774 $log->debug( "server found: @$keys" ); 775 776 # foreach my $path ( @{ $uris } ) { 777 # $path = _get_file_path( $path ); 778 # } 779 780 $log->debug( "leaving" ); 781 782 return $keys; 783 } 784 743 785 744 786 sub find_instances
Note:
See TracChangeset
for help on using the changeset viewer.
