escape results from the CPAN

AuthzLDAP.pm view on Meta::CPAN

      if ($member =~ /^[^=]+="([^"]+)",/) {
	$member = $1;
	$r->log->debug("check_group: Setting quoted $member");
      } elsif ($member =~ /^[^=]+=([^,]+),/) {
	$member = $1;
	$r->log->debug("check_group: Examining escaped $member");
	$member =~ s/\\(.)/$1/g;
	$r->log->debug("check_group: Setting escaped $member");
      }

      $r->log->debug("check_group: Member now $member");
      my ($result, $child_group) = check_group($r, $ld, $basedn, $groupattrtype,
					       $memberattrtype, $userinfo,

view all matches for this distribution

Apache-AxKit-Language-XSP-ObjectTaglib

2 results

lib/Apache/AxKit/Language/XSP/ObjectTaglib.pm view on Meta::CPAN

Similarly, the C<code> tag calls the C<code> method on the same object.

The C<description> and C<summary> tags call the C<description> and C<summary>
methods on each course object with the loop, this time making sure that the
result is valid XML instead of plain text. (This is because we store the
description in the database as XML, and don't want it escaped before AxKit
throws it onto the page.)

      }, {
        tag      => 'presentations',
        target   => 'course',

view all matches for this distribution

Apache-AxKit-Plugin-Session

1 match

lib/Apache/AxKit/Plugin/Session.pm view on Meta::CPAN

    unless ($authen_script = $r->dir_config($auth_name.'LoginScript')) {
        $r->log_reason("PerlSetVar '${auth_name}LoginScript' missing", $r->uri);
        return SERVER_ERROR;
    }

    my $uri = uri_escape($r->uri);
    $authen_script =~ s/((?:[?&])destination=)/$1$uri/;
    $self->debug(3,"Internally redirecting to $authen_script");
    $r->custom_response(FORBIDDEN, $authen_script);
    return FORBIDDEN;
}

view all matches for this distribution

Apache-AxKit-Provider-OpenOffice

2 results

dtds/drawing.mod view on Meta::CPAN

<!-- caption attributes -->
<!ATTLIST style:properties draw:caption-type (straight-line|angled-line|angled-connector-line) #IMPLIED>
<!ATTLIST style:properties draw:caption-angle-type (fixed|free) #IMPLIED>
<!ATTLIST style:properties draw:caption-angle %nonNegativeInteger; #IMPLIED>
<!ATTLIST style:properties draw:caption-gap %distance; #IMPLIED>
<!ATTLIST style:properties draw:caption-escape-direction (horizontal|vertical|auto) #IMPLIED>
<!ATTLIST style:properties draw:caption-escape %lengthOrPercentage; #IMPLIED>
<!ATTLIST style:properties draw:caption-line-length %distance; #IMPLIED>
<!ATTLIST style:properties draw:caption-fit-line-length %boolean; #IMPLIED>

<!-- Animations -->
<!ELEMENT presentation:sound EMPTY>

view all matches for this distribution

Apache-Blog

2 results

templates/lightblue/older.html view on Meta::CPAN

  <tr> 
    <td height="351"></td>
    <td valign="top" colspan="2" class="lightblue"> 
      <p>
<tmpl_loop older_entries>
<li><tmpl_var date> - <a href="<tmpl_var escape=url name=filename>"><tmpl_var escape=html name=short_name></a> (<tmpl_var wc> words)
</tmpl_loop>

		
<p></p>
<hr>

view all matches for this distribution

Apache-BumpyLife

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-Centipaid

1 match

FAQ view on Meta::CPAN

 then you need to reinstall CGI.pm - We have included a tested version
 of CGI.pm in the contrib directory, however it is recommended to get the
 latest version from http://www.perl.com/CPAN/modules/by-module/CGI/

 >Attempt to free unreferenced scalar.
 >[Wed Jan 15 14:36:45 2003] [error] Undefined subroutine &CGI::unescape called at 
 >/usr/lib/perl5/5.6.1/CGI/Cookie.pm line 75.

---> if this condition is met, thenm proceed to next test

4) Check which type of authetication has been chosen. i.e. is it an httpd.conf

view all matches for this distribution

