view release on metacpan or  search on metacpan

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

#
#  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;