# WWW::Extractor::XML::Element::Start # a start tag element # e.g. package WWW::Extractor::XML::Element::Start; use strict; use vars qw(@ISA); use WWW::Extractor::XML::Element; #WWW::Extractor::XML::Element::Start->new($tag, @$attr) #WWW::Extractor::XML::Element::Start->new($tag, %$attr, [@$attr_seq]) @ISA = qw|WWW::Extractor::XML::Element|; sub new { my ($class, $tag, $attr, $attr_seq) = @_; my $self = bless { tag=>lc $tag, has_end=>1 }, $class; # set the attributes varaibles $self->attr($attr, $attr_seq); return $self; } sub type { return 'S'; } #utility function sub evens { return @_[map {$_*2} 0..$#_/2]; } sub attr { my ($self, $attr, $attr_seq) = @_; # access the whole hash if ($#_ > 0) { # we are setting the hash $attr = {} if ! defined $attr; if (ref $attr eq 'ARRAY') { # build hash $attr_seq = [evens(@$attr)]; $attr = {@$attr}; } # ensure lowercase keys %$attr = map { lc $_, $attr->{$_} } (keys %$attr); # create attribute sequence if not sepcified $attr_seq = [sort keys %$attr] if ! defined $attr_seq; # or $#_ < 3; $self->{attr} = $attr; $self->{attr_seq} = $attr_seq; } # get the hash return $self->{attr}; } sub attr_value { my ($self, $attr_key, $v) = @_; # access a single value $attr_key = lc $attr_key; if ($#_ > 1) { # set in hash $self->{attr}{$attr_key} = $v; # AND in the list of keys! if (not grep { $_ eq $attr_key } @{$self->{attr_seq}}) { push @{$self->{attr_seq}}, $attr_key; } } return $self->{attr}{$attr_key}; } sub attr_exists { my ($self, $attr_key) = @_; $attr_key = lc $attr_key; return exists $self->{attr}{$attr_key}; } sub attr_delete { my ($self, $attr_key) = @_; $attr_key = lc $attr_key; # delete from hash delete $self->{attr}{$attr_key}; # AND from the list of keys! @{$self->{attr_seq}} = grep { not $_ eq $attr_key } @{$self->{attr_seq}}; } sub as_string { my $self = shift; my @attr = (); for my $key (@{$self->{attr_seq}}) { my $v = $self->{attr}->{$key}; my $str = HTML::Entities::encode_entities($key); $str .= '="' . HTML::Entities::encode_entities($v) . '"' if defined $v; push @attr, $str; } return '<' . (join ' ', $self->{tag}, @attr) . '>'; } 1