# -*- mode: cperl; c-basic-offset: 8; indent-tabs-mode: nil; -*- =head1 COPYRIGHT # ***** BEGIN LICENSE BLOCK ***** # Version: MPL 1.1 # # The contents of this file are subject to the Mozilla Public License # Version 1.1 (the "License"); you may not use this file except in # compliance with the License. You may obtain a copy of the License # at http://www.mozilla.org/MPL/ # # Software distributed under the License is distributed on an "AS IS" # basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See # the License for the specific language governing rights and # limitations under the License. # # The Original Code is Litmus. # # The Initial Developer of the Original Code is # the Mozilla Corporation. # Portions created by the Initial Developer are Copyright (C) 2006 # the Initial Developer. All Rights Reserved. # # Contributor(s): # Chris Cooper # Zach Lipton # # ***** END LICENSE BLOCK ***** =cut package Litmus::StripScripts; use base qw(HTML::StripScripts::Parser); # Override broken href validation code. sub validate_href_attribute { my ($self, $text) = @_; if ($text) { $self->SUPER::validate_href_attribute or $text =~ m<^((https?|ftp|mailto)://[\w\-\.]{1,100}(?:\:\d{1,5})?(?:/(?:[\w\-.!~*|;:/?=+\$\,%#]|&){0,100})?)$>x ? $1 : undef; } } 1;