# Copyright (C) 1998-09 Stephane Galland <galland@arakhne.org> # # This program 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. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; see the file COPYING. If not, write to # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. =pod =head1 NAME Bib2HTML::Generator::FileWriter - An output stream writer =head1 DESCRIPTION Bib2HTML::Generator::FileWriter is a Perl module, which permits to output streams into files. =head1 SYNOPSYS Bib2HTML::Generator::FileWriter->new( ) ; =head1 DESCRIPTION Bib2HTML::Generator::FileWriter is a Perl module, which permits to output streams into files. =head1 METHOD DESCRIPTIONS This section contains only the methods in FileWriter.pm itself. =over =cut package Bib2HTML::Generator::FileWriter; @ISA = ('Bib2HTML::Generator::Writer'); @EXPORT = qw(); @EXPORT_OK = qw(); use strict; use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); use Exporter; use Carp ; use File::Path; use File::Spec; use Bib2HTML::Generator::Writer; use Bib2HTML::General::Misc; use Bib2HTML::General::Error; #------------------------------------------------------ # # Global vars # #------------------------------------------------------ # Version number of abstract generator my $VERSION = "1.0" ; # Opened streams my @opened_streams = (); #------------------------------------------------------ # # Constructor # #------------------------------------------------------ sub new() : method { my $proto = shift; my $class = ref($proto) || $proto; my $self = $class->SUPER::new() ; bless( $self, $class ); return $self; } =pod =item * openstream($) Open the output stream. Takes 1 param: =over =item * filename (string) is the name of the output file. =back =cut sub openstream($) { my $self = shift; my $filename = shift || confess( 'you must supply the root directory' ) ; confess('output stream already opened') if ($self->{'opened'}); my $streamname = ''; do { my $count = int(rand(5)); $streamname = $filename; $streamname =~ s/[^a-zA-Z]//g; for(my $i=0; $i<$count; $i++) { my $c = rand(26); $streamname .= chr(ord('A')+$c); } } while (strinarray("$streamname",\@opened_streams)); local *OUTPUTFILE; *OUTPUTFILE = $streamname; my $r = open( OUTPUTFILE, "> $filename" ); if ($r) { $self->{'opened'} = "$streamname"; push @opened_streams, "$streamname"; } return $r; } =pod =item * out($) Put a string into the output stream. Takes 1 param: =over =item * str (string) is the string to output. =back =cut sub out($) { my $self = shift; my $str = shift || ''; if ($self->{'opened'}) { local *OUTPUTFILE; *OUTPUTFILE = $self->{'opened'}; print OUTPUTFILE ("$str"); return 1; } else { return undef; } } =pod =item * closestream() Close the currently opened stream. =cut sub closestream() { my $self = shift; if ($self->{'opened'}) { local *OUTPUTFILE; *OUTPUTFILE = $self->{'opened'}; close(OUTPUTFILE); @opened_streams = grep {($self->{opened} ne $_)} @opened_streams; delete $self->{'opened'}; return 1; } else { return undef; } } =pod =item * create_output_directory() Create the output directory if required. Replies the output filename (directory). Takes n params: =over =item * output (string) is the output directory to create. =item * exceptions (list of strings) is the list of the file in the existing output directory to not remove. =back =cut sub create_output_directory($@) { my $self = shift; my $output = shift ; if ( ! $output ) { $output = File::Spec->catdir( ".", "bib2html" ) ; } if ( ! -d "$output" ) { mkdir( "$output", 0777 ) or Bib2HTML::General::Error::syserr( "$output: $!\n" ); } else { $self->_clear_output_directory("$output", @_); } return "$output" ; } =pod =item * _clear_output_directory() Clear the content of the output directory. =cut sub _clear_output_directory($@) { my $self = shift; my $output = shift ; my @protect = (); foreach my $expr (@_) { push @protect, shell_to_regex($expr); } local *DIR; opendir(*DIR,"$output") or Bib2HTML::General::Error::syserr( "The output directory '$output". "' can't be opened: $!\n" ) ; while (my $subfile = readdir(*DIR)) { if (($subfile ne File::Spec->curdir())&&($subfile ne File::Spec->updir())) { my $valid = 1; foreach my $expr (@protect) { if ($subfile =~ /$expr/) { $valid = undef; last; } } if ($valid) { my $fullpath = File::Spec->catfile("$output","$subfile"); if ( -d "$fullpath" ) { rmtree( "$fullpath" ) or Bib2HTML::General::Error::syserr( "The directory '$fullpath". "' can't be deleted: $!\n" ) ; } else { unlink( "$fullpath" ) or Bib2HTML::General::Error::syserr( "The file '$fullpath". "' can't be deleted: $!\n" ) ; } } } } closedir(*DIR); } =pod =item * is_file_creation_allowed() Replies if this writer allows to create files. =cut sub is_file_creation_allowed() { my $self = shift; return 1; } 1; __END__ =back =head1 COPYRIGHT (c) Copyright 1998-09 St�phane Galland E<lt>galland@arakhne.orgE<gt>, under GPL. =head1 AUTHORS =over =item * Conceived and initially developed by St�phane Galland E<lt>galland@arakhne.orgE<gt>. =back =head1 SEE ALSO bib2html.pl