view release on metacpan or  search on metacpan

bin/alvisXSL  view on Meta::CPAN

    $_ = $xslbuff;
    $xslbuff = "";
  } else {
    if ( !$reading ) {
      #  when opening, have to filter initial stuff
      $reading = 1;
      if ( !$fullhead ) {
	while ( defined($_ = <XIN>) && 
		( /<\?xml/ || /<$GROUPELEMENT/ ) ) {
	  $fullhead .= $_;
	}
	#  discard whatever was in the header element before
	$fullhead =~ s/<$GROUPELEMENT([^>]*)>/<$GROUPELEMENT $GROUPELEMENTEXTRA>/;
	print FOUT $fullhead;
      } else {
	while ( defined($_ = <XIN>) && 
		( /<\?xml/ || /<$GROUPELEMENT/ ) ) {
	  ;
	}
      }
    } else {
      $_ = <XIN>;
      #  clean off end element and close if needed
      if (  /<\/$GROUPELEMENT>/ ) {
	s/<\/$GROUPELEMENT>.*//;
	close(XIN);
	$reading = 0;
      }
    }
  }
  # print STDERR "Starting: $_";
  return $_;
}

sub endofline() {
  if ( eof(XIN) ) {
    return 1;
  }
}

#################################################################
#
#  XSLT routine
#
#  This is kind of stupid,, couldn't find an XSLT + Sax + Perl
#  setup, so we split the records into small chunks and pass
#  them off to a separate XSLT program without SAX.
#
#  Badly needs to be rewritten.
#
#################################################################


#   each call is one execution of XSLTPROC
sub XSLfill {
    my $size = 0;
    #print STDERR "Starting XSLfill\n";

    #   set up new XSLT instance
    #   note we need to set this up with open/waitpid
    #   combination say that one STDOUT is finished before
    #   the next one is started
    my $pid = 0;
    if ($pid = open(FOUT, "|-") ) {
	#  goal is to fill up the XSLTPROC with one XML file
	my $filled = 0;
	if ( eof(XIN) ) {
	    close(XIN);
	    my $nf;
	    my $closed = 1;
	    while ( $closed && ($nf=&nextfile()) ) {
	      #  more input XML
	      $closed = 0;
	      if ( $usegzip ) {
		open(XIN,"zcat $nf |");
	      } elsif ( $usebzip2 ) {
		open(XIN,"bzcat $nf |");
	      } else {
		*XIN = Alvis::Utils::open_file($nf);
		#open(XIN, "<$nf");
	      } 
	      if ( eof(XIN) ) {
		$closed = 1;
		print STDERR "Open on $nf failed\n";
	      }	
	    }
	    if ( $usedir == 0 ) {
	      print STDERR "Reading $nf for $XSL\n";
	    }
	    $reading = 0;
	}
	print FOUT $fullhead;
	$_ = &nextline();
	while ( $_ && $filled==0 ) {
	    if ( /<\/$RECORDELEMENT>/o ) {
		if ( $size>$MAXSIZE ) {
		    # termination condition:  too many records, so
		    #      force a file break
		    $filled = 1;
		    my $ending = $_;
		    $ending =~ s/<\/$RECORDELEMENT>.*/<\/$RECORDELEMENT>\n/o;
		    # print STDERR "FOUT: $ending";
		    print FOUT $ending; 
		    $size += length($ending);
		    #  build a new start for the next file
		    s/.*<\/$RECORDELEMENT>//o;
		    s/.*<$RECORDELEMENT /<$RECORDELEMENT /o;
		    $xslbuff = $_;
		    # print STDERR "Ending file set for $XSL\n";
		    # print STDERR "Restart buff line set to $xslbuff\n==========\n";
		} 
	    } 
	    if ( $filled == 0 ) {
		#  print STDERR "FOUT: $_";
		print FOUT;		
		$size += length($_);
		$_ = &nextline();
		if ( &endofline() ) {
		    #  termination condition:  end of current file
		    #  print STDERR "FOUT: $_\n";
		    print FOUT;