view release on metacpan or  search on metacpan

lib/Alvis/Buffer.pm  view on Meta::CPAN

it under the same terms as Perl itself, either Perl version 5.8.4 or,
at your option, any later version of Perl 5 you may have available.

=cut




#############################################
#  parameters - fixed per instance
our $BUFFER="building.xml-ish";
our $HEADER='<?xml version="1.0" encoding="UTF-8"?>
<documentCollection xmlns="http://alvis.info/enriched/" version="1.1">
';
our $TRAILER='</documentCollection>
';

#############################################
#  run time variables
our $docs = 0;
our $size = 0;
our $verbose = 0;

############################################
#
#  add XML chunk
sub add() {
  my $xml = shift();
  my $xc = $xml;
  my $count = $xc =~ s/<\/documentRecord>//g;
  #  now save
  print ABUF $xml,"\n";
  if ( $verbose ) {
    my $tt = Time::Simple->new;
    print STDERR "Docs of $count of size " . length($xml) . " added at time "
      . $tt->format . "\n";
  }
  $docs += $count;
  $size += length($xml);
}

sub close() {
  CORE::close(ABUF);
}

############################################
#
#  make sure the output XML buffer file is in OK state
#  and open it for append, as filehandle ABUF
#  and set $docs, $size
#  return 0 on fatal error, after printing error message
sub fix() {
  $docs = 0;
  $size = 0;
  if ( ! -f $BUFFER ) {
    #  start new one
    if ( ! open(ABUF,">>$BUFFER") ) {
      print STDERR "Cannot open $BUFFER: $!\n";
      return 0;
    }
    select((select(ABUF), $| = 1)[0]);
    print ABUF $HEADER;
  } else {
    #  check old one first
    if ( ! open(ABUF,"<$BUFFER") ) {
      print STDERR "Cannot open $BUFFER: $!\n";
      return 0;
    }
    #  its a UTF-8 file, so have to read it all
    #  since cannot start half way through
    my $last = "";
    my $last2 = "";
    my $last3 = "";
    while ( ($_=<ABUF>) ) {
      if (  ! /^\s+$/ ) {
	$last3 = $last2;
	$last2 = $last;
	$last = $_;
	if ( /<\/documentRecord/ ) {
	  $docs++;
	}
	$size += length($_);
      }
    }
    $last = $last3 . $last2 . $last;
    if ( $last !~ /<documentCollection [^>]+>\s*$/
	 && $last !~ /<\/documentRecord>\s*$/ ) {
      print STDERR "Output buffer $BUFFER in unstable state\n";
      if (  $last =~ /<\/documentCollection>/ ) {
	print STDERR "  has been completed, so move manually\n";
      }
      return 0;
    }
    CORE::close(ABUF);
    # now open for append
    if ( ! open(ABUF,">>$BUFFER") ) {
      print STDERR "Cannot open $BUFFER: $!\n";
      return 0;
    }
    select((select(ABUF), $| = 1)[0]);
  }
  1;
}

############################################
#
#  rename output XML buffer file to xml-add/N.xml for some N
#  and create a new output XML buffer file, name is returned;
#  return undef on fatal error, after printing error message
sub save() {
  print ABUF $TRAILER; 
  CORE::close(ABUF);
  #  determine next available name
  if ( ! opendir(XA,"xml-add") ) {
    print STDERR "Cannot opendir xml-add/: $!\n";
    return undef;
  }
  my $latest = 0;
  while ( ($_=readdir(XA)) ) {
    if ( /^([0-9]+).xml$/ ) {
      if ( $latest < int($1) ) {
	$latest = int($1);
      }
    }
  }
  closedir(XA);
  if ( ! $latest ) {
    if ( !opendir(XA,"xml") ) {
      print STDERR "Cannot opendir xml/: $!\n";
      return undef;
    }
    while ( ($_=readdir(XA)) ) {
      if ( /^([0-9]+).xml$/ ) {
	if ( $latest < int($1) ) {
	  $latest = int($1);
	}
      }
    }
    closedir(XA);
  }
  $latest++;
  my $nf = "xml-add/$latest.xml";
  #   now save
  rename($BUFFER,$nf);
  if ( ! &fix() ) {
    return undef;
  }
  return $nf;
}

1;