Apache-CustomKeywords

1 match

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

    }
}

sub interpolate {
    my($class, $engine, $query) = @_;
    $engine =~ s/%s/$class->escape_it($query)/eg;
    return $engine;
}

sub escape_it {
    my($class, $query) = @_;
    $query =~ s/ /+/g;
    return Apache::Util::escape_uri($query);
}

sub query {
    my($class, $r) = @_;
    my %args = $r->args;

view all matches for this distribution

Apache-DAV

1 match

mod_dav-1.0.3.patch view on Meta::CPAN

+			       &propdb)) != NULL) {
+	err = dav_push_error(r->pool, HTTP_INTERNAL_SERVER_ERROR, 0,
+			     ap_psprintf(r->pool,
+					 "Could not open the property "
+					 "database for %s.",
+					 ap_escape_html(r->pool, r->uri)),
+			     err);
+	return dav_handle_err(r, err, NULL);
+    }
+    /* ### what to do about closing the propdb on server failure? */
+

mod_dav-1.0.3.patch view on Meta::CPAN

-			       &propdb)) != NULL) {
-	err = dav_push_error(r->pool, HTTP_INTERNAL_SERVER_ERROR, 0,
-			     ap_psprintf(r->pool,
-					 "Could not open the property "
-					 "database for %s.",
-					 ap_escape_html(r->pool, r->uri)),
-			     err);
-	return dav_handle_err(r, err, NULL);
-    }
-    /* ### what to do about closing the propdb on server failure? */
-

view all matches for this distribution

Apache-DnsZone

1 match

sql/oracle.sql view on Meta::CPAN

-- drop sequence records_MX_id;
-- drop sequence records_NS_id;
-- drop sequence records_PTR_id;
-- drop sequence records_TXT_id;

set escape \

create table languages (
  id number not null,
  lang varchar2(5) not null,
  language varchar2(255) not null,

view all matches for this distribution

Apache-ExtDirect

1 match

lib/Apache/ExtDirect/Router.pm view on Meta::CPAN


    # Pluck file name from Content-Disposition string
    my ($file_name)
        = $upload_info->{'Content-Disposition'} =~ /filename="(.*?)"/;

    # URL unescape it
    $file_name =~ s/%([\dA-Fa-f]{2})/pack("C", hex $1)/eg;

    return $file_name;
}

view all matches for this distribution

Apache-FakeCookie

2 results

FakeCookie.pm view on Meta::CPAN

    # Some foreign cookies are not in name=value format, so ignore
    # them.
      next if !defined($value);
      my @values = ();
      if ($value ne '') {
        @values = map unescape($_),split(/[&;]/,$value.'&dmy');
        pop @values;
      }
      $key = unescape($key);
      # A bug in Netscape can cause several cookies with same name to
      # appear.  The FIRST one in HTTP_COOKIE is the most recent version.
      $results{$key} ||= $self->new(undef,-name=>$key,-value=>\@values);
    }
    $self = \%results;

