file:// URL support for Net::LDAP::LDIF

[Peter Marschall]

Hi Graham, hi Chris, hi list,

the attached aptch adds support for file:// URLs when reading LDIF files.

I.e. Net::LDAP::LDIF now can handle LDIF files with lines containing attribute 
definitions like
        jpegPhoto:< file///path/to/file.jpg

With this patch Net::LDAP::LDIF fulfils the recommendation about URL types to 
support in RFC2849

I'd appreciate if this patch could make it into the standard perl- ldap 
distribution.

What about an April Fool's Day relase of perl-ldap to make the recent 
additions and changes official ?

Thanks in advance
Peter

-- 
Peter Marschall
eMail: [EMAIL PROTECTED]

# patch to support URL attribute definitions of the form
#   attr:< file:///path/to/file 
# when reading an LDIF file
--- lib/Net/LDAP/LDIF.pm	2004-01-01 10:46:18.000000000 +0100
+++ lib/Net/LDAP/LDIF.pm	2004-03-07 17:14:43.000000000 +0100
@@ -66,6 +66,12 @@
     write_count => ($mode eq 'a' and tell($fh) > 0) ? 1 : 0,
   };
 
+  # fetch glob for URL type attributes (one per LDIF object)
+  if ($mode eq "r") {
+    require Symbol;
+    $self->{_attr_fh} = Symbol::gensym();
+  }
+
   bless $self, $pkg;
 }
   
@@ -105,6 +111,33 @@
 }
 
 
+# read attribute value from URL (currently only file: URLs)
+sub _read_url_attribute {
+  my $self = shift;
+  my $url = shift;
+  my @ldif = @_;
+  my $line;
+
+  if ($url =~ s/^file:(?:\/\/)?//) {
+    my $fh = $self->{_attr_fh};
+    unless (open($fh, '<', $url)) {
+      $self->_error("can't open $line: $!", @ldif);
+      return;
+    }
+    { # slurp in whole file at once
+      local $/;
+      $line = <$fh>;
+    }
+    close($fh);
+  } else {
+    $self->_error("unsupported URL type", @ldif);
+    return;
+  }
+
+  $line;
+}
+
+
 # _read_one() is deprecated and will be removed
 # in a future version
 *_read_one = \&_read_entry; 
@@ -191,6 +224,8 @@
         }
  
         $line =~ s/^([-;\w]+):\s*// and $attr = $1;
+
+        # base64 encoded attribute: decode it
         if ($line =~ s/^:\s*//) {
           eval { require MIME::Base64 };
           if ($@) {
@@ -199,6 +234,11 @@
           }
           $line = MIME::Base64::decode($line);
         }
+        # url attribute: read in file:// url, fail on others
+        elsif ($line =~ s/^\<\s*(.*?)\s*$/$1/) {
+          $line = $self->_read_url_attribute($line, @ldif);
+          return  if !defined($line);
+        }
  
         if( defined($modattr) && $attr ne $modattr ) {
           $self->_error("LDAP entry is not valid", @ldif);
@@ -228,6 +268,7 @@
     foreach $line (@ldif) {
       $line =~ s/^([-;\w]+):\s*// && ($attr = $1) or next;
   
+      # base64 encoded attribute: decode it
       if ($line =~ s/^:\s*//) {
         eval { require MIME::Base64 };
         if ($@) {
@@ -236,6 +277,11 @@
         }
         $line = MIME::Base64::decode($line);
       }
+      # url attribute: read in file:// url, fail on others
+      elsif ($line =~ s/^\<\s*(.*?)\s*$/$1/) {
+        $line = $self->_read_url_attribute($line, @ldif);
+        return  if !defined($line);
+      }
   
       if ($attr eq $last) {
         push @$vals, $line;