File Coverage

blib/lib/HTML/TagUtil.pm

Criterion	Covered	Total	%
statement	12	134	8.9
branch	0	80	0.0
condition	0	42	0.0
subroutine	4	18	22.2
pod	7	9	77.7
total	23	283	8.1

package HTML::TagUtil;

##HTML::TagUtil

use 5.008001; #Need 5.8.1.
use strict;
use warnings;

require Exporter;
use AutoLoader qw(AUTOLOAD);

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw(
tagged
opentagged
closetagged
tagpos
string
comment
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); #allow all public methods to export.



our $VERSION = '1.43';

##package variable to set whether to allow hyphens in comments.
##Note: this is a *hack* to avoid having to deal with putting it in the
##invocant's hashref here. (Couldn't figure out how to do it right. :-)
## still looks the same to the user though, if they call the allow_hyphen
##method.
our $Allow_Hyphen = 0;



#$file will someday be available for checking.
#my $file;

###########################
#####Class Constructor#####
###########################

sub new {
   my $self = {
   string       => shift,
   tag          => shift,
   };

   $self->{string      } ||= '';
   $self->{tag         } ||= '';
   # $file = shift;
   bless $self, 'HTML::TagUtil';
   return $self;
}

####################################
##########PRIVATE METHODS###########
####################################

##
## Private method that does the actual matching for tagged.
##

sub _is_fully_tagged {
   my $self = shift;
   my $arg = shift || $_;
   if ($arg =~ /<(([a-zA-Z])+((\s+\w+)=?("?\w+"?)?){0,})( (\/)?)?\s*>.*<\/(([a-zA-Z])+((\s+\w+)=?("?\w+"?)?){0,})( (\/)?)?\s*/) {
      return 1;
   } else {
      return 0;
   }
   $_ = $arg if ($arg);
   $self->{string} = $arg if ($arg);
}

##
## Private method that matches for opentagged.
##

sub _is_open_tagged {
   my $self = shift;
   my $arg = shift || $_;
   if ($arg =~ /<(([a-zA-Z])+((\s+\w+)=?("?\w+"?)?){0,})( (\/)?)?\s*>/) {
      return 1;
   } else {
      return 0;
   }
   $_ = $arg if ($arg);
   $self->{string} = $arg if ($arg);
}

##
## Private method that matches for closetagged.
##

sub _is_close_tagged {
   my $self = shift;
   my $arg = shift || $_;
   if ($arg =~ /<\/([a-zA-Z])+\s*>/) {
      return 1;
   } else {
      return 0;
   }
   $_ = $arg if ($arg);
   $self->{string} = $arg if ($arg);
}

##
## Private method that matches for empty.
##

sub _is_empty_element {
   my $self = shift;
   my $arg = shift || $_;
   if ($arg =~ /<(([a-zA-Z])+((\s+\w+)=?("?.+"?)?){0,})(\s*\/)\s*>/) {
      return 1;
   } else {
      return 0;
   }
   $_ = $arg if ($arg);
   $self->{string} = $arg if ($arg);
}

##
## Private method for comment().
##

sub _is_comment {
   my $self = shift;
   my $arg  = shift || $_;

   if ($Allow_Hyphen) {
      if ($arg =~ //) {
         return 1;
      } else {
         return 0;
      }
   } else {
      if ($arg =~ //) {
         return 1;
      } else {
         return 0;
      }
   }
   $_ = $arg if ($arg);
   $self->{string} = $arg if ($arg);
}

####################################
##########PUBLIC METHODS############
####################################

##
## Get/set methods.
## one for getting/setting the string(currenly does not work), and one for
## gettin/setting whether to allow hyphens in comments.
##

sub string {
   my $self   = shift;
   my $string = $self->{string};
   $string    = shift unless ($self->{string});
   return $self->{string} unless ($string);
}

sub allow_hyphen {
   my $self = shift;
   my $arg  = shift;
   $Allow_Hyphen = $arg;
   return $Allow_Hyphen unless ($arg);
}

sub tagged {
   my $self   = shift;
   my $string = shift || $self->{string} || $_; #string to look at.
   ##check to see if it has both a start tag and an end tag.
   if (_is_fully_tagged ($self->{string})) {
   ##set some variables just in case.
      my $tag       = $1;
      my $element   = $2;
      my $fullattr  = $3;
      my $attrname  = $4;
      my $attrvalue = $5;
      return 1;
   } else {
      return 0;
   }
   $self->{string} = $string if ($string);
   $_ = $self->{string} if ($self->{string});
}

sub opentagged {
   my $self   = shift;
   my $string = shift || $self->{string} || $_; #string to look at.
   ##check to see if it at least has a start tag.
   if (_is_open_tagged ($string)) {
      ##regexp vars.
      my $tag       = $1;
      my $element   = $2;
      my $fullattr  = $3;
      my $attrname  = $4;
      my $attrvalue = $5;
      return 1;
   } else {
      return 0;
   }
   $self->{string} = $string if ($string);
   $_ = $self->{string} if ($self->{string});
}

sub closetagged {
   my $self   = shift;
   my $string = shift || $self->{string} || $_; #string to look at.
   ##check to see if it at least has an end tag.
   if (_is_close_tagged ($string)) {
      ##regexp vars.
      my $tag       = $1;
      my $element   = $2;
      my $fullattr  = $3;
      my $attrname  = $4;
      my $attrvalue = $5;
      return 1;
   } else {
      return 0;
   }
   $self->{string} = $string if ($string);
   $_ = $self->{string} if ($self->{string});
}

sub tagpos {
   my $self = shift;
   my $string = shift || $self->{string} || $_; #string to look at.
   my $tag =    shift || $self->{tag}    || $_; #tag to look for.
   my $offset = shift || 0;                     # offset.
   $tag = '<' . $tag . '>'   if ($tag !~ /(<(([a-zA-Z])+((\s+\w+)=?("?\w+"?)?){0,})( (\/)?)?\s*>|<\/([a-zA-Z])+\s*>)/);
   return index ($string, $tag, $offset) + 1;
   $self->{string} = $string if ($string);
   $self->{tag   } = $tag    if ($tag);
   $_  = $self->{string}     if ($self->{string});
   $_ .= "||$tag"            if ($self->{tag});
}

sub empty {
   my $self =   shift;
   my $string = shift || $self->{string} || $_;
   if (_is_empty_element ($string)) {
      return 1;
      my $tag       = $1;
      my $element   = $2;
      my $fullattr  = $3;
      my $attrname  = $4;
      my $attrvalue = $5;
   } else {
      return 0;
   }
   $self->{string} = $string if ($string);
   $_ = $self->{string} if ($self->{string});
}

sub comment {
   my $self   = shift;
   my $string = shift || $self->{string} || $_;
   if (_is_comment($string)) {
      my $tag       = $1;
      my $element   = $2;
      my $fullattr  = $3;
      my $attrname  = $4;
      my $attrvalue = $5;
      return 1;
   } else {
      return 0;
   }
   $self->{string} = $string if ($string);
   $_ = $self->{string} if ($self->{string});
}



1;

__END__