FakeCookie.pm view on Meta::CPAN

}
sub as_string {
  my $self = shift;
  return '' unless $self->name;
  my %cook = %$self;
  my $cook = ($cook{-name}) ? escape($cook{-name}) . '=' : '';
  if ($cook{-value}) {
    my $i = '';
    foreach(@{$cook{-value}}) {
      $cook .= $i . escape($_);
      $i = '&'; 
    }
  }  
  foreach(qw(domain path)) {
    $cook .= "; $_=" . $cook{"-$_"} if $cook{"-$_"};

FakeCookie.pm view on Meta::CPAN

    }
    $self->{$item} = $val;
  }
  return (exists $self->{$item}) ? $self->{$item} : '';
}
sub escape {
  my ($x) = @_;
  return undef unless defined($x);
  $x =~ s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
  return $x;
}
# unescape URL-data, but leave +'s alone
sub unescape {  
  my ($x) = @_;
  return undef unless defined($x);
  $x =~ tr/+/ /;       # pluses become spaces
  $x =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
  return $x;

view all matches for this distribution

Apache-FastForward

4 results

examples/basic/Demo.pm view on Meta::CPAN


    # Template initialisation
    my $sheet = tie my %sheet, 'Apache::FastForward::Spreadsheet';
    my %csv_atr = (
        'quote_char'  => '"',
        'escape_char' => '"',
        'sep_char'    => ';',
        'binary'      => 1 );
 
    $sheet->LoadTemplate( '/var/www/demo/books.csv', \%csv_atr);

view all matches for this distribution

Apache-FileManager

2 results


use strict;
#use warnings;
use IO::File;
use Apache::Request;
use Apache::Util qw(escape_html);
use Apache::File;
use File::NCopy  qw(copy);
use File::Copy   qw(move);
use File::Remove qw(remove);
use File::stat;

    var cookiestring=''+document.cookie;
    var index1=cookiestring.indexOf(cookiename);
    if (index1==-1 || cookiename=='') return ''; 
    var index2=cookiestring.indexOf(';',index1);
    if (index2==-1) index2=cookiestring.length; 
    return unescape(cookiestring.substring(index1+cookiename.length+1,index2));
  }
  
  function setcookie(name,value,duration){
    cookiestring=name+'='+escape(value)+';EXPIRES='+getexpirydate(duration);
    document.cookie=cookiestring;
    if(!getcookie(name)){ return false; }
    else{ return true; }
  }

      window.alert('Please select ONE file to edit by clicking on a check box with the mouse.');
    }

    else {
      var f= window.document.FileManager;
      var cd = escape(f.FILEMANAGER_curr_dir.value);
      var editfile = escape(sel_ar[0].value);
      var w = window.open('".r->uri."?FILEMANAGER_cmd=editfile&FILEMANAGER_curr_dir='+cd+'&FILEMANAGER_editfile='+editfile, 'FileManagerEditFile', 'scrollbars,resizable');
      sel_ar[0].checked = false;
      w.focus();  
    }
  }

var cd = f.FILEMANAGER_curr_dir.value;
if (cd != '') {
  rv = cd+'/'+rv;
}
if ((rv != null)&&(rv != '')) { 
  var w = window.open('".r->uri."?FILEMANAGER_cmd=editfile&FILEMANAGER_curr_dir='+escape(cd)+'&FILEMANAGER_editfile='+escape(rv), 'FileManagerEditFile', 'scrollbars,resizable'); 
  w.focus(); 
} else if (rv == '') {
  window.alert('can not create blank file names');
}
return false;

    #if directory?
    if (-d $file) {
      $last_modified = "--";
      $size = "<TD ALIGN=CENTER>--</TD>";
      $type = "/"; # "/" designates "directory"
      $link = "<A HREF=# onclick=\"var f=window.document.FileManager; f.FILEMANAGER_curr_dir.value='".&escape_html($curr_dir.$file)."'; f.submit(); return false;\"><FONT COLOR=#006699>$file$type</FONT></A>";
    }

    #must be a file
    elsif (-f $file) {

      $fake_doc_root =~ s/^\///; $fake_doc_root =~ s/\/$//;

      my $href = $curr_dir;
      $href = $fake_doc_root."/".$href if $fake_doc_root;

      $link = "<A HREF=\"/$href"."$file?nossi=1\" TARGET=_blank><FONT COLOR=BLACK>".&escape_html($file.$type)."</FONT></A>";
    }

    $acum .= "
<TR BGCOLOR=#$bgcolor>
<TD><INPUT TYPE=CHECKBOX NAME=FILEMANAGER_sel_files VALUE='$curr_dir"."$file'></TD>

  my $o = shift;
  my @sel_files = r->param('FILEMANAGER_sel_files');
  return \ @sel_files;
}

#escape spaces in filename
sub filename_esc {
  my $o = shift;
  my $f = shift;
  $f =~ s/\ /\\\ /g;
  return $f;

view all matches for this distribution

Apache-GDGraph

1 match

lib/Apache/GD/Graph.pm view on Meta::CPAN


	eval {
		my $args = scalar $r->args || $r->content;
		my %args = map {
				s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
				$_ # unescaped
			    } split /[=&;]/, $args, -1;

		die <<EOF unless $args;
Please supply arguments in the query string, see the Apache::GD::Graph man
page for details.

view all matches for this distribution

Apache-Gallery

1 match

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));