# 002.x -> 003.0: actually use $html->validator_uri, implemented !validate links uri and !validate [html|css] uri, added aliases, added /validate usage # 003.0 -> 003.1: fix uninitialized value warning (check args more carefully) # 003.1 -> 003.1-a: less susceptible to "!validate " # 003.1-a -> 003.2: fix uri encoding (for display->click->revalidate and direct validation) use strict; use warnings; use Xchat qw( :all ); ### NOTE: you will need the following modules installed; some are core use HTML::Entities qw( decode_entities ); use URI::Heuristic qw( uf_uristr ); use WebService::Validator::HTML::W3C (); use WebService::Validator::CSS::W3C (); our %urlencode; use Tie::UrlEncoder; sub prnt { Xchat::print(\@_) } sub say { Xchat::command(join("",'say ',@_)) } ### NOTE: you may or may not want to change these # http timeout use constant TIMEOUT => 10; # aliases for the commands use constant ALIAS_VALID => qw( validate validator valid v ); use constant ALIAS_CSS => qw( css c style s ); use constant ALIAS_HTML => qw( html h markup m ); # character to precede command my $char = qr{!}; # alternatives: qr{`}, (in print hook:) get_info('nick').'[:,-]', etc ### register my $NAME="W3C Validaton", my $VERSION="003"; prnt "\cB$NAME $VERSION\cB by b0at (use /validate)"; my $html = WebService::Validator::HTML::W3C->new(); my $css = WebService::Validator::CSS::W3C->new(); $html->http_timeout( TIMEOUT ); $css->user_agent->timeout( TIMEOUT ); ### User Command hook_command('validate', sub { my ($w, $e) = @_; my $action = lc $w->[1]; if( $action eq 'html' ) { prnt html( $e->[2]); } elsif( $action eq 'css' ) { prnt css( $e->[2]); } else { prnt html( $e->[1]); prnt css( $e->[1]); } return EAT_XCHAT; }, { help_text => 'Usage: validate [html|css] uri' }); # dispatch and alias tables my %commands = ( html => sub { say html($_) for @_ } , css => sub { say css($_) for @_ } , validate => sub { for(@_) { say html($_); say css($_); } } ); my %aliases; $aliases{$_} = 'validate' for ALIAS_VALID; $aliases{$_} = 'html' for ALIAS_HTML; $aliases{$_} = 'css' for ALIAS_CSS; hook_print( $_, sub { my ($bang, $args) = ${$_[0]}[1] =~ /^$char(\S+)\s+([^#]+)/; my $context = get_context(); return EAT_NONE unless $args and $args =~ /\S/ ### 003.1-a and $bang = $aliases{ lc $bang } # de-alias and not $args =~ m!^(|http://)[^/]*example\.com!i; # just spew links if( $args =~ s/^\s*(links|link|l)\s+//i ) { # in that order so we don't get a partial "inks" stuck push my @links, $html->validator_uri . '?uri=' . encode_for_validation($args) if $bang eq 'validate' or $bang eq 'html'; push @links, $css->validator_uri . '?uri=' . encode_for_validation($args) if $bang eq 'validate' or $bang eq 'css'; say "validator links: ",join(" , ",@links) if @links; } # go through with procedure else { # check for 2nd-level command (validate foo uri) if( $bang eq 'validate' and exists $aliases{ my$type=lc +($args=~/^(\S+)/)[0] } ) { $args =~ s/^\S+\s*//; $bang = $aliases{ $type }; } hook_timer(0, sub { set_context( $context ); $commands{ $bang }->( $args ); return Xchat::REMOVE; }) if $args and exists $commands{ $bang }; } return EAT_NONE; }) for "Channel Message", "Channel Msg Hilight"; # only public methods sub html { my $uri = encode_for_validation( shift ); return( "\cBHTML: Unable to validate\cB ", $uri, ': ', $html->validator_error ) unless $html->validate( $uri ); # encode uri for sending my $err = $html->num_errors(); return( "\cBHTML: ", ( $html->is_valid ? 'V' : 'Not v' ), "alid\cB - ", ( $err ? ('Error',($err>1?'s':''),': ',$err,', ') : '' ), $html->validator_uri , '?uri=', $uri ); } sub css { my $uri = encode_for_validation( shift ); $css->validate( uri => $uri ); # return value is mostly worthless my $response = $css->{response}{_content}; ## do these first, make it fast as possible ## # markup error (should be faster than the next one) if( $response =~ /validate your XML document first!/ ) { return "\cBCSS: Unable to validate\cB ", $uri, ' - Validate your XML document first.'; } # I/O, etc error (bound to be a way to speed it up) if( my ($error) = $response =~ m!class="error">\s*
([^:]+):\s*(.+?)
!is ) { ( my $detail = decode_entities( $2 ) ) =~ s/\s+/ /g; return "\cBCSS: Unable to validate\cB ", $uri, ' - ', $error, ": ", $detail; } ## ## # syntax errors/warnings my %issues; while( $response =~ m!