From ca459459e37d29ff76a90cc457fb85f7d524b441 Mon Sep 17 00:00:00 2001
From: dakkar <dakkar@luxion>
Date: Sat, 8 Sep 2007 11:51:05 +0000
Subject: symlink following, and most parsers for the test

git-svn-id: svn://luxion/repos/WebCoso/trunk@284 fcb26f47-9200-0410-b104-b98ab5b095f3
---
 lib/File/Cache/Parsed.pm |  8 +++++++-
 stest.pl                 | 24 ++++++++++++++----------
 t/fcp-01.t               | 18 +++++++++++++++++-
 3 files changed, 38 insertions(+), 12 deletions(-)

diff --git a/lib/File/Cache/Parsed.pm b/lib/File/Cache/Parsed.pm
index 1546ef1..f6930d3 100644
--- a/lib/File/Cache/Parsed.pm
+++ b/lib/File/Cache/Parsed.pm
@@ -3,16 +3,18 @@ use strict;
 use warnings;
 use List::Util qw(first);
 use List::MoreUtils qw(firstidx);
+use Cwd 'abs_path';
 use Path::Class;
 use Carp;
 
 sub new {
-    my ($class)=@_;
+    my ($class,%opts)=@_;
 
     return bless {
         parsers=>[],
         writers=>[],
         cache=>{},
+        follow=>$opts{follow},
     }=>$class;
 }
 
@@ -58,6 +60,10 @@ sub del_parser {
 sub get {
     my ($self,$filename)=@_;
 
+    if ($self->{follow}) {
+        $filename=abs_path($filename);
+    }
+
     return $self->{cache}{$filename} if exists $self->{cache}{$filename};
 
     my $contents=file($filename)->slurp;
diff --git a/stest.pl b/stest.pl
index 5480f8f..a22c5ce 100644
--- a/stest.pl
+++ b/stest.pl
@@ -9,29 +9,33 @@ use File::Cache::Parsed;
 use Cwd 'abs_path';
 use Text::Restructured;
 use Text::Restructured::Writer::LibXML;
+use XML::LibXML;
+use XML::LibXSLT;
 
 my $stash={};
 my $template=Template->new();
 my $rest=Text::Restructured->new({},'WebCoso');
+my $xml_parser=XML::LibXML->new();
+my $xslt_proc=XML::LibXSLT->new();
 
 my $fc=File::Cache::Parsed->new();
-$fc->add_parser(qr{\.rest\.tt2?$} =>
+$fc->add_parser(qr{\.tt2?$} =>
                     sub {
-                        my ($name,$content)=@_;
-                        my $real_name=abs_path($name);
-                        my $output;
-                        $template->process($real_name,
-                                           {%$stash,name=>$name},
-                                           \$output);
-                        return $output;
+                        $template->context->template($_[0]);
                     });
 $fc->add_parser(qr{\.rest\.txt$} =>
                     sub {
-                        my ($name,$content)=@_;
-                        my $dudom=$rest->Parse($content,$name);
+                        my $dudom=$rest->Parse($_[1],$_[0]);
                         return Text::Restructured::Writer::LibXML
                             ->new->ProcessDOM($dudom);
                     });
+$fc->add_parser(qr{\.xml$} =>
+                    sub { $xml_parser->parse_string($_[1],$_[0]) });
+$fc->add_parser(qr{\.xslt?$} =>
+                    sub { $xslt_proc->parse_stylesheet
+                              ($xml_parser->parse_string($_[1],$_[0])) });
+$fc->add_writer(qr{\.xml$} =>
+                    sub { $_[1]->toFile($_[0]) });
 
 sub expandTT {
     my ($maker,$target,$deps,$matches)=@_;
diff --git a/t/fcp-01.t b/t/fcp-01.t
index a745de2..49a2d66 100644
--- a/t/fcp-01.t
+++ b/t/fcp-01.t
@@ -44,6 +44,22 @@ is($fc->get($test_file->stringify),
 is($fc->get($test_file),
    $test_contents,
    'cache ok 2');
+
+my $fc_l=File::Cache::Parsed->new(follow=>1);
+$fc_l->add_parser(qr{\.t$} => sub { return ['t',@_] });
+
+$fc->add_parser(qr{\.t$} => sub { return ['t',@_] });
+
+my $link_file=$base->file('symlink.t');
+symlink $test_file->stringify,$link_file->stringify;
+END { $link_file->remove }
+
+is_deeply($fc_l->get($link_file->stringify),
+          ['t',$test_file->absolute->stringify,$test_contents],
+          'followed symlink');
+is_deeply($fc->get($link_file->stringify),
+          ['t',$link_file->stringify,$test_contents],
+          q{didn't follow symlink});
 }
 
 {
@@ -70,7 +86,7 @@ my $wr_file=file("$wr_tfile");
 my $wr_contents="something\nor\nother\n";
 
 $fc->put($wr_file->stringify,$wr_contents);
-is($calls{stuff},2,'defaulh writer');
+is($calls{stuff},2,'default writer');
 is($wr_file->slurp,$wr_contents,'written ok passthrough');
 $wr_contents={bad=>'stuff'};
 throws_ok(sub {$fc->put($wr_file->stringify,$wr_contents)},
-- 
cgit v1.2.3