escape results from the CPAN

use Digest::MD5 qw(md5_base64);

use Data::Dumper;

# Regexp for escaping URI's
my $escape_rule = "^A-Za-z0-9\-_.!~*'()\/";
my $memoized;

sub handler {

	my $r = shift or Apache2::RequestUtil->request();


	my $uri = $r->uri;
	$uri =~ s/\/$//;

	unless (-f $filename or -d $filename) {
		show_error($r, 404, "404!", "No such file or directory: ".uri_escape($r->uri, $escape_rule));
		return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
	}

	my $doc_pattern = $r->dir_config('GalleryDocFile');
	unless ($doc_pattern) {


					$dirtitle = $dirtitle ? $dirtitle : $file;
					$dirtitle =~ s/_/ /g if $r->dir_config('GalleryUnderscoresToSpaces');

					$tpl_vars{FILES} .=
					     $templates{directory}->fill_in(HASH=> {FILEURL => uri_escape($fileurl, $escape_rule),
										    FILE    => $dirtitle,
										   }
									   );

				}

					my $filetitle = $file;
					$filetitle =~ s/_/ /g if $r->dir_config('GalleryUnderscoresToSpaces');

					$tpl_vars{FILES} .=
					     $templates{file}->fill_in(HASH => {%tpl_vars,
										FILEURL => uri_escape($fileurl, $escape_rule),
										ALT => "Size: $size Bytes",
										FILE => $filetitle,
										TYPE => $type,
										FILETYPE => $filetype,
									       }

					# Debian bug #348724 <http://bugs.debian.org/348724>
					# HTML <img> tag, alt attribute
					my $filetitle = $file;
					$filetitle =~ s/_/ /g if $r->dir_config('GalleryUnderscoresToSpaces');

					my %file_vars = (FILEURL => uri_escape($fileurl, $escape_rule),
							 FILE    => $filetitle,
							 DATE    => $imageinfo->{DateTimeOriginal} ? $imageinfo->{DateTimeOriginal} : '', # should this really be a stat of the file instead of ''?
							 SRC     => uri_escape($uri."/.cache/$cached", $escape_rule),
							 HEIGHT => (grep($rotate==$_, (1, 3)) ? $thumbnailwidth : $thumbnailheight),
							 WIDTH => (grep($rotate==$_, (1, 3)) ? $thumbnailheight : $thumbnailwidth),
							 SELECT  => $select_mode?'<input type="checkbox" name="selection" value="'.$file.'">&nbsp;&nbsp;':'',);
					$tpl_vars{FILES} .= $templates{picture}->fill_in(HASH => {%tpl_vars,
												 %file_vars,

										       );

					if ($media_rss_enabled) {
						my ($content_image_width, undef, $content_image_height) = get_image_display_size($cgi, $r, $width, $height);
						my %item_vars = ( 
							THUMBNAIL => uri_escape($uri."/.cache/$cached", $escape_rule),
							LINK      => uri_escape($fileurl, $escape_rule),
							TITLE     => $file,
							CONTENT   => uri_escape($uri."/.cache/".$content_image_width."x".$content_image_height."-".$file, $escape_rule)
						);
						$tpl_vars{ITEMS} .= $templates{rss_item}->fill_in(HASH => { 
							%item_vars
						});
					}


		$tpl_vars{TITLE} = "Viewing ".$r->uri()." at $image_width x $height";
		$tpl_vars{META} = " ";
		$tpl_vars{RESOLUTION} = $resolution;
		$tpl_vars{MENU} = generate_menu($r);
		$tpl_vars{SRC} = uri_escape(".cache/$cached", $escape_rule);
		$tpl_vars{URI} = $r->uri();
	
		my $exif_mode = $r->dir_config('GalleryEXIFMode');
		unless ($exif_mode) {
			$exif_mode = 'namevalue';

					my ($orig_width, $orig_height, $type) = imgsize($path.$prevpicture);
					my ($thumbnailwidth, $thumbnailheight) = get_thumbnailsize($r, $orig_width, $orig_height);	
					my $imageinfo = get_imageinfo($r, $path.$prevpicture, $type, $orig_width, $orig_height);
					my $cached = get_scaled_picture_name($path.$prevpicture, $thumbnailwidth, $thumbnailheight);
					my %nav_vars;
					$nav_vars{URL}       = uri_escape($prevpicture, $escape_rule);
					$nav_vars{FILENAME}  = $prevpicture;
					$nav_vars{WIDTH}     = $width;
					$nav_vars{PICTURE}   = uri_escape(".cache/$cached", $escape_rule);
					$nav_vars{DIRECTION} = "&laquo; <u>p</u>rev";
					$nav_vars{ACCESSKEY} = "P";
					$tpl_vars{BACK} = $templates{navpicture}->fill_in(HASH => \%nav_vars);
				}
				else {

					my ($orig_width, $orig_height, $type) = imgsize($path.$nextpicture);
					my ($thumbnailwidth, $thumbnailheight) = get_thumbnailsize($r, $orig_width, $orig_height);	
					my $imageinfo = get_imageinfo($r, $path.$nextpicture, $type, $thumbnailwidth, $thumbnailheight);
					my $cached = get_scaled_picture_name($path.$nextpicture, $thumbnailwidth, $thumbnailheight);
					my %nav_vars;
					$nav_vars{URL}       = uri_escape($nextpicture, $escape_rule);
					$nav_vars{FILENAME}  = $nextpicture;
					$nav_vars{WIDTH}     = $width;
					$nav_vars{PICTURE}   = uri_escape(".cache/$cached", $escape_rule);
					$nav_vars{DIRECTION} = "<u>n</u>ext &raquo;";
					$nav_vars{ACCESSKEY} = "N";

					$tpl_vars{NEXT} = $templates{navpicture}->fill_in(HASH => \%nav_vars);
					$tpl_vars{NEXTURL}   = uri_escape($nextpicture, $escape_rule);
				}
				else {
					$tpl_vars{NEXT} = "&nbsp;";
					$tpl_vars{NEXTURL}   = '#';
				}

		my $scaleable = 0;
		my @sizes = split (/ /, $r->dir_config('GallerySizes') ? $r->dir_config('GallerySizes') : '640 800 1024 1600');
		foreach my $size (@sizes) {
			if ($size<=$original_size) {
				my %sizes_vars;
				$sizes_vars{IMAGEURI} = uri_escape($r->uri(), $escape_rule);
				$sizes_vars{SIZE}     = $size;
				$sizes_vars{WIDTH}    = $size;
				if ($width == $size) {
					$tpl_vars{SIZES} .= $templates{scaleactive}->fill_in(HASH => \%sizes_vars);
				}

			}
		}

		unless ($scaleable) {
			my %sizes_vars;
			$sizes_vars{IMAGEURI} = uri_escape($r->uri(), $escape_rule);
			$sizes_vars{SIZE}     = $original_size;
			$sizes_vars{WIDTH}    = $original_size;
			$tpl_vars{SIZES} .= $templates{scaleactive}->fill_in(HASH => \%sizes_vars);
		}

		$tpl_vars{IMAGEURI} = uri_escape($r->uri(), $escape_rule);

		if ($r->dir_config('GalleryAllowOriginal')) {
			$tpl_vars{SIZES} .= $templates{orig}->fill_in(HASH => \%tpl_vars);
		}

		my @slideshow_intervals = split (/ /, $r->dir_config('GallerySlideshowIntervals') ? $r->dir_config('GallerySlideshowIntervals') : '3 5 10 15 30');
		foreach my $interval (@slideshow_intervals) {

			my %slideshow_vars;
			$slideshow_vars{IMAGEURI} = uri_escape($r->uri(), $escape_rule);
			$slideshow_vars{SECONDS} = $interval;
			$slideshow_vars{WIDTH} = ($width > $height ? $width : $height);

			if ($cgi->param('slideshow') && $cgi->param('slideshow') == $interval and $nextpicture) {
				$tpl_vars{SLIDESHOW} .= $templates{intervalactive}->fill_in(HASH => \%slideshow_vars);

			unless ((grep $cgi->param('slideshow') == $_, @slideshow_intervals)) {
				show_error($r, 200, "Invalid interval", "Invalid slideshow interval choosen");
				return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
			}

			$tpl_vars{URL} = uri_escape($nextpicture, $escape_rule);
			$tpl_vars{WIDTH} = ($width > $height ? $width : $height);
			$tpl_vars{INTERVAL} = $cgi->param('slideshow');
			$tpl_vars{META} .=  $templates{refresh}->fill_in(HASH => \%tpl_vars);

		}


		if ("$root_path$uri" eq $menuurl) {
			$menu .= "$linktext  / ";
		}
		else {
			$menu .= "<a href=\"".uri_escape($menuurl, $escape_rule)."\">$linktext</a> / ";
		}

	}

	if (-f $filename) {
		$menu .= $picturename;
	}
	else {

		if ($r->dir_config('GallerySelectionMode') && $r->dir_config('GallerySelectionMode') eq '1') {
			$menu .= "<a href=\"".uri_escape($menuurl, $escape_rule);
			$menu .= "?select=1\">[select]</a> ";
		}
	}

	return $menu;

view all matches for this distribution

Apache-HeavyCGI

2 results

    }
  } else {
    $checked = $arg{checked};
  }
  sprintf(qq{<input type="checkbox" name="%s" value="%s"%s />},
	  $self->escapeHTML($name),
	  $self->escapeHTML($value),
	  $checked ? qq{ checked="checked"} : ""
	 );
}

