view release on metacpan or  search on metacpan

lib/CGI/Bus.pm  view on Meta::CPAN

   ,-cgi        =>undef           # CGI predefined object
  #,-fcgimax    =>undef           # CGI::Fast requests max
  #,-fcgicount  =>undef           # CGI::Fast requests counter
   ,-dbi        =>undef           # DBI predefined object

  #,-qpath      =>undef           # Query (script) Path
  #,-qurl       =>undef           # Query (script) URL
  #,-spath      =>undef           # Site Path
  #,-surl       =>undef           # Site URL
  #,-bpath      =>undef           # Binary Path
  #,-burl       =>undef           # Binary URL
  #,-dpath      =>undef           # Data Path
  #,-tpath      =>undef           # Temporary Files Path
  #,-ppath      =>undef           # Publish Path
  #,-purl       =>undef           # Publish URL
  #,-fpath      =>undef           # Files Store Path
  #,-furf       =>undef           # Files Store file URL
  #,-furl       =>undef           # Files Store URL
  #,-hpath      =>undef           # Homes Store Path
  #,-hurf       =>undef           # Homes Store file URL
  #,-hurl       =>undef           # Homes Store URL
  #,-urfcnd     =>undef           # URFs condition sub{}
  #,-iurl       =>undef           # Apaceh Images URL '/images'

  #,-user       =>undef           # User name get optional sub
  #,-usdomain   =>undef           # Server's User Domain optional sub
  #,-ugroups    =>undef           # User groups list optional sub
  #,-usercnv    =>undef           # User/Group names convertor optional sub
  #,-ugrpcnv    =>undef           # User/Group names convertor optional sub
  #,-userauth   =>undef           # User authentication optional sub
  #,-uadmins    =>undef           # Administrators list
  #,-w32IISdpsn	=>($ENV{SERVER_SOFTWARE}||'') =~/IIS/ ? 2 : 0 # MsIIS deimpersonation

  #,-httpheader =>undef           # HTTP header hash ref, for httpheader()
  #,-htmlstart  =>undef           # HTML start hash ref, for htmlstart()
  #,-htpnstart  =>undef           #      Navigator pane HTML start
  #,-htpgstart  =>undef           #      HTML page HTML start
  #,-htpfstart  =>undef           #      HTML form HTML start
  #,-htpgtop    =>undef           # HTML page begin, for htpgstart()
  #,-htpgend    =>undef           # HTML page end, for htpgend() 
   );
 }
 $s->set(@_);
 if ($ENV{MOD_PERL}) {
    Apache->push_handlers("PerlCleanupHandler"
           ,sub{eval{$s->reset}; eval('Apache::DECLINED;')}); # or '$s->reset' at the bottom of scripts
 }
 if (!$s->{-cgi}) {
    eval('use CGI::Fast') if $s->{-fcgimax};
    eval('use CGI qw(-no_xhtml);');
  # $CGI::POST_MAX =-1;                                 # default in CGI.pm 
  # $MultipartBuffer::INITIAL_FILLUNIT =1024*4;         # default in CGI.pm 
    local $ENV{CONTENT_TYPE} ='multipart/form-data'     # !!! fix CGI.pm: $boundary = "--$boundary" unless CGI::user_agent('MSIE\s+3\.0[12];\s*Mac')
      if ($ENV{CONTENT_TYPE}||'') =~m|^multipart/form-data|
      && !$ENV{MOD_PERL}; # !!! beter to read boundary from input, but CGI.pm BUG: This won't work correctly under mod_perl
  # $s->pushmsg($ENV{CONTENT_TYPE});
    no warnings;
    $s->{-cgi} =(!$s->{-fcgimax} ? eval('CGI->new') : eval('CGI::Fast->new'))
               ||CGI::Carp::croak("'CGI->new' failure: $@\n");
    $CGI::Q =$s->{-cgi};
    $CGI::XHTML =0;
    if ((($ENV{SERVER_SOFTWARE}||'') =~/IIS/)
	||  ($ENV{MOD_PERL} && !$ENV{PERL_SEND_HEADER})) {
	$CGI::NPH =1;
    }
#CGI quote:
#die "Malformed multipart POST: "
#.'boundary: ' .$self->{BOUNDARY} ."***\n"
#.'buffer: ' .$self->{BUFFER} ."***\n"
#." start=$start; selflen=" .$self->{LENGTH} .'; '
#.join(',', map {($_=>$ENV{$_}||'')} qw (REQUEST_METHOD REQUEST_URI CONTENT_TYPE CONTENT_LENGTH))
#unless ($start >= 0) || ($self->{LENGTH} > 0);
 }
 $s
}


sub class {
 substr($_[0], 0, index($_[0],'='))
}


sub set {
 return(keys(%{$_[0]})) if scalar(@_) ==1;
 return($_[0]->{$_[1]}) if scalar(@_) ==2;
 my ($s, %opt) =@_;
 foreach my $k (keys(%opt)) {
  $s->{$k} =$opt{$k};
 }
 my $h;
 if ($h =$opt{-import}) {    # Import Classes or Methods and Packages
    delete $s->{-import};
    foreach my $k (keys %$h) {
      my $l =  $h->{$k};
      if    (ref($l) eq 'HASH') {  # 'use...'=>{-method=>call,...},...
         my $p =$k =~/^([^\;\s\(]+)/ ? $1 : $k;
         foreach my $c (keys %$l) {
           my $m =$l->{$c};
           $s->{$m} =
             sub{$s->{$m} =eval("use $k; \\\&$p::$c");
                 eval("use $k; &$p::$c(\@_)")}
         }
      }
      elsif (ref($l) eq 'ARRAY') { # 'use...'=>[method,...],...
         my $p =$k =~/^([^\;\s\(]+)/ ? $1 : $k;
         foreach my $m (@$l) {
           $s->{"-$m"} =
             sub{$s->{"-$m"} =eval("use $k; \\\&$p::$m"); 
                 eval("use $k; &$p::$m(\@_)")}
         }
      }
      else {                       # -key=>class,....
         $s->{-classes}->{$k} =$h->{$k}
      }
    }
 }
 if ($h =$opt{-reimport}) {  # Reset or Load Classes
    delete $s->{-reimport};
    if    (ref($h) eq 'HASH') {    # {-key=>class,...}
       foreach my $k (keys %$h) {
         $s->{-classes}->{$k} =$h->{$k};