added writers

git-svn-id: svn://luxion/repos/WebCoso/trunk@282 fcb26f47-9200-0410-b104-b98ab5b095f3

1 files changed, 30 insertions, 0 deletions

diff --git a/lib/File/Cache/Parsed.pm b/lib/File/Cache/Parsed.pm
index 9e980ef..7792cf1 100644
--- a/lib/File/Cache/Parsed.pm
+++ b/lib/File/Cache/Parsed.pm
@@ -4,12 +4,14 @@ use warnings;
 use List::Util qw(first);
 use List::MoreUtils qw(firstidx);
 use Path::Class;
+use Carp;
 
 sub new {
     my ($class)=@_;
 
     return bless {
         parsers=>[],
+        writers=>[],
         cache=>{},
     }=>$class;
 }
@@ -27,6 +29,19 @@ sub add_parser {
     return;
 }
 
+sub add_writer {
+    my ($self,$rx,$writer)=@_;
+
+    my $old_writer=first {$_->[0] eq $rx} @{$self->{writers}};
+    if ($old_writer) {
+        $old_writer->[1]=$writer;
+    }
+    else {
+        push @{$self->{writers}},[$rx,$writer];
+    }
+    return;
+}
+
 sub del_parser {
     my ($self,$rx)=@_;
 
@@ -56,6 +71,21 @@ sub get {
     }
 }
 
+sub put {
+    my ($self,$filename,$contents)=@_;
+
+    my $ww=first {$filename =~ m{$_->[0]}} @{$self->{writers}};
+    if ($ww) {
+        return $ww->[1]->($filename,$contents);
+    }
+    elsif (!ref($contents)) {
+        return print {file($filename)->openw} $contents;
+    }
+    else {
+        croak "'$contents' is not a scalar, and no writer defined for the name '$filename'";
+    }
+}
+
 sub invalidate {
     my ($self,$rx)=@_;