# pause_1999::main


  my %sel;
  @sel{@sel} = ();
  my @m;

  $name = $self->escapeHTML($name);

  my $haslabels = exists $arg{labels};
  my $linebreak = $arg{linebreak} ? "<br />" : "";

  for my $v (@{$arg{values} || []}) {
    push(@m,
	 sprintf(
		 qq{<input type="checkbox" name="%s" value="%s"%s />%s%s},
		 $name,
		 $self->escapeHTML($v),
		 exists $sel{$v} ? qq{ checked="checked"} : "",
		 $haslabels ? $arg{labels}{$v} : $self->escapeHTML($v),
		 $linebreak,
		)
	);
  }
  join "", @m;
}

sub escapeHTML {
  my($self, $what) = @_;
  return unless defined $what;
  my %escapes = qw(& &amp; " &quot; > &gt; < &lt;);
  $what =~ s[ ([&"<>]) ][$escapes{$1}]xg; # ]] cperl-mode comment
  $what;
}

sub file_field {
  my($self) = shift;

      or defined($checked = $sel)
	  or defined($checked = $arg{default})
	      or $checked = "";
  # some people like to check the first item anyway:
  #	  or ($checked = $values->[0]);
  my $escname=$self->escapeHTML($name);
  my $linebreak = $arg{linebreak} ? "<br />" : "";
  my @m;
  for my $v (@$values) {
    my $escv = $self->escapeHTML($v);
    if ($DEBUG) {
      warn "escname undef" unless defined $escname;
      warn "escv undef" unless defined $escv;
      warn "v undef" unless defined $v;
      warn "\$arg{labels}{\$v} undef" unless defined $arg{labels}{$v};

  @sel{@sel} = ();
  my @m;
  push @m, sprintf qq{<select name="%s"%s%s>}, $name, $size, $multiple;
  $arg{values} = [$arg{value}] unless exists $arg{values};
  for my $v (@{$arg{values} || []}) {
    my $escv = $self->escapeHTML($v);
    push @m, sprintf qq{<option%s value="%s">%s</option>\n},
	exists $sel{$v} ? q{ selected="selected"} : "",
	    $escv,
		$haslabels ? $self->escapeHTML($arg{labels}{$v}) : $escv;
  }
  push @m, "</select>";
  join "", @m;
}

sub submit {
  my($self,%arg) = @_;
  my $name = $arg{name} || "";
  my $val  = $arg{value} || $name;
  sprintf qq{<input type="submit" name="%s" value="%s" />},
      $self->escapeHTML($name),
	  $self->escapeHTML($val);
}

# pause_1999::main
sub textarea {
  my($self,%arg) = @_;

  my $val  = $req->param($name) || $arg{default} || $arg{value} || "";
  my($r)   = exists $arg{rows} ? qq{ rows="$arg{rows}"} : '';
  my($c)   = exists $arg{cols} ? qq{ cols="$arg{cols}"} : '';
  my($wrap)= exists $arg{wrap} ? qq{ wrap="$arg{wrap}"} : '';
  sprintf qq{<textarea name="%s"%s%s%s>%s</textarea>},
      $self->escapeHTML($name),
	  $r, $c, $wrap, $self->escapeHTML($val);
}

# pause_1999::main
sub textfield {
  my($self) = shift;

	  defined($val = $arg{default}) or
	      ($val = "");

  sprintf qq{<input type="$fieldtype"
 name="%s" value="%s"%s%s />},
      $self->escapeHTML($name),
	   $self->escapeHTML($val),
	       exists $arg{size} ? " size=\"$arg{size}\"" : "",
		   exists $arg{maxlength} ? " maxlength=\"$arg{maxlength}\"" : "";
}

sub uri_escape {
  my Apache::HeavyCGI $self = shift;
  my $string = shift;
  return "" unless defined $string;
  require URI::Escape;
  my $s = URI::Escape::uri_escape($string, '^\w ');
  $s =~ s/ /+/g;
  $s;
}

sub uri_escape_light {
  my Apache::HeavyCGI $self = shift;
  require URI::Escape;
  URI::Escape::uri_escape(shift,q{<>#%"; \/\?:&=+,\$}); #"
}

1;

=head1 NAME

view all matches for this distribution

Apache-JAF

1 match

lib/Apache/JAF/Util.pm view on Meta::CPAN

use Apache;
use Apache::Util ();

### Content

sub escape_uri {
  my $uri = shift;
  return $uri && Apache::Util::escape_uri($uri);
}

sub unescape_uri {
  my $uri = shift;
  return $uri && Apache::Util::unescape_uri($uri);
}

sub escape_html {
  my $html = shift;
  return $html && Apache::Util::escape_html($html);
}

sub valid_html {
  my $string = shift;
  $string = escape_html($string) if $ENV{MOD_PERL};
  $string =~ s/\</\&lt;/g;
  $string =~ s/\>/\&gt;/g;
  $string =~ s/\n{2,}/<p>/sg;
  $string =~ s/\n/<br>/sg;
  $string = '<p>' . $string;

view all matches for this distribution

Apache-LangPrefCookie

1 match

t/htdocs/langprefcookie/switch.html view on Meta::CPAN

<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-15">
<title>Switch Lang</title>
<script type="text/javascript">
function Set_Cookie( value ) {
  document.cookie = "prefer-language=" + escape( value );
}
</script>
</head>

<body>

view all matches for this distribution

Apache-LogFormat-Compiler

1 match

t/Req2PSGI.pm view on Meta::CPAN

    open $input, "<", \$content;
    $req->content_length(length $content)
        unless defined $req->content_length;

    my $env = {
        PATH_INFO         => URI::Escape::uri_unescape($uri->path || '/'),
        QUERY_STRING      => $uri->query || '',
        SCRIPT_NAME       => '',
        SERVER_NAME       => $uri->host,
        SERVER_PORT       => $uri->port,
        SERVER_PROTOCOL   => $req->protocol || 'HTTP/1.1',

view all matches for this distribution

Apache-LoggedAuthDBI

1 match

DBI.pm view on Meta::CPAN

	];

	my $quote = $info->[0];
	foreach (@id) {			# quote the elements
	    next unless defined;
	    s/$quote/$quote$quote/g;	# escape embedded quotes
	    $_ = qq{$quote$_$quote};
	}

	# strip out catalog if present for special handling
	my $catalog = (@id >= 3) ? shift @id : undef;

DBI.pm view on Meta::CPAN

  $str = neat($value, $maxlen);

Return a string containing a neat (and tidy) representation of the
supplied value.

Strings will be quoted, although internal quotes will I<not> be escaped.
Values known to be numeric will be unquoted. Undefined (NULL) values
will be shown as C<undef> (without quotes).

If the string is flagged internally as utf8 then double quotes will
be used, otherwise single quotes are used and unprintable characters

DBI.pm view on Meta::CPAN


B<Caveat>: The underscore ('_') is valid and often used in SQL identifiers.
Passing such a value to a search pattern argument may return more rows than
expected!
To include pattern characters as literals, they must be preceded by an
escape character which can be achieved with

  $esc = $dbh->get_info( 14 );  # SQL_SEARCH_PATTERN_ESCAPE
  $search_pattern =~ s/([_%])/$esc$1/g;

The ODBC and SQL/CLI specifications define a way to change the default

view all matches for this distribution

Apache-MP3-Skin

2 results


use strict;
use HTML::Template;
use Apache::Constants qw(:common REDIRECT HTTP_NO_CONTENT DIR_MAGIC_TYPE);
use constant COVERIMAGE   => 'cover.jpg';
use CGI qw(param escape);
use Apache::MP3::Playlist;
use Apache::File ();
use Apache::URI ();
use File::Basename 'dirname','basename';

  if ($changed) {
    my $c = CGI::Cookie->new(-name  => 'playlist',
			     -value => \@playlist);
    tied(%{$r->err_headers_out})->add('Set-Cookie' => $c);
    (my $uri = $r->uri) =~ s!playlist\.m3u$!!;
    $self->path_escape(\$uri);
    $r->err_header_out(Location => $uri);
    return REDIRECT;
  }

  $self->playlist(@playlist);

  	    $params{$_} = "0";
    } elsif (($p eq "is_mp3") && (not $on_playlist)) {
  	    $params{$_} = "1";
    } elsif ($p eq "fetch_url") {
        if ($self->download_ok) {
        	$params{$_} = ($on_playlist) ? escape($song_file) : $uri.escape($song_file);
		} else {
		    $params{$_} = "";
		}
    } elsif (($p eq "add_to_playlist_url") && (not $on_playlist)) {
        $params{$_} = $self->r->uri."playlist.m3u?Add+to+Playlist=1;file=".$uri.escape($song_file);
	} elsif (($p eq "remove_from_playlist_url") && ($on_playlist)) {
	    $params{$_} = $self->r->uri."playlist.m3u?Clear+Selected=1;playlist=1;file=".escape($song_file);
    } elsif ($p eq "play_url") {
        if ($self->stream_ok) {
            $params{$_} = ($on_playlist) ?  escape($song_file)."?play=1;" : $uri . escape($song_file) . "?play=1;";
            $params{$_} =~ s/(\.[^.]+)?$/.m3u?play=1/;
		} else {
		    $params{$_} = "";
        }
	} elsif ($p eq "checkbox") {


=over 4

=item <TMPL_VAR [ESCAPE="HTML" | ESCAPE="URL"] NAME=variable>

Tag is replace with the value of variable and optionally escaped making it html
or url compliant.

=item <TMPL_IF NAME=variable> html here 
	[ <TMPL_ELSE>  more here ] 
</TMPL_IF>

view all matches for this distribution

Apache-MP3

5 results

  $self->{'suffixes'} = [ qw(.ogg .OGG .wav .WAV .mp3 .MP3 .mpeg .MPEG .m4a .mp4 .m4p)];

  return $self;
}

sub x {  # maketext plus maybe escape.  The "x" for "xlate"
  my $x = (my $lh = shift->{'lh'})->maketext(@_);
  $x =~ s/([^\x00-\x7f])/'&#'.ord($1).';'/eg
	if $x =~ m/[^\x00-\x7f]/ and $lh->must_escape;
  return $x;
}

sub lh { return shift->{lh} }  # language handle

  # otherwise don't know how to deal with this
  $self->r->log_reason('Invalid parameters -- possible attempt to circumvent checks.');
  return FORBIDDEN;
}

sub escape {
  my $uri = CGI::escape(shift);
  # unescape slashes so directories work right with mozilla
  $uri =~ s!\%2F!/!gi;
  return $uri;
}

# this generates the top-level directory listing

  my $local = $self->playlocal_ok && $self->is_local;
  $self->shuffle($urls) if $shuffle;
  $r->print("#EXTM3U$CRLF");
  my $stream_parms = $self->stream_parms;
  foreach (@$urls) {
    $self->path_escape(\$_);
    my $subr = $r->lookup_uri($_) or next;
    my $file = $subr->filename;
    my $type = $subr->content_type;
    my $data = $self->fetch_info($file,$type);
    my $format = $self->r->dir_config('DescriptionFormat');

  my ($path,$links) = ('',br());
  my $current_style = "line-height: 1.2; font-weight: bold; color: red;";
  my $parent_style  = "line-height: 1.2; font-weight: bold;";

  for (my $c=0; $c < @components-1; $c++) {
    $path .= escape($components[$c]) ."/";
    my $idt = $c * $indent;
    my $l = a({-href=>$path},$components[$c] || ($home.br({-clear=>'all'})));
    $links .= div({-style=>"text-indent: ${idt}em; $parent_style"},
		  font({-size=>'+1'},$l))."\n";
  }

  unshift @components,'' unless @components;
  my $path;
  my $links = br . '&nbsp;&nbsp;' ; #start_h1();
  for (my $c=0; $c < @components-1; $c++) {
    $links .= '&nbsp;/&nbsp;' if $path;
    $path .= escape($components[$c]) . "/";
    $links .= a({-href=>$path},font({-size=>'+1'},$components[$c] || $home));
  }
  $links .= '&nbsp;/&nbsp;' if $path;
  $links .= font({-size=>'+1',-style=>'color: red'},($components[-1] || $home));
  $links .= br;

  my $path;
  my $links = br . '&nbsp;&nbsp;' ; #start_h1();
  my $arrow = $self->arrow_icon;
  for (my $c=0; $c < @components-1; $c++) {
    $links .= '&nbsp;' . img({-src=>$arrow}) if $path;
    $path .= escape($components[$c]) . "/";
    $links .= '&nbsp;' . a({-href=>$path},$components[$c] || $home);
  }
  $links .= '&nbsp;' . img({-src=>$arrow}) if $path;
  $links .= "&nbsp;". ($components[-1] || $home);
  $links .= br;#end_h1();

    $subdirpath = $self->r->lookup_uri($subdir)->filename;
  }
  my $nb = '&nbsp;';
  (my $title = $subdir) =~ s/\s/$nb/og;  # replace whitespace with &nbsp;
  $title =~ s!^.*(/[^/]+/[^/]+)$!...$1!;  # if dir is fully pathed, only keep 2 parts for title
  my $uri = escape($subdir);
  my $result;

  my($atime,$mtime) = (stat($subdirpath))[8,9];

  my($last,$times);

  my $nb = '&nbsp;';
  my $dot3 = '.m3u|.pls';
  my($param) = $playlist =~ /\.m3u$/ ? '?play=1' : '';
  (my $title = $playlist) =~ s/$dot3$//;
  $title =~ s/\s/$nb/og;
  my $url = escape($playlist) . $param;

  return p(a({-href => $url},
             img({-src => $self->playlist_icon,
                  -align => 'ABSMIDDLE',
                  -class => 'subdir',

  my $self = shift;
  my $txtfile = shift;
  my $nb = '&nbsp;';
  (my $title = $txtfile) =~ s/\.(txt|nfo)$//;
  $title =~ s/\s/$nb/og;
  my $url = escape($txtfile);

  return p(a({-href => $url},
             img({-src => "/icons/text.gif", # $self->playlist_icon,
                  -align => 'ABSMIDDLE',
                  -class => 'subdir',

  my $self = shift;
  my ($song,$info,$count,$mode) = @_;

  my $song_title = sprintf("%3d. %s", $count, $info->{title} || $song);

  my $url = escape($song);
  #my $url = $song;

  warn $mode if DEBUG;

  (my $play = $url) =~ s/(\.[^.]+)?$/.m3u?play=1/;

	    track  => $comments->{tracknumber} || $comments->{TRACKNUMBER} || '',
	    year   => $comments->{year}   || $comments->{YEAR}   || '',
	   )
}

# a limited escape of URLs (does not escape directory slashes)
sub path_escape {
  my $self = shift;
  my $uri = shift;
  $$uri =~ s!([^a-zA-Z0-9_/.-])!uc sprintf("%%%02x",ord($1))!eg;
}

sub cd_list_icon  {
  my $self   = shift;
  my $subdir = shift;
  my $image = $self->r->dir_config('CoverImageSmall') || COVERIMAGESMALL;
  my $directory_specific_icon = $self->r->filename."/$subdir";
  my $uri = escape($subdir)."/$image";

  # override the icon filename if the dir is fully pathed
  if (substr($subdir, 0, 1) eq "/") {
    $directory_specific_icon = $self->r->lookup_uri($subdir)->filename;
  }

album and artist merged together; and I<duration>, which contains the
duration of the song expressed as hours, minutes and seconds.  Other
fields are taken directly from the MP3 tag, but are downcased (for
convenience to other routines).

=item Apache::MP3->path_escape($scalarref)

This is a limited form of CGI::escape which does B<not> escape the
slash symbol ("/").  This allows URIs that correspond to directories
to be escaped safely.  The escape is done inplace on the passed scalar
reference.


=item @fields = $mp3->fields

view all matches for this distribution

Apache-Module

1 match


use mod_perl 1.16;
use strict;

use File::Basename 'basename';
use Apache::Util qw(escape_html);
use Apache::Module ();
use Apache::Constants qw(:common :override :args_how :server);

$Apache::ModuleDoc::VERSION = '1.02';
my $ServerVersion;

		push @or, $key if $pc->req_override & $AllowOverride{$key};
	    }
	    $override = join " or ", @or;
	}
    }
    return(escape_html($retval), $override);
}

sub start_html {
    my $name = shift;
    print <<EOF;

    my($r, $modp) = @_;
    my @cmds = sort by_name @{ $modp->commands };

    print "<UL>\n";
    for my $cmd (@cmds) {
	my $text = escape_html($cmd);
	(my $name = $cmd) =~ s/[<>]/./g;

	print qq(<LI><A HREF="#$name">$text</A>\n);
    }
    print "</UL>\n<HR>\n";

    my($r, $modp) = @_;
    my @cmds = sort by_name @{ $modp->commands };
    (my $module = $modp->name) =~ s/\.c$//;

    for my $cmd (@cmds) {
	my $text = escape_html($cmd);
	my $cmd_rec = $modp->cmds->find($cmd);
	(my $name = $cmd) =~ s/[<>]/./g;

	my($context,$override) = overrides($modp, $cmd_rec);
	my $args_how = $cmd_rec->args_how;

	}
	$status = "Base" if $module eq "http_core";

	print qq(<H2><A name="$name">$text directive</A></H2><P>\n);
	print "Description: ", 
               escape_html($cmd_rec->errmsg), "<br>";
	splain(Syntax     => "$text <EM>$syntax</EM> ($args_how)");
	splain(PerlSyntax => "<tt>$perl_syntax</tt>");
	splain(Context    => $context);
	splain(Override   => $override);
	splain(Status     => $status);

view all matches for this distribution

Apache-PSP

3 results

# %Handler    - pointers to subroutines for psp pages
# %type       - subroutines for handling output types

use vars qw (%tags %global_tags $page $parsefile $frags $outputflag $perlflag
	     $handlerflag $package %tagdata %Cache %Handler %type $lineno
	     $top_package $escapeflag $space
	    );

use vars qw(%QUERY %CGI %FILENAMES %AUTH %COOKIE);

%tags = map {$_ => 1} 
	( "tag", "loop", "if", "else", "elseif", "perl", "fetch", "output", 
	"handler", "return", "include", "pspescape" );

sub cleanup
{
  no strict 'refs';
  push(@{$top_package . "::cleanup_handler"}, shift);


  no strict 'refs';

  default($text);

  if ($escapeflag || $tagname eq $tagdata{name} || $perlflag)
  {
    text($space . $text);
    $space = "";
    return;
  }

  my $tagname = lc(shift);
  my $text = shift;

  default($text);

  if (($escapeflag && $tagname ne "pspescape") ||
      ($tagname eq $tagdata{name}) ||
      ($handlerflag && $tagname ne "handler") ||
      (!$handlerflag && $perlflag && $tagname ne "perl"))
  {
    text($space . $text);

# handles all text that is read by the parser
sub text
{
  my ($text) = @_;

  if (!$escapeflag && $text =~ /^\s*$/s)
  {
    $space = $text;
    return;
  }
  if ($perlflag)

{
  $outputflag--;
  $outputflag = 0 if $outputflag < 0;  
}

sub pspescape 
{
  $escapeflag++;
}

sub pspescape_ 
{
  $escapeflag--;
  $escapeflag = 0 if $escapeflag < 0;  
}

sub include 
{
  my ($attr) = @_;

view all matches for this distribution

Apache-PageKit

6 results

lib/Apache/PageKit.pm view on Meta::CPAN

    $apr->pnotes(r_args => $args);
  }

  if($exclude_param && @$exclude_param){
    my %exclude_param_hash = map {$_ => 1} @$exclude_param;
    return join ('&', map { Apache::Util::escape_uri("$_") ."=" . Apache::Util::escape_uri(defined($args->{$_}) ? $args->{$_} : "")}
       grep {!exists $exclude_param_hash{$_}} keys %$args);
  } else {
    return join ('&', map { Apache::Util::escape_uri("$_") ."=" . Apache::Util::escape_uri(defined($args->{$_}) ? $args->{$_} : "")} keys %$args);
  }
}

sub update_session {
  my ($pk, $auth_session_id) = @_;

lib/Apache/PageKit.pm view on Meta::CPAN

  }
#  $view->param(pkit_selfurl => $pkit_selfurl);

  $output_param_object->param(pkit_hostname => $host);

#  my $pkit_done = Apache::Util::escape_uri($apr->param('pkit_done') || $uri_with_query);
  my $pkit_done = $apr->param('pkit_done') || $uri_with_query;

#  $pkit_done =~ s/"/\%22/g;
#  $pkit_done =~ s/&/\%26/g;
#  $pkit_done =~ s/\?/\%3F/g;

lib/Apache/PageKit.pm view on Meta::CPAN


  $done =~ s/ /+/g;

  if(my @pkit_messages = $apr->param('pkit_messages')){
    for my $message (@pkit_messages){
      $done .= "&pkit_messages=" . Apache::Util::escape_uri($message);
    }
  }
  if(my @pkit_error_messages = $apr->param('pkit_error_messages')){
    for my $message (@pkit_error_messages){
      $done .= "&pkit_error_messages=" . Apache::Util::escape_uri($message);
    }
  }

  $apr->headers_out->set(Location => "$done");
  return 1;

view all matches for this distribution

Apache-Perldoc

2 results

lib/Apache/Perldoc.pm view on Meta::CPAN

directly to the documentation for that module. Selecting the bookmark
without having anything highlighted will result in a pop-up dialog in
which you can type a module name.

 javascript:Qr=document.getSelection();if(!Qr){void(Qr=prompt('Module
 name',''))};if(Qr)location.href='http://localhost/perldoc/'+escape(Qr)

Note that that's all one line, split here for display purposes. I know
this works in Netscape and Mozilla. Can't vouch for IE.

=head1 LICENSE

view all matches for this distribution

Apache-Pod

1 match

lib/Apache/Pod/HTML.pm view on Meta::CPAN

    my $to = shift;
    my $section = shift;

    my $link = $to;

    return uri_escape( $link );
}

=head1 AUTHOR

Andy Lester C<< <andy@petdance.com> >>, adapted from Apache::Perldoc by

view all matches for this distribution

Apache-PrettyPerl

1 match

	foreground	=> 'silver',
	background	=> 'black',
	links		=> 'white',
	
	comment	=> 'navy',
	escaped	=> 'purple',
	keyword	=> 'yellow',
	number	=> 'red',
	pod	=> 'navy',
	regex	=> 'red',
	string	=> 'red',

}
EOF

	my %defaults =
	(
		escaped	=> 'purple',
		keyword	=> 'yellow',
		number	=> 'red',
		pod	=> 'navy',
		regex	=> 'red',
		string	=> 'red',


	my $retval = qq#\n<p><a href="$uri?download">Download <code>$file</code></a></p>\n#;
	return ($retval);
}

sub html_escape
{
	$_ = shift;

	s/&/&amp;/g;
	s/>/&gt;/g;

sub string2html
{
	my $string = shift;
	my $retval = '';

	$string = html_escape ($string);

	if ($string =~ m/^(&quot;|&lt;&lt;[^']|qq.)/)
	{
		$retval = $&;
		$string = $';

			{
				$retval .= qq#<span class="variable">$match</span>#;
			}
			else
			{
				$retval .= qq#<span class="escaped">$match</span>#;
			}
		}
		
		$retval .= $string;
		$retval = qq#<span class="string">$retval</span>#;
	}
	elsif ($string =~ m/^('|&lt;&lt;'|q[^qxr])/)
	{
		$retval = $string;
		$retval =~ s#\\[\\']#<span class="escaped">$&</span>#g;
		$retval = qq#<span class="string">$retval</span>#;
	}
	elsif ($string =~ m/^#/)
	{
		$retval = qq#<span class="comment">$string</span>#;

}

sub regex2html
{
	$_ = shift;
	$_ = html_escape ($_);

	s#
		\((?:\?(?:[=!:]|&lt;[=!]|&gt;))?
	|	\[\^?
	|	\\(?:\&\w+;|.)
	|	[\*\+\?\)\]\|]
	#<span class="escaped">$&</span>#gx;

	$_ = qq#<span class="regex">$_</span>#;
	
	return ($_);
}

			$Buffer[$BufferFill] = qq#$match#;
			$BufferFill++;
		}
	}

	$_ = html_escape ($processed . $yet_to_process);

	my $re;
	{
		my $temp = '';
		$temp = join ('|', map { quotemeta ($_) } (@KeyWords));


	s#\b($re)\b#<span class="keyword">$1</span>#g;
	
	s#$alrm!STRING!$alrm(\d+)$alrm#string2html ($Buffer[$1])#ge;
	s#$alrm!REGEX!$alrm(\d+)$alrm#regex2html ($Buffer[$1])#ge;
	s#$alrm!(\w+)!$alrm(\d+)$alrm#"<span class=\"\L$1\E\">" . html_escape ($Buffer[$2]) . '</span>'#ge;

	return (qq#\n<div class="source">\n$_</div>\n#);
}

__END__

view all matches for this distribution

Apache-ProxyRewrite

2 results

ProxyRewrite.pm view on Meta::CPAN

use Apache::Constants qw(OK AUTH_REQUIRED DECLINED DONE);
use Apache::Log;
use Apache::URI;
use LWP::UserAgent;
use Socket;
use URI::Escape qw(uri_unescape);


# Global variables
$Apache::ProxyRewrite::VERSION = '0.17';
$Apache::ProxyRewrite::PRODUCT = 'ProxyRewrite/' .

ProxyRewrite.pm view on Meta::CPAN

    } elsif ($k =~ /Host/) {
      ($v) = ($remote_location =~ m!://([^/]+)!);
    } elsif ($k =~ /User-Agent/) {
      $client_agent = $v;
    }
    $v = uri_unescape($v);
    $request->header($k,$v);	
    $r->log->debug("fetch: IN-MOD $k: $v");
  }

  # If we have authorization information and it isn't already filled in

view all matches for this distribution

Apache-RSS

5 results

lib/Apache/RSS.pm view on Meta::CPAN

use XML::RSS;
use DirHandle;
use URI;
use DynaLoader ();
use Apache::ModuleConfig;
use Apache::Util qw(escape_html);
use vars qw($VERSION);

$VERSION = '0.05';

if($ENV{MOD_PERL}) {

lib/Apache/RSS.pm view on Meta::CPAN

    my $language = $cfg->{'RSSLanguage'} || "en-us";
    my $encoding = $cfg->{'RSSEncoding'} || "UTF-8";

    my $rss = XML::RSS->new(version => '0.91', encoding => $encoding);
    $rss->channel(
	title => escape_html($channel_title),
	link => $base,
	description => escape_html($channel_description),
	webMaster => $r->server->server_admin,
	pubDate => $req_time->datetime,
	lastBuildDate => $req_time->datetime,
	copyright => escape_html($copyright),
	language => $language,
    );
    foreach my $item (@$items) {
	$rss->add_item(
	    link => $item->link,
	    title => escape_html($item->title),
	);
    }
    return $rss;
}

view all matches for this distribution

Apache-Recorder

1 match

Changes view on Meta::CPAN

Revision history for Perl extension Apache::Recorder.

0.07 Sun Oct 13, 1:00:00 2002
        - Changed the PREREQ_PM value for the CGI::Cookie key to 1.21.
	  CGI::Cookie 1.18 has a bug in the parse method -- unescape
	  is erroneously attributed to CGI, rather than CGI::Util,
	  and this was causing one of the tests in t/get_id.t to fail.
	- Updated the description in Recorder.pm to include a more
	  generic statement of what Apache::Recorder does.

view all matches for this distribution

Apache-Request-I18N

1 match

I18N.pm view on Meta::CPAN

	# 
	# This used to call Apache->args, but it doesn't behave so well with
	# ill-formed query strings.  Apache::Request->query_params would be
	# nice, but it was introduced in 1.3, and Debian sarge only has 1.1.
	my %args = map { defined $_ ? $_ : '' }
			map Apache::unescape_url_info(defined $_ ? $_ : ''),
				map /^([^=]*)(?:=(.*))?/,
					split /[&;]+/ => $self->query_string;

	# Extract the Content-Type charset for x-www-form-urlencoded
	my ($is_urlenc, $charset);

view all matches for this distribution

Apache-ReverseProxy

2 results

lib/Apache/ReverseProxy.pm view on Meta::CPAN

and allows you to specify comma separated options for the mapping.
The only option that is currently supported is the B<exact> parameter,
which will make the reverse proxy use exact matching for the first
parameter instead of using regular expressions.  This feature
is convenient when the first parameter contains characters
that may need to be escaped or quotemeta'ed.  Exact options are
evaluated first.  If there isn't an exact match, regular expression
matches are performed.  Configuration files may contain comments,
which start with a pound sign.  For example:

 /news/ http://www.news.com/

view all matches for this distribution

Apache-RewritingProxy

1 match

RewritingProxy.pm view on Meta::CPAN

  my $r = shift;
  my $string = shift;
  return($string);
  }

# We just escape the necessary crap in the URL we are given so that
# it can then be compared in a regex and all will be happy
sub regexEscape
  {
  my $url = shift;
  # This silly little regex fixes (*&?+|) in the URL for me.

view all matches for this distribution

Apache-Roaming

2 results

lib/Apache/Roaming.pm view on Meta::CPAN

=cut

sub handler ($$) {
    my($class, $r) = @_;

    my $file = File::Spec->canonpath(URI::Escape::uri_unescape($r->filename()));

    if ($file=~/IMAP$/) {
        my $addon=$r->the_request();
        $addon=~s/IMAP\s(.*)\s.*$/$1/;
        $file="$file%20$addon";

view all matches for this distribution

Apache-SSI

3 results

lib/Apache/SSI.pm view on Meta::CPAN

#            
#        } elsif ( /\G(\\\\)+/gc ) {
#            $out .= '\\' x (length($1)/2);
#            
#        } elsif ( /\G\\([^\$])/gc ) {
#            $out .= &escape_char($1);
#            
#        } elsif ( /\G\$(\w+)/gc ) {
#            $out .= &lookup($1);
#        
#        } elsif ( /\G\$\{(\w+)\}/gc ) {

view all matches for this distribution

Apache-SdnFw

10 results

	my $msg = shift;

	# make sure we do not report errors to ourself, otherwise we go into a circular loop!
	# if this was a croak, it means that we should record this error into the main error
	# recording system
	my $error = $s->escape($msg);
	my $employee = '<employee>'.$s->escape("$s->{employee_id} $s->{employee}{name}").
		'</employee>' if ($s->{employee_id});
	my $in = $s->escape(Data::Dumper->Dump([\%{$s->{in}}]));
	my $env = $s->escape(Data::Dumper->Dump([\%{$s->{env}}]));
	my $session = $s->escape(Data::Dumper->Dump([\%{$s->{session_data}}]));
	my $uri = $s->escape($s->{uri});

	my $xml = <<END;
<?xml version="1.0" encoding="UTF-8"?>
<error>
	<message>$error</message>

 my $html = $s->html_radio($key,$value,[$checked],[$desc],[$id]);

=cut

	my $s = shift;
	my $key = $s->escape(shift);
	my $value = $s->escape(shift);
	my $checked = shift;
	my $desc = shift;
	my $id = shift;

	$key = "$s->{acfb}::$key" if ($s->{acfb});

 my $html = $s->html_checkbox($key,$value,[$checked],[$desc],[$id]);

=cut

	my $s = shift;
	my $key = $s->escape(shift);
	my $value = $s->escape(shift);
	my $checked = shift;
	my $desc = shift;
	my $id = shift;

	$key = "$s->{acfb}::$key" if ($s->{acfb});

 my $html = $s->html_password($key,$value,[$size]);

=cut

	my $s = shift;
	my $key = $s->escape(shift);
	my $value = $s->escape(shift);
	my $size = shift;

	$key = "$s->{acfb}::$key" if ($s->{acfb});

	my $str = qq(<input type="password" name="$key" value="$value" autocomplete="off");

 my $html = $s->html_upload($key,[$size],[$class],[$id]);

=cut

	my $s = shift;
	my $key = $s->escape(shift);
	my $size = shift;
	my $class = shift;
	my $id = shift;

	$key = "$s->{acfb}::$key" if ($s->{acfb});


 my $html = $s->html_input_email($key,$value,[$size]);

=cut
	my $s = shift;
	my $key = $s->escape(shift);
	my $value = $s->escape(shift);
	my $size = shift;
	my $class = shift;
	my $id = shift;

	$key = "$s->{acfb}::$key" if ($s->{acfb});


 my $html = $s->html_input_number($key,$value,[$size]);

=cut
	my $s = shift;
	my $key = $s->escape(shift);
	my $value = $s->escape(shift);
	my $size = shift;
	my $class = shift;
	my $id = shift;

	$key = "$s->{acfb}::$key" if ($s->{acfb});


 my $html = $s->html_input($key,$value,[$size]);

=cut
	my $s = shift;
	my $key = $s->escape(shift);
	my $value = $s->escape(shift);
	my $size = shift;
	my $class = shift;
	my $id = shift;

	$key = "$s->{acfb}::$key" if ($s->{acfb});

 my $html = $s->html_input($key,$value,[$cols || 40],[$row || 3],[$class]);

=cut

	my $s = shift;
	my $key = $s->escape(shift);
	my $value = $s->escape(shift);
	my $cols = shift || 40;
	my $rows = shift || 3;
	my $class = shift;

	$key = "$s->{acfb}::$key" if ($s->{acfb});

 my $html $s->html_hidden($key,$value,[$desc],[$id]);

=cut

	my $s = shift;
	my $key = $s->escape(shift);
	my $value = $s->escape(shift);
	my $desc = shift;
	my $id = shift;

	$key = "$s->{acfb}::$key" if ($s->{acfb});

	$str .= qq(\t\t</tr>\n\t</tbody>);

	return $str;
}

sub escape {
	my $s = shift;
	my $string = shift;

	$string =~ s/&([^#])/&amp;$1/g; 
	$string =~ s/"/&quot;/g;
	$string =~ s/>/&gt;/g;
	$string =~ s/</&lt;/g;
	# &apos; is a valid XML entity, but not a valid HTML entity.
	# @todo: the ' character is valid HTML and shouldn't need to be escaped.
	#        However, a lot of the code uses value='' instead of "" so we need
	#        to leave this in for now.
	$string =~ s/'/&#39;/g;

	return $string;


=head2 format_text

 my $string = $s->format_text($string);

Converts newlines to <br>, tabs and 8 spaces to 4 nbsp;.  Also does an escape.

=cut

	my $s = shift;
	my $string = shift;

	$string = $s->escape($string);

	$string =~ s/\n/<br>\n/g;
	$string =~ s/\t/&nbsp;&nbsp;&nbsp;&nbsp;/g;
	$string =~ s/\s{8}/&nbsp;&nbsp;&nbsp;&nbsp;/g;


	my @rows = ();
	$text =~ s/\s+$//s;
	my $row = [];
	while ($text=~ m/(  (?!")[^,\r\n]*      # Handle normal fields
					| "(?:["\\]"|[^"])*?" # Handle quoted fields, escaped quotes as "" or \"
					)(\r?\n|,|$)
					/sgx) {
		my $val = defined $1 ? $1 : '';
		my $eol = $2;

				params => "f=edit");

			if ($s->{in}{f} eq 'edit') {
				open F, "/data/$s->{obase}/template/help/$s->{function}.tt";
				while (my $line = <F>) {
					$s->{help_text} .= $s->escape($line);
				}
				close F;

				$s->tt('help_edit.tt', { s => $s, });		
				return;

	} else {
		if ($s->{employee}{admin} && !($s->{object} =~ m/^(me|help)$/)) {
			$s->{employee}{object}{$s->{object}}{permission} = 1;
			(my $args = $s->{args}) =~ s/=/%3D/g;
			$s->add_action(function => 'permission',
				params => "return=$s->{function}&return_args=".$s->escape($args)) 
				unless($s->{env}{HIDE_PERMISSION} || $s->{agent});
		}

		# if we are in autocommit still at this point
		# then it probably means there was an error, so we need

	return $s->html_a("$s->{ubase}/$object/display?$keyfield=$id",$name);
}

sub html_input_calendar {
	my $s = shift;
	my $key = $s->escape(shift);
	my $value = $s->escape(shift);

	$key = "$s->{acfb}::$key" if ($s->{acfb});

	my $cal = $s->add_calendar($key);
	my $str = qq(<input $cal name="$key" value="$value" autocomplete="off" size="12">);

view all matches for this distribution

Apache-SecSess

1 match

SecSess.pm view on Meta::CPAN

		$requrl = $self->wrap_uri($u->unparse);
	}
	return $requrl;
}

## (un)wrap a URI, with more armor than Apache::Util::escape_uri
sub wrap_uri {
	my $self = shift;
	my($u) = @_;
	$u = encode_base64($u, '');
    $u =~ tr/\+\/\=/-._/;

view all matches for this distribution

Apache-Session-Browseable

1 match

lib/Apache/Session/Browseable/LDAP.pm view on Meta::CPAN

use Apache::Session::Lock::Null;
use Apache::Session::Browseable::Store::LDAP;
use Apache::Session::Generate::SHA256;
use Apache::Session::Serialize::JSON;
use Apache::Session::Browseable::_common;
use Net::LDAP::Util qw(escape_filter_value);

our $VERSION = '1.3.6';
our @ISA     = qw(Apache::Session Apache::Session::Browseable::_common);

sub populate {

lib/Apache/Session/Browseable/LDAP.pm view on Meta::CPAN

    my ( $class, $args, $selectField, $value, @fields ) = @_;

    my $index =
      ref( $args->{Index} ) ? $args->{Index} : [ split /\s+/, $args->{Index} ];
    if ( grep { $_ eq $selectField } @$index ) {
        ( $selectField, $value ) = escape_filter_value( $selectField, $value );
        return $class->_query( $args, $selectField, $value, @fields );
    }
    else {
        return $class->SUPER::searchOn( $args, $selectField, $value, @fields );
    }

lib/Apache/Session/Browseable/LDAP.pm view on Meta::CPAN

    my ( $class, $args, $selectField, $value, @fields ) = @_;

    my $index =
      ref( $args->{Index} ) ? $args->{Index} : [ split /\s+/, $args->{Index} ];
    if ( grep { $_ eq $selectField } @$index ) {
        ( $selectField, $value ) = escape_filter_value( $selectField, $value );
        $value =~ s/\\2a/\*/gi;
        return $class->_query( $args, $selectField, $value, @fields );
    }
    else {
        return $class->SUPER::searchOn( $args, $selectField, $value, @fields );

view all matches for this distribution

Apache-SetWWWTheme

2 results


	$newbody = $copyrightnotice . $newbody;

	if ($topbar)                                    # if we have a top links bar, we'll put it in
	  {
	    # first, we'll clean up the vars and remove all escapes before semicolons.
	    
	    my $marker;
	    for ($marker = 0; $marker <= $#topbottomlinks; $marker++)
	      {
		$topbottomlinks[$marker] =~ s/\\;/;/;

	    $newbody .= $Theme->MakeTopBottomBar();
	  }

	if ($usenavbar)                                      # This puts the top/bottom nav bars into the
	  {                                                  # newly-created HTML
	    # first we have to remove the escapes from our strings.

	    $nextlink =~ s/\\;/;/g;
	    $lastlink =~ s/\\;/;/g;
            $uplink   =~ s/\\;/;/g;

      }

    $sidebarmenutitle =~ s/\\;/;/g;
    $morelinkstitle   =~ s/\\;/;/g;

    # Ok, now we have cleaned up all the escaped semicolons.  It's time to feed these to
    # our module and have fun.


    $Theme->SetBGColor($BGCOLOR)                    if ($BGCOLOR);
    $Theme->SetBGPicture($bgpicture)                if ($bgpicture);

=item Module directives

Directives consist of a series of tags within a text file, or within an html
comment block before the <BODY> tag. Valid directive tags are always
terminated with a semicolon. For tags that accept lists as values, elements
are separated by commas.  Semicolons may be escaped within a tag.  Any 
semicolon preceded by a backslash will be considered text, and will not terminate
the directive.  The final text will have the escaped semicolon replaced with
a bare semicolon.  

 @DIRECTIVE=Some string of text\; semicolons are escaped.;

The above directive would set a value of "Some string of text; semicolons 
are escaped."

=item @ALINK

HTML and local configuration subject to server configuration
This tag is used to set the HTML BODY setting "alink". This is the

view all matches for this distribution

Apache-SimpleTemplate

1 match

	my $i = 0;
	for (; $i<$#pieces; $i++) {

		if ($pieces[$i] =~ 
			m/(.*?)$block_begin([\^\+\\\-\=\:]?)(.*?)\;?(\s*)$/gs) {
			my $text = &quote_escape($1);
			my $encode = $2;
			my $block = $3.$4;

			if ($s->{debug} > 3) {
				print STDERR "==================================TEXT $i:\n";

			}
			elsif ($encode eq '+') {
				$eval .= '$$____st_out_ .= &Apache::SimpleTemplate::encode('.$block.'); ';
			}
			elsif ($encode eq '^') {
				$eval .= '$$____st_out_ .= &Apache::SimpleTemplate::escape('.$block.'); ';
			}
			elsif ($encode eq '\\') {
				$eval .= '$$____st_out_ .= &Apache::SimpleTemplate::js_escape('.$block.'); ';
			}
			elsif ($encode eq '-') {
				$eval .= &blank_lines($block);
			}

		print STDERR "==================================TEXT $i:\n";
		print STDERR "$pieces[$i]\n";
		print STDERR "==================================\n";
	}

	$eval .= '$$____st_out_.=\''.&quote_escape($pieces[$i]).'\'; ';
	$eval .= "return (\$____st_out_);\n}";
	
	#if ($usepackage) { $eval .= "1;\n"; }

	if ($s->{debug} > 2) {


	return $s;

}

# html-escape a string ('<tag> & " ' becomes '&lt;tag&gt; &amp; &quot;')
sub escape {

	my $s = shift;
	if (ref $s) { $s = shift; }
	return undef unless defined($s);

	$s =~ s/\"/&quot;/g;

	return $s;
}

# escape single quotes (') and backslashes (\) with \' and \\
sub quote_escape {

	my $s = shift;
	if (ref $s) { $s = shift; }
	return undef unless defined($s);

	$s =~ s/([\'\\])/\\$1/gs;

	return $s;
}

# escape single quotes (') and backslashes (\) with \' and \\, newlines and cr's with \n \r
sub js_escape {

	my $s = shift;
	if (ref $s) { $s = shift; }
	return undef unless defined($s);

     the expression's value.

     '<%+ %>' is the same as '<%= %>', but the output gets url-encoded.
     (mnemonic: '+' is a space in a url-encoded string.)

     '<%^ %>'is the same as '<%= %>', but the output gets html-escaped.
     (mnemonic: '^' looks like the '<' and '>' that get replaced.)

     '<%\ %>'is the same as '<%= %>', except the string gets escaped for
     use as a single-quoted javascript var. ("'", "\", NL, CR get escaped.)

=head3  <%- _a_comment_ %>

     is ignored and replace by nothing.
     (mnemonic: "-" as in "<!-- html comments -->".)


  $s->encode($string)            -- url-encode the $string.
                                    &Apache::SimpleTemplate::encode($string)
  $s->decode($string)            -- url-decode the $string.
                                    &Apache::SimpleTemplate::decode($string)
  $s->escape($string)            -- html-escape the $string.
                                    &Apache::SimpleTemplate::escape($string)
  $s->quote_escape($string)      -- single-quote-escape the $string.
                                    &Apache::SimpleTemplate::quote_escape($string)
  $s->js_escape($string)         -- single-quote and newline escape (for javascript)
                                    &Apache::SimpleTemplate::quote_escape($string)

  $s->preload($file)             -- preload the template in $file, a full
                                    path which must match the DOCUMENT_ROOT.
                                    (for use in a startup.pl file.)

view all matches for this distribution

Apache-SiteConfig

1 match

inc/Module/Install/Metadata.pm view on Meta::CPAN

				defined $2
				? chr($2)
				: defined $Pod::Escapes::Name2character_number{$1}
				? chr($Pod::Escapes::Name2character_number{$1})
				: do {
					warn "Unknown escape: E<$1>";
					"E<$1>";
				};
			}gex;
		}
		elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {

inc/Module/Install/Metadata.pm view on Meta::CPAN

				defined $2
				? chr($2)
				: defined $mapping->{$1}
				? $mapping->{$1}
				: do {
					warn "Unknown escape: E<$1>";
					"E<$1>";
				};
			}gex;
		}
		else {

view all matches for this distribution

Apache-Status-DBI

2 results

lib/Apache/Status/DBI.pm view on Meta::CPAN


BEGIN {
    if (MP2) {
        require mod_perl2;
        require Apache2::Module;
        *escape_html = sub {
            my $s = shift;
            $s =~ s/&/&amp;/g;
            $s =~ s/</&lt;/g;
            $s =~ s/>/&gt;/g;
            return $s;
        }
    }
    else {
        require Apache;
        require Apache::Util;
        Apache::Util->import(qw(escape_html));
    }
}

my %apache_status_menu_items = (
    DBI_handles => [ 'DBI Handles', \&apache_status_dbi_handles ],

lib/Apache/Status/DBI.pm view on Meta::CPAN


    push @s, sprintf "%sAttributes: %s\n", $pad,
        join ", ", grep { $h->{$_} } @boolean_attr;
    push @s, sprintf "%sAttributes: %s\n", $pad,
        join ", ", map { "$_=".DBI::neat($h->{$_}) } @scalar_attr;
    if (my $sql = escape_html($h->{Statement} || '')) {
        $sql =~ s/\n/ /g;
        push @s, sprintf "%sStatement: <b>%s</b>\n", $pad, $sql;
        my $ParamValues = $type eq 'st' && $h->{ParamValues};
        push @s, sprintf "%sParamValues: %s\n", $pad,
                join ", ", map { "$_=".DBI::neat($ParamValues->{$_}) } sort keys %$ParamValues

lib/Apache/Status/DBI.pm view on Meta::CPAN

    push @s, sprintf "%sRows: %s\n", $pad, $h->rows
        if $type eq 'st' || $h->rows != -1;
    if (defined( my $err = $h->err )) {
        push @s, sprintf "%s%s %s %s\n", $pad,
            ($err ? "Error" : length($err) ? "Warning" : "Information"),
            $err, escape_html($h->errstr);
    }
    push @s, sprintf "    sth: %d (%d cached, %d active)\n",
        scalar @children, scalar keys %{$h->{CachedKids}||{}}, $h->{ActiveKids}
        if @children;
    push @s, "\n";

view all matches for this distribution

Apache-TaintRequest

1 match


use strict;
use warnings;

use Apache;
use Apache::Util qw(escape_html);
use Taint qw(tainted);

$Apache::TaintRequest::VERSION = '0.10';
@Apache::TaintRequest::ISA = qw(Apache);

  foreach my $value (@data) {
    # Dereference scalar references.
    $value = $$value if ref $value eq 'SCALAR';

    # Escape any HTML content if the data is tainted.
    $value = escape_html($value) if tainted($value);
  }

  $self->SUPER::print(@data);
}

  sub handler {
    my $r = shift;
    $r = Apache::TaintRequest->new($r);

    my $querystring = $r->query_string();
    $r->print($querystring);   # html is escaped...

    $querystring =~ s/<script>//;
    $r->print($querystring);   # html is NOT escaped...
  }

=head1 DESCRIPTION

=over 15