Net::DRI::Logging::Files - Logging to Files for Net::DRI

	$dri->new({..., logging => ['files',{output_directory => '/tmp'}] ,...});

## Domain Registry Interface, Logging into files
##
## Copyright (c) 2009,2010 Patrick Mevzek <netdri@dotandco.com>. All rights reserved.
##
## This file is part of Net::DRI
##
## Net::DRI is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 2 of the License, or
## (at your option) any later version.
##
## See the LICENSE file that comes with this distribution for more details.
#
# 
#
#########################################################################################

package Net::DRI::Logging::Files;

use strict;
use warnings;

use base qw/Net::DRI::Logging/;

use Net::DRI::Exception;

use IO::Handle; ## needed for the autoflush method on any lexical $fh

our $VERSION=do { my @r=(q$Revision: 1.3 $=~/\d+/g); sprintf('%d'.'.%02d' x $#r, @r); };

####################################################################################################

sub new
{
 my ($class,$data)=@_;
 my $self=$class->SUPER::new($data);
 if (! exists $self->{output_directory} || ! defined $self->{output_directory} ) { $self->{output_directory}='.'; }
 if (! -d $self->{output_directory}) { Net::DRI::Exception->die(0,'logging',1,'Directory '.$self->{output_directory}.' does not exist'); }
 if (! -w $self->{output_directory}) { Net::DRI::Exception->die(0,'logging',2,'Directory '.$self->{output_directory}.' is not writable'); }
 $self->{fh}={};
 return $self;
}

sub name { return 'files'; }

sub setup_channel
{
 my ($self,$source,$type,$data)=@_;
 my $name=$self->generate_filename($type,$data);
 if (exists $self->{fh}->{$name}) { return; }
 my $fh;
 open $fh,'>>',$name or Net::DRI::Exception->die(0,'logging',3,'File '.$name.' can not be open for writing: '.$!);
 $fh->autoflush(1); ## this is possible thanks to IO::Handle
 $self->{fh}->{$name}=$fh;
 return;
}

sub output
{
 my ($self,$level,$type,$data)=@_;
 if (! $self->should_log($level)) { return; }
 my $name=$self->generate_filename($type,$data);
 print { $self->{fh}->{$name} } $self->tostring($level,$type,$data),"\n";
 return;
}

####################################################################################################

sub generate_filename
{
 my ($self,$type,$ctx)=@_;
 my $name=(defined $ctx && ref $ctx eq 'HASH')? sprintf('%s-%s',$ctx->{registry},$ctx->{profile}) : $type;
 return sprintf '%s/%d-%s.log',$self->{output_directory},$$,$name;
}

sub DESTROY
{
 my ($self)=@_;
 foreach my $fh (values %{$self->{fh}})
 {
  close $fh or 1;
 }
 return;
}

####################################################################################################
1;

__END__