view release on metacpan or  search on metacpan

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

  my $name = $arg{name};
  my @sel = $self->{CGI}->param($name);
  if (!@sel && exists $arg{default} && defined $arg{default}) {
    my $d = $arg{default};
    @sel = ref $d ? @$d : $d;
  }
  my %sel;
  @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;
}

# pause_1999::main
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 $req = $self->{CGI};
  my $name = $arg{name} || "";
  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;
  $self->text_pw_field(FIELDTYPE=>"text", @_);
}

sub text_pw_field {
  my($self, %arg) = @_;
  my $name = $arg{name} || "";
  my $fieldtype = $arg{FIELDTYPE};

  my $req = $self->{CGI};
  my $val;
  if ($fieldtype eq "FILE") {
    if ($req->can("upload")) {
      if ($req->upload($name)) {
	$val = $req->upload($name);
      } else {
	$val = $req->param($name);
      }
    } else {
      $val = $req->param($name);
    }
  } else {
    $val = $req->param($name);
  }
  defined $val or
      defined($val = $arg{value}) or
	  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

Apache::HeavyCGI - Framework to run complex CGI tasks on an Apache server

=head1 SYNOPSIS

 use Apache::HeavyCGI;

=head1 WARNING UNSUPPORTED ALPHA CODE RELEASED FOR DEMO ONLY

The release of this software was only for evaluation purposes to
people who are actively writing code that deals with Web Application
Frameworks. This package is probably just another Web Application
Framework and may be worth using or may not be worth using. As of this
writing (July 1999) it is by no means clear if this software will be
developed further in the future. The author has written it over many
years and is deploying it in several places. B<Update 2006-02-03:
Development stalled since 2001 and now discontinued.>

There is no official support for this software. If you find it useful

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

 |ISA Class::Singleton  |---define----->| sub parameter {...}|
 +----------------------+               +--------------------+

                                                                       +----+
                                                                       |Your|
                                                                       |Duty|
 +----------------------------+----------------------------------------+----+
 |Apache                      | calls Your::Class::handler()           |    |
 +----------------------------+----------------------------------------+----+
 |                            | nominates the handlers,                |    |
 |Your::Class::handler()      | constructs $self,                      | ** |
 |                            | and calls $self->dispatch              |    |
 +----------------------------+----------------------------------------+----+
 |                            |        $self->init     (does nothing)  | ?? |
 |                            |        $self->prepare  (see below)     |    |
 |Apache::HeavyCGI::dispatch()| calls  $self->layout   (sets up layout)| ** |
 |                            |        $self->finish   (headers and    | ** |
 |                            |                         gross content) |    |
 |                            |        $self->deliver  (delivers)      | ?? |
 +----------------------------+----------------------------------------+----+
 |Apache::HeavyCGI::prepare() | calls HANDLER->instance->header($self) | ** |
 |                            | and HANDLER->instance->parameter($self)| ** |
 |                            | on all of your nominated handlers      |    |
 +----------------------------+----------------------------------------+----+


=head1 Object Attributes

As already mentioned, the HeavyCGI object is a pseudo-hash, i.e. can
be treated like a HASH, but all attributes that are being used must be
predeclared at compile time with a C<use fields> clause.

The convention regarding attributes is as simple as it can be:
uppercase attributes are reserved for the Apache::HeavyCGI class, all
other attribute names are at your disposition if you write a subclass.

The following attributes are currently defined. The module author's
production environment has a couple of attributes more that seem to
work well but most probably need more thought to be implemented in a
generic way.

=over

=item CAN_GZIP

Set by the can_gzip method. True if client is able to handle gzipped
data.

=item CAN_PNG

Set by the can_png method. True if client is able to handle PNG.

=item CAN_UTF8

Set by the can_utf8 method. True if client is able to handle UTF8
endoded data.

=item CGI

An object that handles GET and POST parameters and offers the method
param() and upload() in a manner compatible with Apache::Request.
Needs to be constructed and set by the user typically in the
contructor.

=item CHARSET

Optional attribute to denote the charset in which the outgoing data
are being encoded. Only used within the finish method. If it is set,
the finish() method will set the content type to text/html with this
charset.

=item CONTENT

Scalar that contains the content that should be sent to the user
uncompressed. During te finish() method the content may become
compressed.

=item DOCUMENT_ROOT

Unused.

=item ERROR

Anonymous array that accumulates error messages. HeavyCGI doesn't
handle the error though. It is left to the user to set up a proper
response to the user.

=item EXECUTION_PLAN

Object of type L<Apache::HeavyCGI::ExePlan>. It is recommended to
compute the object at startup time and always pass the same execution
plan into the constructor.

=item EXPIRES

Optional Attribute set by the expires() method. If set, HeavyCGI will
send an Expires header. The EXPIRES attribute needs to contain an
L<Apache::HeavyCGI::Date> object.

=item HANDLER

If there is an EXECUTION_PLAN, this attribute is ignored. Without an
EXECUTION_PLAN, it must be an array of package names. HeavyCGI treats
the packages as Class::Singleton classes. During the prepare() method
HeavyCGI calls HANDLER->instance->header($self) and
HANDLER->instance->parameter($self) on all of your nominated handlers.

=item LAST_MODIFIED

Optional Attribute set by the last_modified() method. If set, HeavyCGI
will send a Last-Modified header of the specified time, otherwise it
sends a Last-Modified header of the current time. The attribute needs
to contain an L<Apache::HeavyCGI::Date> object.

=item MYURL

The URL of the running request set by the myurl() method. Contains an
URI::URL object.

=item R