📄 cgi.pm
字号:
# for resolving relative references (-base) # $xbase -> (optional) alternative base at some remote location (-xbase)# $target -> (optional) target window to load all links into (-target)# $script -> (option) Javascript code (-script)# $no_script -> (option) Javascript <noscript> tag (-noscript)# $meta -> (optional) Meta information tags# $head -> (optional) any other elements you'd like to incorporate into the <HEAD> tag# (a scalar or array ref)# $style -> (optional) reference to an external style sheet# @other -> (optional) any other named parameters you'd like to incorporate into# the <BODY> tag.####'start_html' => <<'END_OF_FUNC',sub start_html { my($self,@p) = &self_or_default(@_); my($title,$author,$base,$xbase,$script,$noscript,$target,$meta,$head,$style,$dtd,$lang,@other) = rearrange([TITLE,AUTHOR,BASE,XBASE,SCRIPT,NOSCRIPT,TARGET,META,HEAD,STYLE,DTD,LANG],@p); # strangely enough, the title needs to be escaped as HTML # while the author needs to be escaped as a URL $title = $self->escapeHTML($title || 'Untitled Document'); $author = $self->escape($author); $lang ||= 'en-US'; my(@result,$xml_dtd); if ($dtd) { if (defined(ref($dtd)) and (ref($dtd) eq 'ARRAY')) { $dtd = $DEFAULT_DTD unless $dtd->[0] =~ m|^-//|; } else { $dtd = $DEFAULT_DTD unless $dtd =~ m|^-//|; } } else { $dtd = $XHTML ? XHTML_DTD : $DEFAULT_DTD; } $xml_dtd++ if ref($dtd) eq 'ARRAY' && $dtd->[0] =~ /\bXHTML\b/i; $xml_dtd++ if ref($dtd) eq '' && $dtd =~ /\bXHTML\b/i; push @result,q(<?xml version="1.0" encoding="utf-8"?>) if $xml_dtd; if (ref($dtd) && ref($dtd) eq 'ARRAY') { push(@result,qq(<!DOCTYPE html\n\tPUBLIC "$dtd->[0]"\n\t"$dtd->[1]">)); } else { push(@result,qq(<!DOCTYPE html\n\tPUBLIC "$dtd">)); } push(@result,$XHTML ? qq(<html xmlns="http://www.w3.org/1999/xhtml" lang="$lang"><head><title>$title</title>) : qq(<html lang="$lang"><head><title>$title</title>)); if (defined $author) { push(@result,$XHTML ? "<link rev=\"made\" href=\"mailto:$author\" />" : "<link rev=\"made\" href=\"mailto:$author\">"); } if ($base || $xbase || $target) { my $href = $xbase || $self->url('-path'=>1); my $t = $target ? qq/ target="$target"/ : ''; push(@result,$XHTML ? qq(<base href="$href"$t />) : qq(<base href="$href"$t>)); } if ($meta && ref($meta) && (ref($meta) eq 'HASH')) { foreach (keys %$meta) { push(@result,$XHTML ? qq(<meta name="$_" content="$meta->{$_}" />) : qq(<meta name="$_" content="$meta->{$_}">)); } } push(@result,ref($head) ? @$head : $head) if $head; # handle the infrequently-used -style and -script parameters push(@result,$self->_style($style)) if defined $style; push(@result,$self->_script($script)) if defined $script; # handle -noscript parameter push(@result,<<END) if $noscript;<noscript>$noscript</noscript>END ; my($other) = @other ? " @other" : ''; push(@result,"</head><body$other>"); return join("\n",@result);}END_OF_FUNC### Method: _style# internal method for generating a CSS style section####'_style' => <<'END_OF_FUNC',sub _style { my ($self,$style) = @_; my (@result); my $type = 'text/css'; my $cdata_start = $XHTML ? "\n<!--/* <![CDATA[ */" : "\n<!-- "; my $cdata_end = $XHTML ? "\n/* ]]> */-->\n" : " -->\n"; if (ref($style)) { my($src,$code,$stype,@other) = rearrange([SRC,CODE,TYPE], '-foo'=>'bar', # a trick to allow the '-' to be omitted ref($style) eq 'ARRAY' ? @$style : %$style); $type = $stype if $stype; if (ref($src) eq "ARRAY") # Check to see if the $src variable is an array reference { # If it is, push a LINK tag for each one. foreach $src (@$src) { push(@result,$XHTML ? qq(<link rel="stylesheet" type="$type" href="$src" />) : qq(<link rel="stylesheet" type="$type" href="$src">/)) if $src; } } else { # Otherwise, push the single -src, if it exists. push(@result,$XHTML ? qq(<link rel="stylesheet" type="$type" href="$src" />) : qq(<link rel="stylesheet" type="$type" href="$src">) ) if $src; } push(@result,style({'type'=>$type},"$cdata_start\n$code\n$cdata_end")) if $code; } else { push(@result,style({'type'=>$type},"$cdata_start\n$style\n$cdata_end")); } @result;}END_OF_FUNC'_script' => <<'END_OF_FUNC',sub _script { my ($self,$script) = @_; my (@result); my (@scripts) = ref($script) eq 'ARRAY' ? @$script : ($script); foreach $script (@scripts) { my($src,$code,$language); if (ref($script)) { # script is a hash ($src,$code,$language, $type) = rearrange([SRC,CODE,LANGUAGE,TYPE], '-foo'=>'bar', # a trick to allow the '-' to be omitted ref($script) eq 'ARRAY' ? @$script : %$script); # User may not have specified language $language ||= 'JavaScript'; unless (defined $type) { $type = lc $language; # strip '1.2' from 'javascript1.2' $type =~ s/^(\D+).*$/text\/$1/; } } else { ($src,$code,$language, $type) = ('',$script,'JavaScript', 'text/javascript'); } my $comment = '//'; # javascript by default $comment = '#' if $type=~/perl|tcl/i; $comment = "'" if $type=~/vbscript/i; my $cdata_start = "\n<!-- Hide script\n"; $cdata_start .= "$comment<![CDATA[\n" if $XHTML; my $cdata_end = $XHTML ? "\n$comment]]>" : $comment; $cdata_end .= " End script hiding -->\n"; my(@satts); push(@satts,'src'=>$src) if $src; push(@satts,'language'=>$language); push(@satts,'type'=>$type); $code = "$cdata_start$code$cdata_end" if defined $code; push(@result,script({@satts},$code || '')); } @result;}END_OF_FUNC#### Method: end_html# End an HTML document.# Trivial method for completeness. Just returns "</BODY>"####'end_html' => <<'END_OF_FUNC',sub end_html { return "</body></html>";}END_OF_FUNC################################# METHODS USED IN BUILDING FORMS#################################### Method: isindex# Just prints out the isindex tag.# Parameters:# $action -> optional URL of script to run# Returns:# A string containing a <ISINDEX> tag'isindex' => <<'END_OF_FUNC',sub isindex { my($self,@p) = self_or_default(@_); my($action,@other) = rearrange([ACTION],@p); $action = qq/action="$action"/ if $action; my($other) = @other ? " @other" : ''; return $XHTML ? "<isindex $action$other />" : "<isindex $action$other>";}END_OF_FUNC#### Method: startform# Start a form# Parameters:# $method -> optional submission method to use (GET or POST)# $action -> optional URL of script to run# $enctype ->encoding to use (URL_ENCODED or MULTIPART)'startform' => <<'END_OF_FUNC',sub startform { my($self,@p) = self_or_default(@_); my($method,$action,$enctype,@other) = rearrange([METHOD,ACTION,ENCTYPE],@p); $method = lc($method) || 'post'; $enctype = $enctype || &URL_ENCODED; unless (defined $action) { $action = $self->url(-absolute=>1,-path=>1); $action .= "?$ENV{QUERY_STRING}" if $ENV{QUERY_STRING}; } $action = qq(action="$action"); my($other) = @other ? " @other" : ''; $self->{'.parametersToAdd'}={}; return qq/<form method="$method" $action enctype="$enctype"$other>\n/;}END_OF_FUNC#### Method: start_form# synonym for startform'start_form' => <<'END_OF_FUNC',sub start_form { &startform;}END_OF_FUNC'end_multipart_form' => <<'END_OF_FUNC',sub end_multipart_form { &endform;}END_OF_FUNC#### Method: start_multipart_form# synonym for startform'start_multipart_form' => <<'END_OF_FUNC',sub start_multipart_form { my($self,@p) = self_or_default(@_); if (defined($param[0]) && substr($param[0],0,1) eq '-') { my(%p) = @p; $p{'-enctype'}=&MULTIPART; return $self->startform(%p); } else { my($method,$action,@other) = rearrange([METHOD,ACTION],@p); return $self->startform($method,$action,&MULTIPART,@other); }}END_OF_FUNC#### Method: endform# End a form'endform' => <<'END_OF_FUNC',sub endform { my($self,@p) = self_or_default(@_); if ( $NOSTICKY ) { return wantarray ? ("</form>") : "\n</form>"; } else { return wantarray ? ($self->get_fields,"</form>") : $self->get_fields ."\n</form>"; }}END_OF_FUNC#### Method: end_form# synonym for endform'end_form' => <<'END_OF_FUNC',sub end_form { &endform;}END_OF_FUNC'_textfield' => <<'END_OF_FUNC',sub _textfield { my($self,$tag,@p) = self_or_default(@_); my($name,$default,$size,$maxlength,$override,@other) = rearrange([NAME,[DEFAULT,VALUE],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p); my $current = $override ? $default : (defined($self->param($name)) ? $self->param($name) : $default); $current = defined($current) ? $self->escapeHTML($current,1) : ''; $name = defined($name) ? $self->escapeHTML($name) : ''; my($s) = defined($size) ? qq/ size="$size"/ : ''; my($m) = defined($maxlength) ? qq/ maxlength="$maxlength"/ : ''; my($other) = @other ? " @other" : ''; # this entered at cristy's request to fix problems with file upload fields # and WebTV -- not sure it won't break stuff my($value) = $current ne '' ? qq(value="$current") : ''; return $XHTML ? qq(<input type="$tag" name="$name" $value$s$m$other />) : qq/<input type="$tag" name="$name" $value$s$m$other>/;}END_OF_FUNC#### Method: textfield# Parameters:# $name -> Name of the text field# $default -> Optional default value of the field if not# already defined.# $size -> Optional width of field in characaters.# $maxlength -> Optional maximum number of characters.# Returns:# A string containing a <INPUT TYPE="text"> field#'textfield' => <<'END_OF_FUNC',sub textfield { my($self,@p) = self_or_default(@_); $self->_textfield('text',@p);}END_OF_FUNC#### Method: filefield# Parameters:# $name -> Name of the file upload field# $size -> Optional width of field in characaters.# $maxlength -> Optional maximum number of characters.# Returns:# A string containing a <INPUT TYPE="text"> field#'filefield' => <<'END_OF_FUNC',sub filefield { my($self,@p) = self_or_default(@_); $self->_textfield('file',@p);}END_OF_FUNC#### Method: password# Create a "secret password" entry field# Parameters:# $name -> Name of the field# $default -> Optional default value of the field if not# already defined.# $size -> Optional width of field in characters.# $maxlength -> Optional maximum characters that can be entered.# Returns:# A string containing a <INPUT TYPE="password"> field#'password_field' => <<'END_OF_FUNC',sub password_field { my ($self,@p) = self_or_default(@_); $self->_textfield('password',@p);}END_OF_FUNC#### Method: textarea# Parameters:# $name -> Name of the text field# $default -> Optional default value of the field if not# already defined.# $rows -> Optional number of rows in text area# $columns -> Optional number of columns in text area# Returns:# A string containing a <TEXTAREA></TEXTAREA> tag#'textarea' => <<'END_OF_FUNC',sub textarea { my($self,@p) = self_or_default(@_); my($name,$default,$rows,$cols,$override,@other) = rearrange([NAME,[DEFAULT,VALUE],ROWS,[COLS,COLUMNS],[OVERRIDE,FORCE]],@p); my($current)= $override ? $default : (defined($self->param($name)) ? $self->param($name) : $default); $name = defined($name) ? $self->escapeHTML($name) : ''; $current = defined($current) ? $self->escapeHTML($current) : ''; my($r) = $rows ? " rows=$rows" : ''; my($c) = $cols ? " cols=$cols" : ''; my($other) = @other ? " @other" : ''; return qq{<textarea name="$name"$r$c$other>$current</textarea>};}END_OF_FUNC#### Method: button# Create a javascript button.# Parameters:# $name -> (optional) Name for the button. (-name)# $value -> (optional) Value of the button when selected (and visible name) (-value)# $onclick -> (optional) Text of the JavaScript to run when the button is# clicked.# Returns:# A string containing a <INPUT TYPE="button"> tag####'button' => <<'END_OF_FUNC',sub button { my($self,@p) = self_or_default(@_); my($label,$value,$script,@other) = rearrange([NAME,[VALUE,LABEL], [ONCLICK,SCRIPT]],@p); $label=$self->escapeHTML($label); $value=$self->escapeHTML($value,1); $script=$self->escapeHTML($script); my($name) = ''; $name = qq/ name="$label"/ if $label; $value = $value || $label; my($val) = ''; $val = qq/ value="$value"/ if $value; $script = qq/ onclick="$script"/ if $script; my($other) = @other ? " @other" : ''; return $XHTML ? qq(<input type="button"$name$val$script$other />) : qq/<input type="button"$name$val$script$other>/;}END_OF_FUNC#### Method: submit# Create a "submit query" button.# Parameters:# $name -> (optional) Name for the button.# $value -> (optional) Value of the button when selected (also doubles as label).# $label -> (optional) Label printed on the button(also doubles as the value).# Returns:# A string containing a <INPUT TYPE="submit"> tag####'submit' => <<'END_OF_FUNC',sub submit { my($self,@p) = self_or_default(@_);⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -