diff options
Diffstat (limited to 'biblio/bibtex/utils/bib2ml/src/Bib2HTML/Generator/FileWriter.pm')
| -rw-r--r-- | biblio/bibtex/utils/bib2ml/src/Bib2HTML/Generator/FileWriter.pm | 307 |
1 files changed, 307 insertions, 0 deletions
diff --git a/biblio/bibtex/utils/bib2ml/src/Bib2HTML/Generator/FileWriter.pm b/biblio/bibtex/utils/bib2ml/src/Bib2HTML/Generator/FileWriter.pm new file mode 100644 index 0000000000..d79d5495e2 --- /dev/null +++ b/biblio/bibtex/utils/bib2ml/src/Bib2HTML/Generator/FileWriter.pm @@ -0,0 +1,307 @@ +# 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 |