view release on metacpan or  search on metacpan

lib/SGML/StripParser.pm  view on Meta::CPAN

##    02111-1307, USA
##---------------------------------------------------------------------------##

package SGML::StripParser;

use SGML::Parser;
@ISA = qw( SGML::Parser );

$VERSION = "0.01";

use SGML::ISO8859 qw( &sgml2str );
use SGML::Util;

##**********************************************************************##
##	Public Methods
##**********************************************************************##

sub new {
    my $this = new SGML::Parser;
    my $class = shift;
    $this->{'_stripout'}{'_fh'}	   = \*STDOUT;
    $this->{'_stripout'}{'_html'}	   = 0;
    $this->{'_stripout'}{'_url'}	   = '';
    $this->{'_stripout'}{_charset} = '';
    $this->{'_stripout'}{_ignents} = {};
    $this->{'_stripout'}{_incents} = {};

    bless $this, $class;
    $this;
}

sub set_outhandle {
    my $this = shift;
    $this->{'_stripout'}{'_fh'} = shift;
}

sub set_html_mode {
    my $this = shift;
    $this->{'_stripout'}{'_html'} = shift;
}

sub set_charset {
    my $this = shift;
    $this->{'_stripout'}{_charset} = shift;
}

sub set_inc_parm_ents {
    my $this = shift;
    $this->{'_stripout'}{_incents}{@_} = ('INCLUDE') x scalar(@_);
}

sub set_ign_parm_ents {
    my $this = shift;
    $this->{'_stripout'}{_ignents}{@_} = ('IGNORE') x scalar(@_);
}

##**********************************************************************##
##	Redefined SGML::Parser Callback Methods
##**********************************************************************##

sub cdata {
    my $this = shift;
    print { $this->{'_stripout'}{'_fh'} } $_[0];
}

sub char_ref {
    my $this = shift;
    my $val = shift;
    my $str = '';

    if ($this->{'_stripout'}{'_charset'}) {
	$str = pack("C", int($val));
    } else {
	$str = defined($Entity{$val}) ? $Entity{$val} : "&#$val;";
    }

    print { $this->{'_stripout'}{'_fh'} } $str;
    '';
}

sub comment_decl { }

sub end_tag {
    my $this = shift;
    my $gi = lc shift;

    if ($this->{'_stripout'}{'_html'} and
	    $gi eq 'a' and
	    $this->{'_stripout'}{'_url'}) {

	print { $this->{'_stripout'}{'_fh'} }
	      ", <URL:$this->{'_stripout'}{'_url'}>, ";

	$this->{'_stripout'}{'_url'} = '';
    }
}

sub entity_ref {
    my $this = shift;
    my $name = shift;
    my $str  = '';

    if ($this->{'_stripout'}{'_charset'}) {
	$str = sgml2str("&$name;", $this->{'_stripout'}{'_charset'});
    } else {
	$str = defined($Entity{$name}) ? $Entity{$name} : "&$name;";
    }
    print { $this->{'_stripout'}{'_fh'} } $str;

    '';
}

sub ignored_data { }

sub marked_sect_close { }

sub marked_sect_open { }

sub parm_entity_ref {
    my $this = shift;
    my $name = shift;