[SVN] [34] Directory to XML plugin

[ma...@sergeant.org]

Revision: 34
Author:   matt
Date:     2006-08-02 22:15:08 +0000 (Wed, 02 Aug 2006)

Log Message:
-----------
Directory to XML plugin

Modified Paths:
--------------
    trunk/lib/AxKit2/Client.pm

Added Paths:
-----------
    trunk/plugins/dir_to_xml

Modified: trunk/lib/AxKit2/Client.pm
===================================================================
--- trunk/lib/AxKit2/Client.pm	2006-08-02 22:04:49 UTC (rev 33)
+++ trunk/lib/AxKit2/Client.pm	2006-08-02 22:15:08 UTC (rev 34)
@@ -125,7 +125,7 @@
 
 sub hook_error {
     my $self = shift;
-    $self->headers_out->code(SERVER_ERROR, "Internal Server Error");
+    $self->headers_out->code(SERVER_ERROR);
     my ($ret) = $self->run_hooks('error');
     if ($ret != OK) {
         $self->headers_out->header('Content-Type' => 'text/html; charset=UTF-8');

Added: trunk/plugins/dir_to_xml
===================================================================
--- trunk/plugins/dir_to_xml	2006-08-02 22:04:49 UTC (rev 33)
+++ trunk/plugins/dir_to_xml	2006-08-02 22:15:08 UTC (rev 34)
@@ -0,0 +1,61 @@
+#!/usr/bin/perl -w
+
+use File::Spec::Functions qw(catfile);
+use Encode;
+
+sub init {
+    my $self = shift;
+    
+    $self->register_config('DirExternalEncoding', sub { $self->ext_encoding(@_) });
+}
+
+sub ext_encoding {
+    my ($self, $conf) = (shift, shift);
+    
+    my $key = $self->plugin_name . '::external_encoding';
+    @_ and $conf->notes($key, shift);
+    $conf->notes($key);
+}
+
+sub hook_xmlresponse {
+    my ($self, $input) = @_;
+    my $dir = self->client->headers_in->filename;
+    return DECLINED unless -d $dir;
+    
+    my $enc = $self->ext_encoding($self->config);
+    
+    opendir(DIR, $dir) || die "opendir($dir): $!";
+    
+    my $output = '<?xml version="1.0" encoding="UTF-8"?>
+<filelist xmlns="http://axkit.org/2002/filelist">
+';
+    while(my $line = readdir(DIR)) {
+        my $xmlline = _to_utf8($enc, $line);
+        $xmlline =~ s/&/&amp;/;
+        $xmlline =~ s/</&lt;/;
+        my @stat = stat(catfile($dir,$line));
+        my $attr = "size=\"$stat[7]\" atime=\"$stat[8]\" mtime=\"$stat[9]\" ctime=\"$stat[10]\"";
+        $attr .= ' readable="1"' if (-r _);
+        $attr .= ' writable="1"' if (-w _);
+        $attr .= ' executable="1"' if (-x _);
+        
+        if (-f _) {
+            $output .= "<file $attr>$xmlline</file>\n";
+        } elsif (-d _) {
+            $output .= "<directory $attr>$xmlline</directory>\n";
+        } else {
+            $output .= "<unknown $attr>$xmlline</unknown>\n";
+        }
+    }
+    $output .= "</filelist>\n";
+    
+    $input->dom($output);
+    
+    return DECLINED;
+}
+
+sub _to_utf8 {
+    my ($enc, $line) = @_;
+    # NB: We croak because it's useless returning a dir we can't convert
+    return Encode::decode($enc, $line, Encode::FB_CROAK);
+}
\ No newline at end of file