# HG changeset patch
# User Peter Marschall <peter@adpm.de>
# Date 1299359607 -3600
# Node ID 7d170d1bc17b5d55c7aac3b06d24d338c09957ce
# Parent  68318d115f6cfb2029a00c9ce3a6dac98ec29004
run_list: new argument syntax: [<options>] [<filter>] [<attributes>]

From 232fbd24ff43c9c0d0691cf0e1b51a82ef099489 Mon Sep 17 00:00:00 2001
Make run_list work with a properly defined argument syntax:
- start with (optional) options: -R -l
- continue with filter ['(objectclass=*)' as fallback if none given]
- end with attributes (also optional)

Add method is_valid_filter() to check whether a strig is a legal LDAP filter.

diff -r 68318d115f6c -r 7d170d1bc17b shelldap
--- a/shelldap	Sat Mar 05 20:56:20 2011 +0100
+++ b/shelldap	Sat Mar 05 22:13:27 2011 +0100
@@ -775,6 +775,18 @@
 	return $filter;
 }
 
+
+# check whether a given string may be a filter
+# Synopsis: $yesNo = $self->is_valid_filter($string);
+sub is_valid_filter
+{
+	my $self  = shift;
+	my $filter = shift or return;
+	my $filterObject = Net::LDAP::Filter->new($filter);
+
+	return $filterObject ? 1 : 0
+}
+
 # little. yellow. different. better.
 #
 sub debug 
@@ -1404,35 +1416,50 @@
 
 sub run_list
 {
-	my $self	= shift;
-	my @filters = @_;
-	my $base	= $self->base();
-	my $attrs 	= [ 'hasSubordinates' ];
+	my $self = shift;
+	my @args = @_;
+	my $base = $self->base();
+	my @attrs = ();
+	my $flags = '';
+	my $filter = '(objectclass=*)';
+
+	# parse arguments: [ <option> ...] [<filter> ...] [<attribute> ...]
+	if (@args) {
+		# options: support '-l' or '-R' listings
+		if ( $args[0] =~ /^\-([lR])/o ) {
+			$flags .= $1;
+			shift(@args);
+		}
 
-	# setup filters
-	my ( $flags, $filter );
-	if ( scalar @filters ) {
-		# support '-l' or '-R' listings
-		if ( $filters[0] =~ /\-[lR]|verbose/ ) {
-			$flags = shift @filters;
+		my @filters;
+
+		# get filter elements from argument list
+		while (@args && $self->is_valid_filter($args[0])) {
+			push(@filters, shift(@args));
 		}
+
+		push(@filters, '(objectclass=*)')  if (!@filters);
 		
+		# construct OR'ed filter from filter elements
 		$filter = $self->make_filter( \@filters );
+
+		# remaining arguments must be attributes
+		push(@attrs, @args);
 	}
 
 	# flag booleans
 	my ( $recurse, $long );
 	if ( $flags ) {
-		$recurse = $flags =~ /R/;
-		$long	 = $flags =~ /l/;
-		$attrs   = [ '*', 'hasSubordinates' ] if $long;
+		$recurse = $flags =~ /R/o;
+		$long	 = $flags =~ /l/o;
+		push(@attrs, '*')  if ($long && !@attrs);
 	}
 
 	my $s = $self->search({
 		scope  => $recurse ? 'sub' : 'one',
 		vals   => 1,
 		filter => $filter,
-		attrs  => $attrs
+		attrs  => [ @attrs, 'hasSubordinates' ]
 	});
 	if ( $s->{'code'} ) {
 		print "$s->{'message'}\n";
@@ -1456,51 +1483,56 @@
 	# iterate and print
 	#
 	my $dn_count = 0;
-	my $dn;
 	foreach my $e ( sort { $a->dn() cmp $b->dn() } @{ $s->{'entries'} } ) {
-		$dn = $e->dn();
+		my $dn = $e->dn();
+
+		# only show RDN unless -l was given
+		$dn = canonical_dn([shift(@{ldap_explode_dn($dn, casefold => 'none')})],
+				   casefold => 'none')
+			unless ($long);
 
 		# if this entry is a container for other entries, append a
 		# trailing slash.
-		if ( $e->get_value('hasSubordinates') eq 'TRUE' ) {
-			$dn .= '/';
-		}
-
-		my $rdn = $dn;
-		$rdn =~ s/,$base//i;
+		$dn .= '/'  if ($e->get_value('hasSubordinates') eq 'TRUE');
 
-		unless ( $long ) {
-			$dn = $rdn;
-			next;
-		}
+		# additional arguments given; show their values
+		if (@args) {
+			my @elements = ( $dn );
 
-		# show descriptions
-		my $desc = $e->get_value('description');
-		if ( $desc ) {
-			$desc =~ s/\n.*//s; # 1st line only
-			$dn .= " ($desc)";
-		}
+			foreach my $attr (@args) {
+				my @vals = $e->get_value($attr);
+				push(@elements, join(',', @vals));
+			}
 
-		# no desc?  Try and infer something useful
-		# to display.
+			print join("\t", @elements)."\n";
+		}
 		else {
+			# show descriptions
+			my $desc = $e->get_value('description');
+			if ( $desc ) {
+				$desc =~ s/\n.*//s; # 1st line only
+				$dn .= " ($desc)";
+			}
 
-			# pull objectClasses, hash for lookup speed
-			my @oc   = $e->get_value('objectClass');
-			my %ochash;
-			map { $ochash{$_} = 1 } @oc;
+			# no desc?  Try and infer something useful
+			# to display.
+			else {
 
-			foreach my $d_listing ( sort keys %descs ) {
-				if ( exists $ochash{ $d_listing } ) {
-					my $str = $e->get_value( $descs{ $d_listing }, asref => 1 );
-					$dn .= ' (' . (join ', ', @$str) . ')' if $str && scalar @$str;
+				# pull objectClasses, hash for lookup speed
+				my @oc   = $e->get_value('objectClass');
+				my %ochash;
+				map { $ochash{$_} = 1 } @oc;
+
+				foreach my $d_listing ( sort keys %descs ) {
+					if ( exists $ochash{ $d_listing } ) {
+						my $str = $e->get_value( $descs{ $d_listing }, asref => 1 );
+						$dn .= ' (' . (join ', ', @$str) . ')' if $str && scalar @$str;
+					}
+					next;
 				}
-				next;
 			}
+			print "$dn\n";
 		}
-	} 
-	continue {
-		print "$dn\n";
 		$dn_count++;
 	}